diff options
author | Akira Kakuto <kakuto@fuk.kindai.ac.jp> | 2016-02-10 05:31:26 +0000 |
---|---|---|
committer | Akira Kakuto <kakuto@fuk.kindai.ac.jp> | 2016-02-10 05:31:26 +0000 |
commit | c4cbbb4b4c32ca5e900cf1d276fa70595c34c5bd (patch) | |
tree | 1c9f00b9002b03bcf863e93a761d252b4cc0487f /Build/source/utils | |
parent | ea9c1a801bdfb30bf6cec9b9261d37c52441e27b (diff) |
pmx 2.7.3
git-svn-id: svn://tug.org/texlive/trunk@39654 c570f23f-e606-0410-a88d-b1316a301751
Diffstat (limited to 'Build/source/utils')
-rw-r--r-- | Build/source/utils/README | 2 | ||||
-rw-r--r-- | Build/source/utils/pmx/ChangeLog | 4 | ||||
-rwxr-xr-x | Build/source/utils/pmx/configure | 24 | ||||
-rw-r--r-- | Build/source/utils/pmx/configure.ac | 4 | ||||
-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/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/scor2prt.for.orig | 1621 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src-PATCHES/ChangeLog (renamed from Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog) | 5 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src-PATCHES/TL-Changes (renamed from Build/source/utils/pmx/pmx-2.7.0-PATCHES/TL-Changes) | 3 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/AUTHORS (renamed from Build/source/utils/pmx/pmx-2.7.0/AUTHORS) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/COPYING (renamed from Build/source/utils/pmx/pmx-2.7.0/COPYING) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/ChangeLog (renamed from Build/source/utils/pmx/pmx-2.7.0/ChangeLog) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/INSTALL (renamed from Build/source/utils/pmx/pmx-2.7.0/INSTALL) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/Makefile.am (renamed from Build/source/utils/pmx/pmx-2.7.0/Makefile.am) | 8 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/Makefile.f2c | 7 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/NEWS (renamed from Build/source/utils/pmx/pmx-2.7.0/NEWS) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-1 | 34 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-2 | 10 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/README (renamed from Build/source/utils/pmx/pmx-2.7.0/README) | 2 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/configure.ac (renamed from Build/source/utils/pmx/pmx-2.7.0/configure.ac) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/abort_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/abort_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/backspac.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/backspac.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_abs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_abs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_cos.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_cos.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_div.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_div.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_exp.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_exp.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_log.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_log.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_sin.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_sin.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/c_sqrt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/c_sqrt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/cabs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/cabs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/close.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/close.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_abs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_abs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_acos.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_acos.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_asin.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_asin.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_atan.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_atan.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_atn2.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_atn2.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_cnjg.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cnjg.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_cos.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cos.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_cosh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cosh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_dim.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_dim.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_exp.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_exp.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_imag.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_imag.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_int.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_int.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_lg10.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_lg10.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_log.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_log.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_mod.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_mod.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_nint.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_nint.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_prod.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_prod.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_sign.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sign.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_sin.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sin.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_sinh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sinh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_sqrt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sqrt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_tan.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_tan.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/d_tanh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/d_tanh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/derf_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/derf_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/derfc_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/derfc_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/dfe.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/dfe.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/dolio.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/dolio.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/dtime_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/dtime_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/due.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/due.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/ef1asc_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/ef1asc_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/ef1cmc_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/ef1cmc_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/endfile.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/endfile.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/erf_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/erf_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/erfc_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/erfc_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/err.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/err.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/etime_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/etime_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/exit_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/exit_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/f2c.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/f2c.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/f77_aloc.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/f77_aloc.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/f77vers.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/f77vers.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/fio.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/fio.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/fmt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/fmt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/fmt.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/fmt.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/fmtlib.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/fmtlib.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/fp.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/fp.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/ftell64_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/ftell64_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/ftell_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/ftell_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/getarg_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/getarg_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/getenv_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/getenv_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_abs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_abs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_dim.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_dim.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_dnnt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_dnnt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_indx.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_indx.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_len.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_len.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_mod.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_mod.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_nint.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_nint.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/h_sign.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/h_sign.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/hl_ge.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_ge.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/hl_gt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_gt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/hl_le.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_le.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/hl_lt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_lt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i77vers.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i77vers.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_abs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_abs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_dim.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_dim.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_dnnt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_dnnt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_indx.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_indx.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_len.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_len.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_mod.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_mod.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_nint.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_nint.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/i_sign.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/i_sign.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/iargc_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/iargc_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/iio.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/iio.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/ilnw.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/ilnw.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/inquire.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/inquire.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/l_ge.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/l_ge.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/l_gt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/l_gt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/l_le.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/l_le.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/l_lt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/l_lt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/lbitbits.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/lbitbits.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/lbitshft.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/lbitshft.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/lio.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/lio.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/lread.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/lread.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/lwrite.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/lwrite.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/main.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/main.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/open.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/open.c) | 116 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-01-binary (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-01-binary) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-03-DOS-line-endings (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-03-DOS-line-endings) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-04-MSVC-complex (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-04-MSVC-complex) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-05-FreeBSD-off_t (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-05-FreeBSD-off_t) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-06-WIN32 (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-06-WIN32) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-07-MuslLibc (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-08-WIN64 | 23 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/patch-09-tmpfile | 136 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_ci.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ci.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_dd.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_dd.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_di.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_di.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_hh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_hh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_ii.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ii.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_qq.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_qq.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_ri.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ri.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_zi.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_zi.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/pow_zz.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_zz.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/qbitbits.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/qbitbits.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/qbitshft.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/qbitshft.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_abs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_abs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_acos.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_acos.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_asin.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_asin.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_atan.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_atan.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_atn2.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_atn2.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_cnjg.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cnjg.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_cos.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cos.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_cosh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cosh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_dim.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_dim.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_exp.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_exp.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_imag.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_imag.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_int.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_int.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_lg10.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_lg10.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_log.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_log.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_mod.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_mod.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_nint.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_nint.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_sign.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sign.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_sin.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sin.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_sinh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sinh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_sqrt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sqrt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_tan.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_tan.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/r_tanh.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/r_tanh.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/rawio.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/rawio.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/rdfmt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/rdfmt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/rewind.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/rewind.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/rsfe.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/rsfe.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/rsli.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/rsli.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/rsne.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/rsne.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/s_cat.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/s_cat.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/s_cmp.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/s_cmp.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/s_copy.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/s_copy.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/s_paus.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/s_paus.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/s_rnge.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/s_rnge.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/s_stop.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/s_stop.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/sfe.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/sfe.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/sig_die.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/sig_die.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/signal1.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/signal1.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/signal_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c) | 10 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/signbit.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/signbit.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/sue.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/sue.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/sysdep1.h (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/system_.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/system_.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/typesize.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/typesize.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/uio.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/uio.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/uninit.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/uninit.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/util.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/util.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/wref.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/wref.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/wrtfmt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/wrtfmt.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/wsfe.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/wsfe.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/wsle.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/wsle.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/wsne.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/wsne.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/xwsne.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/xwsne.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_abs.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_abs.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_cos.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_cos.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_div.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_div.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_exp.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_exp.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_log.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_log.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_sin.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_sin.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/libf2c/z_sqrt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/libf2c/z_sqrt.c) | 0 | ||||
-rwxr-xr-x | Build/source/utils/pmx/pmx-src/pmx.test (renamed from Build/source/utils/pmx/pmx-2.7.0/pmx.test) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/pmx273.for (renamed from Build/source/utils/pmx/pmx-2.7.0/pmx270.for) | 1305 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/pmx273.for.orig (renamed from Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig) | 1307 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/pmxab.c (renamed from Build/source/utils/pmx/pmx-2.7.0/pmxab.c) | 27104 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/scor2prt.c (renamed from Build/source/utils/pmx/pmx-2.7.0/scor2prt.c) | 1553 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/scor2prt.for (renamed from Build/source/utils/pmx/pmx-2.7.0/scor2prt.for) | 24 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/tests/barsant.mid (renamed from Build/source/utils/pmx/pmx-2.7.0/tests/barsant.mid) | bin | 3071 -> 3071 bytes | |||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/tests/barsant.pml (renamed from Build/source/utils/pmx/pmx-2.7.0/tests/barsant.pml) | 2 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/tests/barsant.pmx (renamed from Build/source/utils/pmx/pmx-2.7.0/tests/barsant.pmx) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/tests/barsant.tex (renamed from Build/source/utils/pmx/pmx-2.7.0/tests/barsant.tex) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/tests/barsant1.pmx (renamed from Build/source/utils/pmx/pmx-2.7.0/tests/barsant1.pmx) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/tests/barsant2.pmx (renamed from Build/source/utils/pmx/pmx-2.7.0/tests/barsant2.pmx) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/version.ac (renamed from Build/source/utils/pmx/pmx-2.7.0/version.ac) | 2 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmx-src/w32getc.c (renamed from Build/source/utils/pmx/pmx-2.7.0/w32getc.c) | 0 | ||||
-rw-r--r-- | Build/source/utils/pmx/pmxab.1 | 8 | ||||
-rw-r--r-- | Build/source/utils/pmx/scor2prt.1 | 2 | ||||
-rw-r--r-- | Build/source/utils/pmx/version.ac | 2 |
212 files changed, 28476 insertions, 5182 deletions
diff --git a/Build/source/utils/README b/Build/source/utils/README index ab8b58ce8e7..ac77c5346d5 100644 --- a/Build/source/utils/README +++ b/Build/source/utils/README @@ -18,7 +18,7 @@ lacheck - maintained here, by us m-tx 0.61 - checked 17dec15 http://mirror.ctan.org/support/m-tx/ -pmx 2.7.0 - checked 25nov14 +pmx 2.7.3 - checked 10feb16 http://mirror.ctan.org/support/pmx/ ps2eps 1.68 - checked 10may12 diff --git a/Build/source/utils/pmx/ChangeLog b/Build/source/utils/pmx/ChangeLog index 9297ae9e6a3..fad64ea7ff8 100644 --- a/Build/source/utils/pmx/ChangeLog +++ b/Build/source/utils/pmx/ChangeLog @@ -1,3 +1,7 @@ +2016-02-10 Akira Kakuto <kakuto@fuk.kindai.ac.jp> + + * Import pmx 2.7.3. + 2015-07-07 Peter Breitenlohner <peb@mppmu.mpg.de> * Makefile.am: Better dependencies for 'make check'. diff --git a/Build/source/utils/pmx/configure b/Build/source/utils/pmx/configure index f6719bae451..7194bf0d72c 100755 --- a/Build/source/utils/pmx/configure +++ b/Build/source/utils/pmx/configure @@ -1,6 +1,6 @@ #! /bin/sh # Guess values for system-dependent variables and create Makefiles. -# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.7.0. +# Generated by GNU Autoconf 2.69 for pmx (TeX Live) 2.7.3. # # Report bugs to <tex-k@tug.org>. # @@ -580,12 +580,12 @@ MAKEFLAGS= # Identity of this package. PACKAGE_NAME='pmx (TeX Live)' PACKAGE_TARNAME='pmx--tex-live-' -PACKAGE_VERSION='2.7.0' -PACKAGE_STRING='pmx (TeX Live) 2.7.0' +PACKAGE_VERSION='2.7.3' +PACKAGE_STRING='pmx (TeX Live) 2.7.3' PACKAGE_BUGREPORT='tex-k@tug.org' PACKAGE_URL='' -ac_unique_file="pmx-2.7.0/pmxab.c" +ac_unique_file="pmx-src/pmxab.c" # Factoring default headers for most tests. ac_includes_default="\ #include <stdio.h> @@ -1278,7 +1278,7 @@ if test "$ac_init_help" = "long"; then # Omit some internal or obsolete options to make the list less imposing. # This message is too long to be a string in the A/UX 3.1 sh. cat <<_ACEOF -\`configure' configures pmx (TeX Live) 2.7.0 to adapt to many kinds of systems. +\`configure' configures pmx (TeX Live) 2.7.3 to adapt to many kinds of systems. Usage: $0 [OPTION]... [VAR=VALUE]... @@ -1344,7 +1344,7 @@ fi if test -n "$ac_init_help"; then case $ac_init_help in - short | recursive ) echo "Configuration of pmx (TeX Live) 2.7.0:";; + short | recursive ) echo "Configuration of pmx (TeX Live) 2.7.3:";; esac cat <<\_ACEOF @@ -1441,7 +1441,7 @@ fi test -n "$ac_init_help" && exit $ac_status if $ac_init_version; then cat <<\_ACEOF -pmx (TeX Live) configure 2.7.0 +pmx (TeX Live) configure 2.7.3 generated by GNU Autoconf 2.69 Copyright (C) 2012 Free Software Foundation, Inc. @@ -1835,7 +1835,7 @@ cat >config.log <<_ACEOF This file contains any messages produced by compilers while running configure, to aid debugging if configure makes a mistake. -It was created by pmx (TeX Live) $as_me 2.7.0, which was +It was created by pmx (TeX Live) $as_me 2.7.3, which was generated by GNU Autoconf 2.69. Invocation command line was $ $0 $@ @@ -3758,7 +3758,7 @@ fi # Define the identity of the package. PACKAGE='pmx--tex-live-' - VERSION='2.7.0' + VERSION='2.7.3' cat >>confdefs.h <<_ACEOF @@ -5380,7 +5380,7 @@ if test $ac_cv_sizeof_long_long -lt 8; then PMX_DEFINES="$PMX_DEFINES -DNO_LONG_LONG" fi -PMX_TREE=pmx-2.7.0 +PMX_TREE=pmx-src ac_config_files="$ac_config_files Makefile" @@ -5963,7 +5963,7 @@ cat >>$CONFIG_STATUS <<\_ACEOF || ac_write_fail=1 # report actual input values of CONFIG_FILES etc. instead of their # values after options handling. ac_log=" -This file was extended by pmx (TeX Live) $as_me 2.7.0, which was +This file was extended by pmx (TeX Live) $as_me 2.7.3, which was generated by GNU Autoconf 2.69. Invocation command line was CONFIG_FILES = $CONFIG_FILES @@ -6020,7 +6020,7 @@ _ACEOF cat >>$CONFIG_STATUS <<_ACEOF || ac_write_fail=1 ac_cs_config="`$as_echo "$ac_configure_args" | sed 's/^ //; s/[\\""\`\$]/\\\\&/g'`" ac_cs_version="\\ -pmx (TeX Live) config.status 2.7.0 +pmx (TeX Live) config.status 2.7.3 configured by $0, generated by GNU Autoconf 2.69, with options \\"\$ac_cs_config\\" diff --git a/Build/source/utils/pmx/configure.ac b/Build/source/utils/pmx/configure.ac index 86967e1c173..d84d82c4db3 100644 --- a/Build/source/utils/pmx/configure.ac +++ b/Build/source/utils/pmx/configure.ac @@ -9,7 +9,7 @@ dnl m4_include([version.ac])[] dnl define pmx_version AC_INIT([pmx (TeX Live)], pmx_version, [tex-k@tug.org]) AC_PREREQ([2.65]) -AC_CONFIG_SRCDIR([pmx-]pmx_version[/pmxab.c]) +AC_CONFIG_SRCDIR([pmx-src/pmxab.c]) AC_CONFIG_AUX_DIR([../../build-aux]) AC_CONFIG_MACRO_DIR([../../m4]) @@ -40,7 +40,7 @@ if test $ac_cv_sizeof_long_long -lt 8; then PMX_DEFINES="$PMX_DEFINES -DNO_LONG_LONG" fi -AC_SUBST([PMX_TREE], [pmx-]pmx_version) +AC_SUBST([PMX_TREE], [pmx-src]) AC_CONFIG_FILES([Makefile]) AC_OUTPUT 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 deleted file mode 100644 index b2662315f34..00000000000 --- a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/patch-01-ptr-to-int +++ /dev/null @@ -1,16 +0,0 @@ -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/PATCH-pmx270.for-1 b/Build/source/utils/pmx/pmx-2.7.0/PATCH-pmx270.for-1 deleted file mode 100644 index 332ef603ee2..00000000000 --- a/Build/source/utils/pmx/pmx-2.7.0/PATCH-pmx270.for-1 +++ /dev/null @@ -1,142 +0,0 @@ -*** 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 deleted file mode 100644 index 54656fad837..00000000000 --- a/Build/source/utils/pmx/pmx-2.7.0/PATCH-scor2prt.for-1 +++ /dev/null @@ -1,182 +0,0 @@ -*** 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/scor2prt.for.orig b/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for.orig deleted file mode 100644 index 1343f76ac32..00000000000 --- a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for.orig +++ /dev/null @@ -1,1621 +0,0 @@ -cccccccccccccccccccccccccc -cc -cc scor2prt 7/24/11 for PMX 2.615 -cccccccccccccccccccccccccc -c This program, developed by Don Simons (dsimons@roadrunner.com), is -c part of the PMX distribution, PMX is a preprocessor for MusiXTeX. In concert -c with MusiXTeX and TeX, the purpose of PMX is to allow the user to create -c high-quality typeset musical scores by including a sequence of PMX commands -c in an ASCII input file. Scor2prt is an auxiliary program that creates PMX -c input files for individual parts from the PMX input file for the score. -c -c This program is free software: you can redistribute it and/or modify -c it under the terms of the GNU General Public License as published by -c the Free Software Foundation, either version 3 of the License, or -c (at your option) any later version. -c -c This program is distributed in the hope that it will be useful, -c but WITHOUT ANY WARRANTY; without even the implied warranty of -c MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the -c GNU General Public License for more details. -c -c You should have received a copy of the GNU General Public License -c along with this program. If not, see <http://www.gnu.org/licenses/>. -c -c -c 4/9/12 -c Add logical declarations to subroutine dosetup -c 8/8/11 -c Copy & mod Ki into parts when after beginning. -c 7/18/11 -c Start to fix up for AS..., also Ki was done a little earlier. -c 7/5/10 -c Modify Manual to explain extended hex numbering for part-specific comments -c 5/16/10 -c Extend part-specific comments for up to 24 parts (subroutine chkcom) -c Allow files 11-34 for parts -c Change file 30 to 40 -c 6/1/08 es2p -c noimax = 24 -c -c To do -c Override fracindent, musicsize? -c Deal with midbar R? -c 2/29/04 -c Check for special character being in quoted string. -c 10/20/02 PMX 2.407 -c Interpret AN[n]"[used-defined-part-file-name]" -c 1/21/02 -c Deals with rm in multiple parts. -c s2p15 -c Get right non-tex index even if there's "\" inside D"..." -c s2p14 -c 10/29/00 fix transfer to parts of negative mtrdnp -c 4/29/00 screen for "%%" followed by "T" -c Restore change from "Version 2.1a, 21 Dec" -c s2p13 -c Allow whole-bar double-whole rests. -c Bypass MIDI commands "I..." achar(10)="I" -c s2p12 -c Let %ablabla ... %cblabla represent pmx input for parts 10-12. But %?blabla -c only taken as such if ? represents a hex digit .le. noinst, otherwise it's -c a simple comment. This lessens incompatibility. -c In subroutine mbrest, properly open parts 10-12 if needed -c s2p11 -c Ignore leading blanks -c Fix undefined linelength in mbrest at very end of comments. -c s2p10 -c Fix non-transfer of P..c" " -c Allow "%%" and "%"n anywhere -c Version 1.43 -c Fix bug with P in TeX string. -c Ignore shifted whole-bar rests when consolidating whole-bar rests -c Copy type 4 TeX into all parts. -c Deal with XB and XP. -c Permit transfer of blank line into parts -c Change staves/inst in 'M' command. -c Arbitrary staves/inst. -c Recognize m1/2/3/4 syntax. -c Enable comment and one-voice syntax in instrument names -c -c Changes since 1.1 -c Deal with saved macros. -c Revise setup readin, to admit comments. -c Do not copy 'X' into parts -c -cccccccccccccccccccccccccccccccccccccccccccccccc - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - integer*4 ludpfn(noimax) - character*1 sq,achar(10) - character*2 termsym - character*27 jobname,infileq - character*128 instrum(noimax),udpfnq(noimax) - character*128 line,holdln,templine - logical termrpt,isachar,frstln,oneof2,botv,clefpend,fexist, - * insetup,replacing,gotname,yesodd - data achar /'P','m','V','R','A','h','w','K','M','I'/ - clefpend = .false. - insetup = .true. - replacing = .false. - frstln = .true. - lenhold = 0 - sq = char(92) - print*,'This is scor2prt for PMX 2.7, 2 April 2013' - numargs = iargc() - if (numargs .eq. 0) then - print*,'You could have entered a jobname on the command line,' - print*,' but you may enter one now:' - 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 - print*,'No was jobname entered. Restart and try again.' - stop - end if -c -c Strip ".pmx" if necessary -c - ndxpmx = max(index(jobname,'.pmx'),index(jobname,'.PMX')) - if (ndxpmx .gt. 0) then - jobname = jobname(1:ndxpmx-1) - ljob = ljob-4 - end if -c -c Check for existence of input file -c - infileq = jobname(1:ljob)//'.pmx' - inquire(file=infileq,EXIST=fexist) - if (.not.fexist) then - print*,'Cannot find file '//infileq - stop - end if - open(10,file=jobname(1:ljob)//'.pmx') -c -c Open all instrument files now for allparts stuff. Later disgard those >nv -c - do 19 iv = 1 , noimax - iorig(iv) = iv - open(10+iv,status='SCRATCH') - ludpfn(iv) = 0 -19 continue - read(10,'(a)')line - call chkcom(line) - if (line(1:3) .eq. '---') then - call allparts(line,128) -31 read(10,'(a)')line - if (line(1:3) .ne. '---') then - call allparts(line,128) - go to 31 - end if - call allparts(line,128) - read(10,'(a)')line - call chkcom(line) - end if - iccount = 0 - nv = readin(line,iccount,1)+.1 - noinst = readin(line,iccount,2)+.1 - if (noinst .gt. 0) then - nvi(1) = nv-noinst+1 - else - noinst = 1-noinst - do 21 iinst = 1 , noinst - nvi(iinst) = readin(line,iccount,-1)+.1 -21 continue - end if - noinow = noinst - insnow = 1 -c -c ivlast is last iv in current inst. instnum(iv) is iinst for current voice. -c - ivlast = nvi(1) - 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, -c so botv(1) is left .false. -c - if (insnow .lt. noinst) then - insnow = insnow+1 - ivlast = ivlast+nvi(insnow) - end if - end if -22 continue - mtrnuml = readin(line,iccount,0)+.1 - mtrdenl = readin(line,iccount,0)+.1 - mtrnmp = readin(line,iccount,0)+.1 - mtrdnp = readin(line,iccount,0)+.1 - xmtrnum0 = readin(line,iccount,0) - isig = readin(line,iccount,0)+.1 - npages = readin(line,iccount,3)+.1 - nsyst = readin(line,iccount,0)+.1 - musicsize = readin(line,iccount,4)+.1 - fracindent = readin(line,iccount,5) - if (npages .eq. 0) then - print*, - *'You entered npages=0, which means nsyst is not the total number' - print*, - *'of systems. Scor2prt has to know the total number of systems.' - print*, - *'Please set npages and nsyst to their real values.' - stop - end if -c -c Must leave insetup=.true. else could bypass ALL instrument names. -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 - call allparts(instrum(iv),128) - go to 16 - else - line = instrum(iv)(3:) - instrum(iv) = line - gotname = .true. - end if - else - gotname = .true. - end if -cc -cc The following checks for macro that write original C-clef as part of -cc instrument name. See pmx.tex -cc -c if (index(instrum(iv),'namewpc') .eq. 0) then -c write(10+iv,'(a)')' ' -c else -c inm1 = index(instrum(iv),'{')+1 -c inm2 = index(instrum(iv),'}')-1 -c read(instrum(iv)(inm2+2:inm2+8),'(i1,4x,2i1)')ilev,iy1,iy2 -c write(10+iv,'(a)')sq//'namewpc{}'//char(ilev+48)//'{20}'// -c * char(iy1+49)//char(iy2+49) -c instrum(iv) = instrum(iv)(inm1:inm2) -c end if - if (.not.gotname) then - print*,'You must provide a replacement instrument name' - stop - end if - write(10+iv,'(a)')' ' -14 continue - replacing = .false. - nvnow = nv -c -c Clef string: Note insetup is still T, so "%%" will be treated specially -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. -c - read(10,'(a)')line - call chkcom(line) - backspace(10) - else -c -c If here, line has the clef string in it. Handle the old way -c - kvstart = 1 - kvend = nvi(1) - do 2 inst = 1 , noinst - write(10+inst,'(a'//char(48+nvi(inst))//')') - * line(kvstart:kvend) - if (inst .lt. noinst) then - kvstart = kvend+1 - kvend = kvstart+nvi(inst+1)-1 - end if -2 continue - end if - replacing = .false. - insetup = .false. -c -c *****NOTE*****This comment applies to stuff done earlier! -c Before starting the big loop, copy initial instnum and staffnum stuff -c into working values. Latter may change if noinst changes. Also make -c list of current inst nums relative to original ones. In addition to those -c below, must redo instnum(iv) and botv(iv) when we change noinst. -c -c Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! -c -18 read(10,'(a)') line - if (line(1:1) .eq. '%') then - call allparts(line,128) - go to 18 - end if - call allparts(line,128) -c -c Write instrument names. Will be blank if later part of a score. -c - if (instrum(1)(1:1) .ne. ' ') then - do 3 iv = 1 , noinst - len = lenstr(instrum(iv),79) - write(10+iv,'(a2/a)')'Ti',instrum(iv)(1:len) -3 continue - end if -c -c The big loop. Except for '%%', put all comment lines in all parts. -c Unless preceeded by '%%', put all type 2 or 3 TeX Strings in all parts -c If a line starts with %!, put the rest of it in each part. -c If a line starts with %[n], put the rest of it in part [n]. -c Check for Tt, Tc, Voltas, Repeats, headers, lower texts, meter changes. -c Assume they only come at top of block, except terminal repeat needs -c special handling. -c Check for "P"; ignore in parts. -c Check for consecutive full-bar rests; if found, replace with rm[nn] -c - iv = 1 - iinst = 1 - termrpt = .false. -4 read(10,'(a)',end=999)line - lenline = lenstr(line,128) - if (lenline .eq. 0) go to 4 - 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 - call allparts(line,128) - go to 4 - else if (line(1:2) .eq. sq//sq) then - call allparts(line,128) - go to 4 - else if (index('hl',line(1:1)).gt.0 .and. - * index(' +-',line(2:2)) .gt. 0) then - call allparts(line,128) - read(10,'(a)')line - call allparts(line,128) - go to 4 - else if (iv .eq. 1) then - do 5 ia = 1 , 10 -24 continue - idxa = ntindex(line,achar(ia)) - isachar = idxa .gt. 0 - if (idxa.gt.1) isachar = line(idxa-1:idxa-1).eq.' ' -c -c 1 2 3 4 5 6 7 8 9 10 -c data achar /'P','m','V','R','A','h','w','K','M','I'/ -c - if (ia .eq. 9) isachar = - * isachar .and. line(idxa+1:idxa+1).eq.'S' - if (isachar) then -c -c Check whether character is inside a quoted string by counting -c how many quotes precede it in the line -c - - call OddQuotesBefore(line,idxa,yesodd) - if (yesodd) isachar=.false. - end if - if (isachar) then -c -c Find next blank -c - do 6 ib = idxa+1 , 128 - if (line(ib:ib) .eq. ' ') go to 7 -6 continue - print*,'Problem with "V,R,m,P,A,h,MS, or w"' - print*, - * 'Send files to Dr. Don at dsimons at roadrunner dot com' - stop 1 -7 continue -c -c Next blank is at position ib. Later, if ia=1, must check for Pc" " ; -c i.e., look for '"' between P and blank -c - if (ia .eq. 4) then -c -c Check for terminal repeat. Note if there's a term rpt, there can't be any -c others. Also, must process repeats LAST, after m's and 'V's -c - do 8 ic = ib+1 , 128 -c -c If any subsequent character on this line is neither blank nor "/", get out -c - if (index(' /',line(ic:ic)) .eq. 0) go to 9 - if (line(ic:ic) .eq. '/') then - termrpt = .true. - termsym = line(ib-2:ib-1) -c -c Process the line as if there were no "R" -c - go to 10 - end if -8 continue -c -c +++ 060812 -c If here, all chars after "R" symbol are blanks, so process the line normally, -c but only IF next line is not the M-Tx line " /" -c - read(10,'(a)')templine - if (templine(1:2) .ne. ' /') then - backspace(10) ! and flow out - else -c -c We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, -c and proceed as above -c - line = line(1:ib)//'/' - lenline = lenline+2 - termrpt = .true. - termsym = line(ib-2:ib-1) - go to 10 - end if -c +++ 060812 -c - else if (ia .eq. 1) then - idxq = ntindex(line,'"') - if (idxq.gt.idxa .and. idxq.lt.ib) then -c -c Quote is between P and next blank. Find 2nd quote, starting at the blank. -c - idxq2 = ib-1+ntindex(line,'"') - if (idxq.eq.0 .or. line(idxq2+1:idxq2+1).ne.' ') then - print* - print*,'Error copying P with quotes, idxq2:',idxq2 - print*,line(1:60) - stop 1 - end if - ib = idxq2+1 - end if -c -c Do not transfer P into parts. -c - go to 12 - else if (ia .eq. 9) then -c -c Start Saving a macro. After leaving here, a symbol will be sent to all parts, -c If all on this line, set ib to end and exit normally. -c - ndxm = index(line(ib+1:128),'M') - if (ndxm.gt.0 .and. line(ib+ndxm-1:ib+ndxm-1).eq.' ') then -c -c Macro ends on this line -c - ib = ib+ndxm+1 - else -c -c Save leading part of current line -c - lenhold = idxa-1 - if (lenhold .gt. 0) holdln = line(1:lenhold) -c -c Transfer rest of line -c - call allparts(line(idxa:128),129-idxa) -c -c Read next line -c -20 read(10,'(a)')line -c -c Check for comment, transfer and loop if so -c -c if (line(1:1) .eq.'%') then -23 if (line(1:1) .eq.'%') then -c call allparts(line,128) -c go to 20 - call chkcom(line) - go to 23 - end if -c -c Look for terminal ' M' -c - if (line(1:1) .eq. 'M') then - ndxm = 1 - else - ndxm = index(line,' M') - if (ndxm .gt. 0) ndxm = ndxm+1 - end if - if (ndxm .gt. 0) then -c -c Set parameters, exit normally (but later check for leading part of 1st line -c - idxa = 1 - ib = ndxm+1 - else -c -c No "M", transfer entire line, loop -c - call allparts(line,128) - go to 20 - end if - end if - else if (ia .eq. 10) then -c -c Do not transfer MIDI command into parts -c - go to 12 - else if (ia .eq. 5) then -c -c First check for "AS", but S may come after other "A" options -c - idxS = index(line(idxa+1:ib),'S') - if (idxS .gt. 0) then -c -c Get rid of the string. First check if that's all there is in A. -c - if (ib-idxa .eq. nv+2) go to 12 - line = line(1:idxa+idxS-1)//line(idxa+idxS+nv+1:ib) - end if -c -c Check for user-defined part file name. Must start in column 1 and have -c AN[n]"userfilename". -c idxa is position of "A" -c ib is position of the next blank after "A" -c Don't allow any blanks in user -c - if (line(idxa+1:idxa+1) .ne. 'N') go to 9 ! bail out - if (idxa .ne. 1) then - print* - print*, - * 'You entered "AN..." somewhere beyond first column; stopping.' - stop 1 - end if -c -c pmxa already checked for valid one- or 2-digit number, so get it -c - if (line(4:4) .eq. '"') then -c -c Single digit instrument number -c - read(line(3:3),'(i1)')iudpfn - idxstartname = 5 - else - read(line(3:4),'(i2)')iudpfn - idxstartname = 6 - end if - ludpfn(iudpfn) = index(line(idxstartname:128),'"')-1 - if (ludpfn(iudpfn) .lt. 0) then - print* - print*,'User-defined part file name must be in quotes' - stop 1 - end if - idxendname = idxstartname+ludpfn(iudpfn)-1 - udpfnq(iudpfn) = line(idxstartname:idxendname) -c -c Get a new line! -c - go to 4 - else if (ia .eq. 8) then -c -c Key change/transposition. -c If not instrument specific, copy to all parts -c - if (line(idxa+1:idxa+1).ne.'i') go to 9 -c -c Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... -c - ibb = idxa+2 ! Starts on digit after 'i' -40 continue - read(line(ibb:ibb),'(i1)')iiinst ! 1st digit of iinst - itemp = (index('01234567890',line(ibb+1:ibb+1))) - if (itemp.gt.0) then - ibb = ibb+1 - iiinst = 10*iiinst+itemp-1 - end if - ibb = ibb+1 ! now at first +/-. Need end of 2nd number - itemp = index(line(ibb+1:ib),'i') ! Rel pos'n of next 'i' or 0 - if (itemp .gt. 0) then - iend = ibb+itemp-1 - else - iend = ib-1 - end if - write(10+iorig(iiinst),'(a)')'Ki1'//line(ibb:iend) - if (itemp .gt. 0) then - ibb = iend+2 - go to 40 - end if - go to 12 ! Remove K command from string, go to next ia - end if -9 continue - call allparts(line(idxa:ib-1),ib-idxa) -12 continue -c -c Remove the string from line -c - if (idxa .eq. 1) then - line = line(ib:128) - else - line = line(1:idxa-1)//line(ib:128) - end if - lenline = lenstr(line,128) -c -c Loop if only blanks are left -c - if (lenline .eq. 0) go to 4 -c -c Must check for multiple "I" commands, so go to just after start of ia loop -c - if (ia .eq. 10) go to 24 -c -c Tack on front part from 1st line of saved macro -c - if (lenhold .gt. 0) then - line = holdln(1:lenhold)//' '//line(1:lenline) - lenhold = 0 - end if - end if -5 continue - end if -c -c Now a special loop to deal with 'X'. If it was %[n]X..., will have been -c copied into part [n] already. If no "B" or "P", remove. If "P", just -c remove the "P" so pmxa/b will process. If "B". do nothing. -c -10 continue - nchk = 1 -13 ntinx = nchk-1+ntindex(line(nchk:),'X') - if (ntinx .gt. nchk-1) then -c -c There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. -c - if (ntinx.gt.1) then - if (line(ntinx-1:ntinx-1).ne.' ') then -c -c The X is not 1st char of PMX command. Advance starting point, loop. -c - nchk = ntinx+1 - go to 13 - end if - end if -c -c We now know the X at ntinx starts a PMX command. Find next blank -c - ib = ntinx+index(line(ntinx+1:),' ') -c -c There must be a blank to right of "X", so ib>ntinx -c -c locp = nchk-1+index(line(nchk:ib),'P') - locp = ntinx+index(line(ntinx+1:ib),'P') -c -c Did not need to use ntindex because we already know bounds of PMX command. -c -c if (locp .gt. nchk-1) then - if (locp .gt. ntinx) then -c -c Strip out the 'P' -c - templine = line(1:locp-1) - line = templine(1:locp-1)//line(locp+1:lenline) - lenline = lenline-1 - ib = ib-1 - end if - if (index(line(ntinx:ib),':').gt.0 .or. - * index(line(ntinx:ib),'S').gt.0 .or. - * index(line(ntinx:ib),'B').gt.0 .or. locp.gt.ntinx) then -c -c The X command is a shift, "Both", or "Part". Do not remove. -c - nchk = ib+1 - go to 13 - end if -c -c Remove the X command. -c - if (ntinx .eq. 1) then - if (ib .lt. lenline) then - line = line(ib+1:lenline) - else -c -c line contains ONLY the "X" command, so get a new line -c - go to 4 - end if - else - templine = line(1:ntinx-1) - if (ib .lt. lenline) then - line = templine(1:ntinx-1)//line(ib+1:lenline) - else - line = templine(1:ntinx-1) - end if - end if -c -c Recompute lenline -c - lenline = lenstr(line,128) -c -c Resume checking after location of removed command. -c - nchk = ntinx - go to 13 - end if -c -c End of loop for X-checks -c - oneof2 = ntindex(line,'//') .gt. 0 - if (termrpt .and. botv(iv) .and. frstln .and. - * line(lenline:lenline).eq.'/') then -c -c Must add a terminal repeat before the slash -c - if (oneof2) lenline = lenline-1 - if (lenline.gt.1) write(10+iorig(iinst),'(a)')line(1:lenline-1) - if (.not. oneof2) then - line = termsym//' /' - lenline = 4 - else - line = termsym//' //' - lenline = 5 - end if - end if - if (termrpt .and. frstln .and. line(lenline:lenline).eq.'/' .and. - * iv.eq.nvnow) termrpt = .false. - write(10+iorig(iinst),'(a)')line(1:lenline) - if (oneof2) then - frstln = .false. - else if (.not.frstln) then - frstln = .true. - end if -c if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then - if (ntindex(line,'/').gt.0 .and. ntindex(line,'//').eq.0) then - iv = 1+mod(iv,nvnow) - iinst = instnum(iv) - end if - go to 4 -999 continue - close(10) -c -c In the mbrest checks, must run through ALL noinst files (not just noinow) -c - do 11 iinst = 1 , noinst -ccc+++ -cc -cc Temporarily transfer entire scratch file to real file -cc -c rewind(10+iinst) -c open(40,file='s2pout'//char(48+iinst)//'.pmx') -c do 50 m = 1 , 10000 -c read(10+iinst,'(a)',end=51)line -c lenline = lenstr(line,128) -c if (lenline .ge. 1) then -c write(40,'(a)')line(1:lenline) -c else -c write(40,'(a)')' ' -c end if -c50 continue -c51 continue -c close(40) -ccc+++ - if (nvi(iinst) .eq. 1) then - call mbrests(iinst,jobname,ljob,ludpfn(iinst),udpfnq(iinst)) - else -c -c Send a signal with ljob to bypass most mbrest processing -c - call mbrests(iinst,jobname,-ljob,ludpfn(iinst),udpfnq(iinst)) - end if -11 continue - end - function lenstr(string,n) - character*(*) string - do 1 lenstr = n , 1 , -1 - if (string(lenstr:lenstr) .ne. ' ') return -1 continue - lenstr = 0 - return - end - subroutine allparts(string,n) - parameter (noimax=24) - character*(*) string - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,botv - len = lenstr(string,n) - if (len .eq. 0) then - len = 1 - string = ' ' - end if - do 1 iinst = 1 , noinow - write(10+iorig(iinst),'(a)')string(1:len) -1 continue - return - end - subroutine mbrests(iv,jobname,ljob,ludpfn,udpfnq) - character*128 line(50),line1,udpfnq - character*80 sym - character*12 jobname - character*3 wbrsym(2) - character*2 partq - character*1 sq - logical wbrest,alldone,rpfirst,newmtr,type4 - type4 = .false. - sq = char(92) - alldone = .false. - rewind(10+iv) - if (iv .lt. 10) then - partq(1:1) = char(48+iv) - lpart = 1 - else - lpart = 2 - if (iv .lt. 20) then - partq = '1'//char(38+iv) - else - partq = '2'//char(28+iv) - end if - end if -c 130327 -c open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') - if (ludpfn .eq. 0) then - open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') - else - open(40,file=udpfnq(1:ludpfn)//'.pmx') - end if - do 10 i = 1 , 10000 - read(10+iv,'(a)')line(1) - if (line(1)(1:1).eq.'%' .or. line(1)(1:3).eq.'---' - * .or. type4) then - len = lenstr(line(1),128) - if (len .gt. 0) then - write(40,'(a)')line(1)(1:len) - else - write(40,'(a)')' ' - end if - if (line(1)(1:3).eq.'---') type4 = .not.type4 - else - go to 11 - end if -10 continue - print*,'You should not be here in scor2prt. Call Dr. Don' - stop -11 continue -c -c Finished reading opening type4 TeX and comments. Next line to be read -c will contain the first of the input numbers -c - call dosetup(iv,line(1),mtrnum,mtrden) - do 1 i = 1 , 10000 -13 read(10+iv,'(a)',end=999)line(1) -7 len = lenstr(line(1),128) -c -c Pass-through (and copy into part file) if instrumnet has >1 voice. -c - if (ljob .lt. 0) go to 2 - if (index('TtTiTch+h-h l ',line(1)(1:2)) .gt. 0) then -c -c Traps titles, instruments, composers, headers, lower strings. Read 2 lines. -c - write(40,'(a)')line(1)(1:len) - read(10+iv,'(a)')line(1) - len = lenstr(line(1),128) - go to 2 - end if - if (i.eq.1 .or. (i.gt.5.and.line(1)(1:1).eq.'m')) then -c -c Either just starting, or a new meter is defined. -c NOTE! The above test may be bogus. -c - if (line(1)(1:1) .eq. '%') then - write(40,'(a)')line(1)(1:len) - go to 13 - end if - if (i .ne. 1) then -c -c New meter. Check for slashes (new meter change syntax) -c - idxs = index(line(1),'/') - idxb = index(line(1),' ') - newmtr = idxs.gt.0 .and. (idxb.eq.0 .or. idxs.lt.idxb) - if (.not.newmtr) then -c -c Old way, no slashes, uses 'o' for lonesome '1' -c - icden = 3 - if (line(1)(2:2) .eq. 'o') then - mtrnum = 1 - else - mtrnum = ichar(line(1)(2:2))-48 - if (mtrnum .eq. 1) then - icden = 4 - mtrnum = 10+ichar(line(1)(3:3))-48 - end if - end if - mtrden = ichar(line(1)(icden:icden))-48 - else -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:),'/') - 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 - lenmult = 2 - end if - lenbar = lenmult*mtrnum*lenbeat - call fwbrsym(lenbar,nwbrs,wbrsym,lwbrs) - end if -c -c Finished setting up meter stuff and defining whole-bar rest symbols -c - ip1 = 0 - line1 = line(1) - do 3 iw = 0 , nwbrs - if (iw .gt. 0) then - idx = ntindex(line1,wbrsym(iw)(1:lwbrs)) - if (idx .gt. 0) then -c -c Check for blank or shifted rest, discount it if it's there -c - if (line1(idx+lwbrs:idx+lwbrs).ne.' ') idx = 0 - end if - else - idx = ntindex(line1,'rp') -c -c Check for raised rest -c - if (idx.gt.0) then - if (line1(idx+2:idx+2).ne.' ') idx = 0 - end if - end if - if (idx .gt. 0) then - if (ip1 .eq. 0) then - ip1 = idx - else - ip1 = min(ip1,idx) ! Maybe allows e.g. r0 rp ... - end if - end if -3 continue - if (i.lt.5 .or. line(1)(1:1).eq.'%' .or. line(1)(1:2).eq.sq//sq - * .or. ip1.eq.0) go to 2 -c -c Switch to multibar rest search mode!!! Start forward in line(1) -c - rpfirst = line1(ip1:ip1+1) .eq. 'rp' - iline = 1 - nmbr = 1 - if (rpfirst) then - lwbrsx = 2 - else - lwbrsx = lwbrs - end if - ipe = ip1+lwbrsx-1 ! ip at end of 1st wbrsym -4 if (ipe .eq. len) then -c -c Need a new line -c - iline = iline+1 -6 read(10+iv,'(a)',end=998)line(iline) - len = lenstr(line(iline),128) - if (line(iline)(1:1).eq.'%' ) then - write(40,'(a)')'% Following comment has been moved forward' - write(40,'(a)')line(iline)(1:len) - go to 6 - end if - ipe = 0 - go to 4 -998 continue -c -c No more input left -c - print*,'All done!' - alldone = .true. - ipe = 0 - iline = iline-1 - len = lenstr(line(iline),128) - go to 4 - else - if (alldone) then - sym(1:1) = ' ' - else -c -c ipe<len here, so it's ok to get a symbol -c - call nextsym(line(iline),len,ipe,ipenew,sym,lsym) - end if -c -c Check for end of block or bar line symbol -c - if (index('/|',sym(1:1)) .gt. 0) then - ipe = ipenew - go to 4 - else - wbrest = .false. - if (alldone) go to 12 - do 5 iw = 1 , nwbrs - wbrest = wbrest .or. sym(1:lsym).eq.wbrsym(iw)(1:lwbrs) -5 continue - wbrest = wbrest .or. (sym(1:lsym).eq.'r'.and.lwbrs.eq.2) - * .or. (sym(1:lsym).eq.'rd'.and.lwbrs.eq.3) - * .or. (sym(1:lsym).eq.'rp') - * .or. (sym(1:lsym).eq.'r' .and. rpfirst) -12 if (wbrest) then - ipe = ipenew - nmbr = nmbr+1 - go to 4 - else -c -c AHA! Failed prev. test, so last symbol was *not* mbr. -c It must be saved, and its starting position is ipenew-lsym+1 -c - if (nmbr .gt. 1) then -c -c Write stuff up to start of mbr -c - if (ip1 .gt. 1) write(40,'(a)')line(1)(1:ip1-1) -c -c Insert mbr symbol. Always end with a slash just in case next sym must be -c at start of block. May think this causes undefined octaves, but -c probably not since it's a single voice. -c - ndig = int(alog10(nmbr+.01))+1 - print*,'Inserting rm, iv,nmbr:',iv,nmbr - write(40,'(a2,i'//char(48+ndig)//',a2)')'rm',nmbr,' /' - if (alldone) go to 999 - ipc = ipenew-lsym+1 - line(1) = line(iline)(ipc:len) - else -c -c Write old stuff up to end of original lonesome wbr, save the rest. -c 4 cases: (wbr /) , (wbr line-end) , (wbr followed by other non-/ symbols) , -c alldone. -c In 1st 2 will have gotten some other lines, so write all up to one b4 last -c non-comment line; then revert to normal mode on that. In 3rd case must -c split line. -c - if (alldone) then - write(40,'(a)')line(1)(1:len) - go to 999 - else if (iline .gt. 1) then - do 9 il = 1 , iline-1 - len = lenstr(line(il),128) - write(40,'(a)')line(il)(1:len) -9 continue - line(1) = line(iline) - else -c -c Since iline = 1 the wbr is not the last sym, so must split -c - write(40,'(a)')line(1)(1:ip1+lwbrsx-1) - line(1) = line(1)(ip1+lwbrsx+1:len) - end if - end if -c -c Exit multibar mode -c - go to 7 - end if - end if - end if -2 continue - if (len .gt. 0) then - write(40,'(a)')line(1)(1:len) - else - write(40,'(a)')' ' - end if -1 continue -999 continue - close(10+iv) - close(40) - return - end - function ifnodur(idur,dotq) - character*1 dotq - if (idur .eq. 6) then - ifnodur=1 - else if (idur .eq. 3) then - ifnodur=2 - else if (idur.eq.1 .or. idur.eq.16) then - ifnodur=4 - else if (idur .eq. 8) then - ifnodur=8 - else if (idur .eq. 4) then - ifnodur=16 - else if (idur .eq. 2) then - ifnodur=32 - else if (idur .eq. 0) then - ifnodur=64 - else - print*,'You entered an invalid note-length value' - stop - end if - if (dotq .eq. 'd') ifnodur = ifnodur*3/2 - return - end - subroutine fwbrsym(lenbar,nwbrs,wbrsym,lwbrs) - character*3 wbrsym(2) - nwbrs = 1 - lwbrs = 2 - if (lenbar .eq. 16) then - wbrsym(1) = 'r4' - else if (lenbar .eq. 32) then - wbrsym(1) = 'r2' - else if (lenbar .eq. 64) then - wbrsym(1) = 'r0' - else if (lenbar .eq. 8) then - wbrsym(1) = 'r8' - else if (lenbar .eq. 128) then - wbrsym(1) = 'r9' - else - nwbrs = 2 - lwbrs = 3 - if (lenbar .eq. 24) then - wbrsym(1) = 'rd4' - wbrsym(2) = 'r4d' - else if (lenbar .eq. 48) then - wbrsym(1) = 'rd2' - wbrsym(2) = 'r2d' - else if (lenbar .eq. 96) then - wbrsym(1) = 'rd0' - wbrsym(2) = 'r0d' - else - write(*,'(33H Any whole-bar rests of duration ,i3, - * 26H/64 will not be recognized)') lenbar - end if - end if - return - end - subroutine nextsym(line,len,ipeold,ipenew,sym,lsym) -c -c Know its the last symbol if on return ipenew = len!. So should never -c be called when ipstart=len. -c - character*128 line - character*80 sym - if (ipeold .ge. len) then - print*,'Called nextsym with ipstart>=len ' - print*,'Send files to Dr. Don at dsimons@logicon.com' - stop - end if - do 1 ip = ipeold+1 , len - if (line(ip:ip) .ne. ' ') then -c -c symbol starts here (ip). We're committed to exit the loop. -c - if (ip .lt. len) then - do 2 iip = ip+1 , len - if (line(iip:iip) .ne. ' ') go to 2 -c -c iip is the space after the symbol -c - ipenew = iip-1 - lsym = ipenew-ip+1 - sym = line(ip:ipenew) - return -2 continue -c -c Have len>=2 and ends on len -c - ipenew = len - lsym = ipenew-ip+1 - sym = line(ip:ipenew) - return - else -c -c ip = len -c - ipenew = len - lsym = 1 - sym = line(ip:ip) - return - end if - end if -1 continue - print*,'Error #3. Send files to Dr. Don at dsimons@logicon.com' - end - function ntindex(line,s2q) -c -c Returns index(line,s2q) if NOT in TeX string, 0 otherwise -c - character*(*) s2q - character*128 line,tline - logical intex -c -c print*,'Starting ntindex. s2q:',s2q,', line(1:79) is below' -c print*,line(1:79) -c -c -c Use a temporary string to store the input and test, so can zap D"..." -c - tline = line - ndxs2 = index(tline,s2q) -c -c Return point below for rechecks after zapping D" " -c -2 continue - ndxbs = index(tline,char(92)) - if (ndxbs .gt. 0) then -c -c Special check in case \ is inside D"..." -c - ndxDq1 = index(tline,'D"') -c -c If the following test fails, flow out of if block; else loop up to 2. -c - if (ndxDq1 .gt. 0) then -c -c Find end of D"..." -c - ndxDq2 = ndxDq1+1+index(tline(ndxDq1+2:128),'"') - if (ndxDq2 .eq. ndxDq1+1) then - print*,'Something is really wierd here' - stop - end if - tline = tline(1:ndxDq1-1) - do 3 ic = ndxDq1 , ndxDq2 - tline = tline(1:ic-1)//' ' -3 continue - tline = tline(1:ndxDq2)//line(ndxDq2+1:128) - go to 2 - end if - end if - if (ndxbs.eq.0 .or. ndxs2.lt.ndxbs) then - ntindex = ndxs2 -c print*,'No bs, or char is left of 1st bs, ntindex:',ntindex - else -c -c There are both bs and s2q, and bs is to the left of sq2. So check bs's to -c right of first: End is '\ ', start is ' \' -c - len = lenstr(tline,128) - intex = .true. -c print*,'intex+>',intex - do 1 ic = ndxbs+1 , len - if (ic .eq. ndxs2) then - if (intex) then - ntindex = 0 - ndxs2 = index(tline(ic+1:len),s2q)+ic -c print*,'ndxs2 =>',ndxs2 - else - ntindex = ndxs2 - return - end if -c print*,'Internal exit, intex, ntindex:',intex,ntindex - else if (intex .and. tline(ic+1:ic+2).eq.char(92)//' ') then - intex = .false. -c print*,'intex+>',intex - else if (.not.intex .and. tline(ic+1:ic+2).eq.' '//char(92)) - * then - intex = .true. -c print*,'intex+>',intex - end if -1 continue -c print*,'Out end of loop 1' - end if -c print*,'Exiting ntindex at the end???' - return - end - subroutine getchar(line,iccount,charq) -c -c Gets the next character out of line*128. If pointer iccount=128 on entry, -c then reads in a new line. Resets iccount to position of the new character. -c - character*1 charq - character*128 line - if (iccount .eq. 128) then - read(10,'(a)')line - iccount = 0 - end if - iccount = iccount+1 - charq = line(iccount:iccount) - return - end - function readin(line,iccount,iread) - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,botv -c -c Reads a piece of setup data from line, gets a new line from -c file 10 (jobname.pmx) if needed, Transfers comment lines into all parts. -c -c iread controls copying of values into scratch files for parts, but only -c if not replacing. -c -c iread input value written -c -1 nvi nothing (only used when noinst<0 initially) -c 0 various value read -c 1 nv -1 , replace later with nvi(i) -c 2 noinst 1 -c 3 np -2 , replace later with (nsyst-1)/12+1 -c 4 musicsize 20 -c 5 fracondent 0.05 -c - character*128 line - character*1 durq -4 if (iccount .eq. 128) then - read(10,'(a)')line - if (replacing) replacing = .false. - call chkcom(line) - iccount = 0 - end if - iccount = iccount+1 -c -c Find next non-blank or end of line -c - do 2 iccount = iccount , 127 - if (line(iccount:iccount) .ne. ' ') go to 3 -2 continue -c -c If here, need to get a new line -c - iccount = 128 - go to 4 -3 continue -c -c iccount now points to start of number to read -c - i1 = iccount -5 call getchar(line,iccount,durq) -c -c Remember that getchar first increments iccount, *then* reads a character. -c - if (index('0123456789.-',durq) .gt. 0) go to 5 - i2 = iccount-1 - if (i2 .lt. i1) then - print*,'Found "'//durq//'" instead of number' - stop 1 - end if - icf = i2-i1+49 - read(line(i1:i2),'(f'//char(icf)//'.0)')readin - if (.not.replacing) then - if (iread .eq. 0) then - call allparts(line(i1:i2),i2-i1+1) - else if (iread .eq. 1) then - call allparts('-999',4) - else if (iread .eq. 2) then - call allparts('1',1) - else if (iread .eq. 3) then - call allparts('-998',4) - else if (iread .eq. 4) then - call allparts('20',2) - else if (iread .eq. 5) then - call allparts('.05',3) - else if (iread .ne. -1) then - print*,'Error with iread in readin' - stop - end if - end if - return - end - subroutine chkcom(line) - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,clefpend,botv - character*128 line -c -c Assume that line has just been read. No need to change iccount since we only -c process full lines. -c -1 if (line(1:1) .ne. '%') return -c -c If here, line has some sort of comment -c - if (line(2:2) .eq. '%') then - if (.not. insetup) then -c -c Suck up a line, then flow out of "if" block to get another and loop -c - read(10,'(a)')line - -c++VV -c -c UNLESS (a) it has a score-only "M" and changes # of inst's. -c - if (index(line,'M') .gt. 0) then - idxL = index(line,'L') - idxM = index(line,'M') - idxn = index(line,'n') - idxb = index(line,' ') - if (idxL.lt.idxM .and. idxM.lt.idxn .and. - * (idxb.eq.0 .or. idxn.lt.idxb)) then - noinow = ichar(line(idxn+1:idxn+1))-48 - clefpend = .true. -c -c Next noinow digits are original inst. #'s of new inst. set. Next noinow -c char's after that are clefs -c - nvnow = 0 - do 24 j = 1 , noinow - iorig(j) = ichar(line(idxn+1+j:idxn+1+j))-48 - iposc0 = idxn+1+noinow - do 25 k = 1 , nvi(iorig(j)) - nvnow = nvnow+1 -c clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) - instnum(nvnow) = j - botv(nvnow) = k.eq.1 .and. j.ne.1 -25 continue -24 continue - end if - end if -c -c or if it's "h" or "l", need to suck up one more line -c - if ((line(1:1).eq.'h'.and.index('+- ',line(2:2)).gt.0) .or. -c -c 4/29/00 check for T string also -c - * line(1:1).eq.'T' .or. - * line(1:2).eq.'l ') read(10,'(a)')line - else -c -c In setup mode. Set flag, flow out and do use following line -c - replacing = .true. - end if - else if (line(2:2) .eq. '!') then -c -c Copy to all parts -c - call allparts(line(3:128),125) - else -c -c Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise -cc Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise -c - ivq = index('123456789abcdefghijklmno',line(2:2)) -c -c Only treat as part-specific pmx line if number .le. noinst -c - if (ivq.lt.1 .or. ivq.gt.noinst) then -c -c Simple comment. -c - call allparts(line,128) - else -c -c Instrument comment, copy only to part -c - lenline = lenstr(line,128) - if (lenline .gt. 2) then - write(10+ivq,'(a)')line(3:lenline) - else -c -c Transferring blank line -c - write(10+ivq,'(a)')' ' - end if - end if - end if - read(10,'(a)',end=2)line - call zapbl(line,128) - go to 1 -2 continue - return - end - subroutine dosetup(iv,line,mtrnum,mtrden) - parameter (noimax=24) -c -c Transfers setup data from scratch file to real one for one instrument -c Data may be mixed with comments, but on entry 1st item is a number. -c Write a comment when encountered, as it comes. -c Write numbers one per line. -c Three input data require special handling: -c If not already replaced, i.e., if negative, then -c iset(1) (nv) will be replaced with nvi(i) -c iset(9) (npages) will be replaced with (nsyst-1)/12+1 -c iset(2), if negative, will be followed by extra numbers to be transf. -c - 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) - if (iset .eq. 2) then - if (xdata .gt. 0) then - write(40,'(i5)')int(xdata+.1) - else - noi = -xdata+.1 - write(40,'(i5)')noi - do 2 ioi = 1 , noi - call partnum(iv,iccount,line,xdata) - write(40,'(i5)')int(xdata+.1) -2 continue - end if -c else if (iset.ne.8 .and. xdata.lt.0) then - else if (iset.ne.8 .and. iset.ne.5 .and. xdata.lt.0) then -c -c Must be either nv or npages -c - if (int(-xdata+.1) .eq. 999) then -c -c It's nv -c - write(40,'(i5)')nvi(iv) - else -c -c npages must be computed -c - write(40,'(i5)')(nsyst-1)/12+1 - end if - else if (iset.ne.7 .and. iset.ne.12) then -c -c write integer -c - write(40,'(i5)')nint(xdata) - else -c -c write floating number -c - write(40,'(f5.2)')xdata - end if - if (iset .eq. 3) then - mtrnum = nint(xdata) - else if (iset .eq. 4) then - mtrden = nint(xdata) - end if -1 continue - return - end - subroutine partnum(iv,iccount,line,xdata) -c -c Simplified number parsing. Only looks for comment lines and numbers. -c - character*128 line - character*1 durq -2 if (iccount .eq. 128) then - read(10+iv,'(a)')line - if (line(1:1) .eq. '%') then - len = lenstr(line,128) - write(40,'(a)')line(1:len) - go to 2 - end if - iccount = 0 - end if - iccount = iccount+1 -c -c Find next non-blank or end of line -c - do 4 iccount = iccount , 127 - if (line(iccount:iccount) .ne. ' ') go to 3 -4 continue -c -c If here, iccount=128 and need to get a new line -c - go to 2 -3 continue -c -c iccount now points to start of number to read -c - i1 = iccount -5 call getchar(line,iccount,durq) -c -c Remember that getchar first increments iccount, *then* reads a character. -c - if (index('0123456789.-',durq) .gt. 0) go to 5 - i2 = iccount-1 - if (i2 .lt. i1) then - print*,'Found "'//durq//'" instead of number' - stop 1 - end if - icf = i2-i1+49 - read(line(i1:i2),'(f'//char(icf)//'.0)')xdata - return - end - block data - parameter (noimax=24) - common /all/ noinow,iorig(noimax),noinst,insetup,replacing, - * instnum(noimax),botv(noimax),nvi(noimax),nsyst,nvnow - logical insetup,replacing,botv - data nvi /noimax*1/, noinst,noinow /2*noimax/ - data botv /noimax*.false./ - end - subroutine zapbl(string,len) - character*(*) string - do 1 i = 1 , len - if (string(i:i) .eq. ' ')go to 1 - if (i .eq. 1) return - go to 2 -1 continue -c -c If line is all blank, leave it alone -c - return -2 continue - string = string(i:len) - return - end - subroutine OddQuotesBefore(lineq,indx,yesodd) -c -c This counts number of double quotes in lineq up to position indx-1, then -c sets yesodd according to whether number is odd or even -c - logical yesodd - character*(*) lineq - numdqs = 0 - do 1 i = 1 , indx-1 - if (lineq(i:i) .eq. '"') numdqs = numdqs+1 -1 continue - yesodd = mod(numdqs,2) .eq. 1 - return - end - - - - - diff --git a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog b/Build/source/utils/pmx/pmx-src-PATCHES/ChangeLog index 4faa12f492d..ad1812c368b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/ChangeLog +++ b/Build/source/utils/pmx/pmx-src-PATCHES/ChangeLog @@ -1,3 +1,8 @@ +2016-02-10 Akira Kakuto <kakuto@fuk.kindai.ac.jp> + + * import pmx-2.7.3. + * patch-01-ptr-to-int: Removed. Now included upstream. + 2013-11-25 Peter Breitenlohner <peb@mppmu.mpg.de> Updated pmx-2.7.0 source tree from a modifies version of diff --git a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/TL-Changes b/Build/source/utils/pmx/pmx-src-PATCHES/TL-Changes index 76634bc032c..5d8d9f5f938 100644 --- a/Build/source/utils/pmx/pmx-2.7.0-PATCHES/TL-Changes +++ b/Build/source/utils/pmx/pmx-src-PATCHES/TL-Changes @@ -1,4 +1,4 @@ -Changes applied to the pmx-2.7.0 tree as obtained from: +Changes applied to the pmx-2.7.3 tree as obtained from: http://www.ctan.org/tex-archive/support/pmx/ Remove: @@ -9,4 +9,3 @@ Remove: depcomp install-sh missing - diff --git a/Build/source/utils/pmx/pmx-2.7.0/AUTHORS b/Build/source/utils/pmx/pmx-src/AUTHORS index 2fa3681a96f..2fa3681a96f 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/AUTHORS +++ b/Build/source/utils/pmx/pmx-src/AUTHORS diff --git a/Build/source/utils/pmx/pmx-2.7.0/COPYING b/Build/source/utils/pmx/pmx-src/COPYING index 92bc3d8dc11..92bc3d8dc11 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/COPYING +++ b/Build/source/utils/pmx/pmx-src/COPYING diff --git a/Build/source/utils/pmx/pmx-2.7.0/ChangeLog b/Build/source/utils/pmx/pmx-src/ChangeLog index 86223087368..86223087368 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/ChangeLog +++ b/Build/source/utils/pmx/pmx-src/ChangeLog diff --git a/Build/source/utils/pmx/pmx-2.7.0/INSTALL b/Build/source/utils/pmx/pmx-src/INSTALL index 7d1c323beae..7d1c323beae 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/INSTALL +++ b/Build/source/utils/pmx/pmx-src/INSTALL diff --git a/Build/source/utils/pmx/pmx-2.7.0/Makefile.am b/Build/source/utils/pmx/pmx-src/Makefile.am index e1a0d8b9e19..e1e2eb6d5e4 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/Makefile.am +++ b/Build/source/utils/pmx/pmx-src/Makefile.am @@ -3,7 +3,6 @@ ## INCLUDES = -I$(srcdir)/libf2c -AM_CFLAGS = #$(WARNING_CFLAGS) bin_PROGRAMS = pmxab scor2prt @@ -232,11 +231,14 @@ 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-07-MuslLibc \ - PATCH-pmx270.for-1 PATCH-scor2prt.for-1 + libf2c/patch-08-WIN64 \ + libf2c/patch-09-tmpfile \ + PATCH-pmx273.for-1 PATCH-pmx273.for-2 ## pmx.test EXTRA_DIST += tests/barsant.mid tests/barsant.pml tests/barsant.pmx \ tests/barsant.tex tests/barsant1.pmx tests/barsant2.pmx -EXTRA_DIST += scor2prt.for.orig scor2prt.for pmx270.for.orig pmx270.for +EXTRA_DIST += scor2prt.for pmx273.for.orig pmx273.for EXTRA_DIST += $(PATCHES) +EXTRA_DIST += version.ac configure.ac Makefile.am Makefile.f2c DISTCLEANFILES = barsant* pmxaerr.dat diff --git a/Build/source/utils/pmx/pmx-src/Makefile.f2c b/Build/source/utils/pmx/pmx-src/Makefile.f2c new file mode 100644 index 00000000000..60b08df4439 --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/Makefile.f2c @@ -0,0 +1,7 @@ +all: pmxab.c scor2prt.c + +pmxab.c: pmx273.for + f2c -g -\!bs < pmx273.for > pmxab.c + +scor2prt.c: scor2prt.for + f2c -g -\!bs < scor2prt.for > scor2prt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/NEWS b/Build/source/utils/pmx/pmx-src/NEWS index e69de29bb2d..e69de29bb2d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/NEWS +++ b/Build/source/utils/pmx/pmx-src/NEWS diff --git a/Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-1 b/Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-1 new file mode 100644 index 00000000000..ac8f2bcbf59 --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-1 @@ -0,0 +1,34 @@ +11004c11004 +< subroutine getmidi(noinst,lineq,iccount,ibarcnt,ibaroff,nbars, +--- +> subroutine getmidi(noinstarg,lineq,iccount,ibarcnt,ibaroff,nbars, +11033c11033 +< * ,miditran(nm),midtc(0:nm),noinstdum,iinsiv(nm) +--- +> * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) +11110c11110 +< do 2 ivx = 1 , noinst +--- +> do 2 ivx = 1 , noinstarg +11155c11155 +< do 7 ivx = 1 , noinst +--- +> do 7 ivx = 1 , noinstarg +11178c11178 +< do 8 ivx = 1 , noinst +--- +> do 8 ivx = 1 , noinstarg +11201c11201 +< do 9 ivx = 1 , noinst +--- +> do 9 ivx = 1 , noinstarg +19791c19791,19792 +< logical inputmlyr /.false./ +--- +> logical inputmlyr +> data inputmlyr /.false./ +24429c24430,24431 +< character*1 sq /'\'/ +--- +> character*1 sq +> data sq /'\'/ diff --git a/Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-2 b/Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-2 new file mode 100644 index 00000000000..44b4de79f1f --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/PATCH-pmx273.for-2 @@ -0,0 +1,10 @@ +113,114c113,114 +< call getarg(1,jobname,idum) ! May need to replace this w/ next line +< c call getarg(1,jobname) +--- +> c call getarg(1,jobname,idum) ! May need to replace this w/ next line +> call getarg(1,jobname) +1485c1485 +< logical insetup,replacing +--- +> logical insetup,replacing,botv diff --git a/Build/source/utils/pmx/pmx-2.7.0/README b/Build/source/utils/pmx/pmx-src/README index bdccc32841a..833060ed60e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/README +++ b/Build/source/utils/pmx/pmx-src/README @@ -1,4 +1,4 @@ -This is PMX, version 2.7.0. PMX provides a preprocessor for MusiXTeX. +This is PMX, version 2.7.3 (2016-02-02). PMX provides a preprocessor for MusiXTeX. pmxab builds a TeX input file based on a .pmx input file in a much simpler language, making most of the layout decisions by itself. It has diff --git a/Build/source/utils/pmx/pmx-2.7.0/configure.ac b/Build/source/utils/pmx/pmx-src/configure.ac index d56db2ca306..d56db2ca306 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/configure.ac +++ b/Build/source/utils/pmx/pmx-src/configure.ac diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/abort_.c b/Build/source/utils/pmx/pmx-src/libf2c/abort_.c index fa5aae6b716..fa5aae6b716 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/abort_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/abort_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/backspac.c b/Build/source/utils/pmx/pmx-src/libf2c/backspac.c index 908a61897aa..908a61897aa 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/backspac.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/backspac.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_abs.c b/Build/source/utils/pmx/pmx-src/libf2c/c_abs.c index 858f2c8b4b1..858f2c8b4b1 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_abs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_abs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_cos.c b/Build/source/utils/pmx/pmx-src/libf2c/c_cos.c index 29fe49e3cda..29fe49e3cda 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_cos.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_cos.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_div.c b/Build/source/utils/pmx/pmx-src/libf2c/c_div.c index 59425e7aaad..59425e7aaad 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_div.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_div.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_exp.c b/Build/source/utils/pmx/pmx-src/libf2c/c_exp.c index f46508d35b1..f46508d35b1 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_exp.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_exp.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_log.c b/Build/source/utils/pmx/pmx-src/libf2c/c_log.c index a0ba3f0d8d2..a0ba3f0d8d2 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_log.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_log.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_sin.c b/Build/source/utils/pmx/pmx-src/libf2c/c_sin.c index c8bc30f2d69..c8bc30f2d69 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_sin.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_sin.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_sqrt.c b/Build/source/utils/pmx/pmx-src/libf2c/c_sqrt.c index 1678c534d60..1678c534d60 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/c_sqrt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/c_sqrt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/cabs.c b/Build/source/utils/pmx/pmx-src/libf2c/cabs.c index 84750d505cf..84750d505cf 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/cabs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/cabs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/close.c b/Build/source/utils/pmx/pmx-src/libf2c/close.c index e958c7172a8..e958c7172a8 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/close.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/close.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_abs.c b/Build/source/utils/pmx/pmx-src/libf2c/d_abs.c index 2f7a153c2e3..2f7a153c2e3 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_abs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_abs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_acos.c b/Build/source/utils/pmx/pmx-src/libf2c/d_acos.c index 69005b56d76..69005b56d76 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_acos.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_acos.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_asin.c b/Build/source/utils/pmx/pmx-src/libf2c/d_asin.c index d5196ab101e..d5196ab101e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_asin.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_asin.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_atan.c b/Build/source/utils/pmx/pmx-src/libf2c/d_atan.c index d8856f8d698..d8856f8d698 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_atan.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_atan.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_atn2.c b/Build/source/utils/pmx/pmx-src/libf2c/d_atn2.c index 56113850ab9..56113850ab9 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_atn2.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_atn2.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cnjg.c b/Build/source/utils/pmx/pmx-src/libf2c/d_cnjg.c index 38471d9bc0e..38471d9bc0e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cnjg.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_cnjg.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cos.c b/Build/source/utils/pmx/pmx-src/libf2c/d_cos.c index 12def9ad0fd..12def9ad0fd 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cos.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_cos.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cosh.c b/Build/source/utils/pmx/pmx-src/libf2c/d_cosh.c index 9214c7a0d82..9214c7a0d82 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_cosh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_cosh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_dim.c b/Build/source/utils/pmx/pmx-src/libf2c/d_dim.c index 627ddb690fd..627ddb690fd 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_dim.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_dim.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_exp.c b/Build/source/utils/pmx/pmx-src/libf2c/d_exp.c index e9ab5d4425c..e9ab5d4425c 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_exp.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_exp.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_imag.c b/Build/source/utils/pmx/pmx-src/libf2c/d_imag.c index d17b9dd591d..d17b9dd591d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_imag.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_imag.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_int.c b/Build/source/utils/pmx/pmx-src/libf2c/d_int.c index 6da4ce35e92..6da4ce35e92 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_int.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_int.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_lg10.c b/Build/source/utils/pmx/pmx-src/libf2c/d_lg10.c index 664c19d9e99..664c19d9e99 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_lg10.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_lg10.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_log.c b/Build/source/utils/pmx/pmx-src/libf2c/d_log.c index e74be02c54e..e74be02c54e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_log.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_log.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_mod.c b/Build/source/utils/pmx/pmx-src/libf2c/d_mod.c index 3766d9fa828..3766d9fa828 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_mod.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_mod.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_nint.c b/Build/source/utils/pmx/pmx-src/libf2c/d_nint.c index 66f2dd0ee67..66f2dd0ee67 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_nint.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_nint.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_prod.c b/Build/source/utils/pmx/pmx-src/libf2c/d_prod.c index f9f348b03dd..f9f348b03dd 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_prod.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_prod.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sign.c b/Build/source/utils/pmx/pmx-src/libf2c/d_sign.c index d06e0d19231..d06e0d19231 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sign.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_sign.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sin.c b/Build/source/utils/pmx/pmx-src/libf2c/d_sin.c index ebd4eec5eeb..ebd4eec5eeb 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sin.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_sin.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sinh.c b/Build/source/utils/pmx/pmx-src/libf2c/d_sinh.c index 2479a6fab22..2479a6fab22 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sinh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_sinh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sqrt.c b/Build/source/utils/pmx/pmx-src/libf2c/d_sqrt.c index a7fa66c00aa..a7fa66c00aa 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_sqrt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_sqrt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_tan.c b/Build/source/utils/pmx/pmx-src/libf2c/d_tan.c index 7d252c4d5cf..7d252c4d5cf 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_tan.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_tan.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_tanh.c b/Build/source/utils/pmx/pmx-src/libf2c/d_tanh.c index 415b58508b3..415b58508b3 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/d_tanh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/d_tanh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/derf_.c b/Build/source/utils/pmx/pmx-src/libf2c/derf_.c index d935d315213..d935d315213 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/derf_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/derf_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/derfc_.c b/Build/source/utils/pmx/pmx-src/libf2c/derfc_.c index 18f5c619b6f..18f5c619b6f 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/derfc_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/derfc_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/dfe.c b/Build/source/utils/pmx/pmx-src/libf2c/dfe.c index c6b10d0e9c3..c6b10d0e9c3 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/dfe.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/dfe.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/dolio.c b/Build/source/utils/pmx/pmx-src/libf2c/dolio.c index 4070d879012..4070d879012 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/dolio.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/dolio.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/dtime_.c b/Build/source/utils/pmx/pmx-src/libf2c/dtime_.c index 6a09b3e9837..6a09b3e9837 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/dtime_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/dtime_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/due.c b/Build/source/utils/pmx/pmx-src/libf2c/due.c index a7f4cec4673..a7f4cec4673 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/due.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/due.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ef1asc_.c b/Build/source/utils/pmx/pmx-src/libf2c/ef1asc_.c index 70be0bc2e0b..70be0bc2e0b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ef1asc_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/ef1asc_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ef1cmc_.c b/Build/source/utils/pmx/pmx-src/libf2c/ef1cmc_.c index 4b420ae6465..4b420ae6465 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ef1cmc_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/ef1cmc_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/endfile.c b/Build/source/utils/pmx/pmx-src/libf2c/endfile.c index 04020d3802d..04020d3802d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/endfile.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/endfile.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/erf_.c b/Build/source/utils/pmx/pmx-src/libf2c/erf_.c index 532fec61c86..532fec61c86 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/erf_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/erf_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/erfc_.c b/Build/source/utils/pmx/pmx-src/libf2c/erfc_.c index 6f6c9f10644..6f6c9f10644 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/erfc_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/erfc_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/err.c b/Build/source/utils/pmx/pmx-src/libf2c/err.c index b81ffc111f0..b81ffc111f0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/err.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/err.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/etime_.c b/Build/source/utils/pmx/pmx-src/libf2c/etime_.c index 2d9a36d8a31..2d9a36d8a31 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/etime_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/etime_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/exit_.c b/Build/source/utils/pmx/pmx-src/libf2c/exit_.c index 08e9d07067c..08e9d07067c 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/exit_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/exit_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/f2c.h b/Build/source/utils/pmx/pmx-src/libf2c/f2c.h index a8d13f6b1eb..a8d13f6b1eb 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/f2c.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/f2c.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/f77_aloc.c b/Build/source/utils/pmx/pmx-src/libf2c/f77_aloc.c index 1ff0f896b30..1ff0f896b30 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/f77_aloc.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/f77_aloc.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/f77vers.c b/Build/source/utils/pmx/pmx-src/libf2c/f77vers.c index 782d40160ca..782d40160ca 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/f77vers.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/f77vers.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fio.h b/Build/source/utils/pmx/pmx-src/libf2c/fio.h index e709dde1934..e709dde1934 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fio.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/fio.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fmt.c b/Build/source/utils/pmx/pmx-src/libf2c/fmt.c index 80bcd0a7663..80bcd0a7663 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fmt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/fmt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fmt.h b/Build/source/utils/pmx/pmx-src/libf2c/fmt.h index a2fdc651778..a2fdc651778 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fmt.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/fmt.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fmtlib.c b/Build/source/utils/pmx/pmx-src/libf2c/fmtlib.c index 279f66f4390..279f66f4390 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fmtlib.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/fmtlib.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fp.h b/Build/source/utils/pmx/pmx-src/libf2c/fp.h index 40743d79f74..40743d79f74 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/fp.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/fp.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ftell64_.c b/Build/source/utils/pmx/pmx-src/libf2c/ftell64_.c index 9cc00cba8b9..9cc00cba8b9 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ftell64_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/ftell64_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ftell_.c b/Build/source/utils/pmx/pmx-src/libf2c/ftell_.c index be9f2871086..be9f2871086 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ftell_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/ftell_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/getarg_.c b/Build/source/utils/pmx/pmx-src/libf2c/getarg_.c index 9006ad20169..9006ad20169 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/getarg_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/getarg_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/getenv_.c b/Build/source/utils/pmx/pmx-src/libf2c/getenv_.c index 57ca28cb3b4..57ca28cb3b4 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/getenv_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/getenv_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_abs.c b/Build/source/utils/pmx/pmx-src/libf2c/h_abs.c index db6906869cf..db6906869cf 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_abs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_abs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_dim.c b/Build/source/utils/pmx/pmx-src/libf2c/h_dim.c index 443427a9b99..443427a9b99 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_dim.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_dim.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_dnnt.c b/Build/source/utils/pmx/pmx-src/libf2c/h_dnnt.c index 1ec641c5aa4..1ec641c5aa4 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_dnnt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_dnnt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_indx.c b/Build/source/utils/pmx/pmx-src/libf2c/h_indx.c index 018f2f43861..018f2f43861 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_indx.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_indx.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_len.c b/Build/source/utils/pmx/pmx-src/libf2c/h_len.c index 8b0aea99d26..8b0aea99d26 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_len.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_len.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_mod.c b/Build/source/utils/pmx/pmx-src/libf2c/h_mod.c index 611ef0aa8bf..611ef0aa8bf 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_mod.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_mod.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_nint.c b/Build/source/utils/pmx/pmx-src/libf2c/h_nint.c index 9e2282f2a74..9e2282f2a74 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_nint.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_nint.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_sign.c b/Build/source/utils/pmx/pmx-src/libf2c/h_sign.c index 4e214380cf9..4e214380cf9 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/h_sign.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/h_sign.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_ge.c b/Build/source/utils/pmx/pmx-src/libf2c/hl_ge.c index 8c72f03d489..8c72f03d489 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_ge.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/hl_ge.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_gt.c b/Build/source/utils/pmx/pmx-src/libf2c/hl_gt.c index a448522db4b..a448522db4b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_gt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/hl_gt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_le.c b/Build/source/utils/pmx/pmx-src/libf2c/hl_le.c index 31cbc431a3f..31cbc431a3f 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_le.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/hl_le.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_lt.c b/Build/source/utils/pmx/pmx-src/libf2c/hl_lt.c index 7ad3c714b1d..7ad3c714b1d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/hl_lt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/hl_lt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i77vers.c b/Build/source/utils/pmx/pmx-src/libf2c/i77vers.c index 60cc24eec19..60cc24eec19 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i77vers.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i77vers.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_abs.c b/Build/source/utils/pmx/pmx-src/libf2c/i_abs.c index 2b92c4aa782..2b92c4aa782 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_abs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_abs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_dim.c b/Build/source/utils/pmx/pmx-src/libf2c/i_dim.c index 60ed4d8c5b4..60ed4d8c5b4 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_dim.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_dim.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_dnnt.c b/Build/source/utils/pmx/pmx-src/libf2c/i_dnnt.c index 3abc2dc4a51..3abc2dc4a51 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_dnnt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_dnnt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_indx.c b/Build/source/utils/pmx/pmx-src/libf2c/i_indx.c index 19256393ecd..19256393ecd 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_indx.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_indx.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_len.c b/Build/source/utils/pmx/pmx-src/libf2c/i_len.c index 0f7b188d65a..0f7b188d65a 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_len.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_len.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_mod.c b/Build/source/utils/pmx/pmx-src/libf2c/i_mod.c index 4a9b5609ba4..4a9b5609ba4 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_mod.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_mod.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_nint.c b/Build/source/utils/pmx/pmx-src/libf2c/i_nint.c index fe9fd68a86e..fe9fd68a86e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_nint.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_nint.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_sign.c b/Build/source/utils/pmx/pmx-src/libf2c/i_sign.c index 4c20e9494e1..4c20e9494e1 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/i_sign.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/i_sign.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/iargc_.c b/Build/source/utils/pmx/pmx-src/libf2c/iargc_.c index 2f29da0eaa6..2f29da0eaa6 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/iargc_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/iargc_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/iio.c b/Build/source/utils/pmx/pmx-src/libf2c/iio.c index 8553efcf97f..8553efcf97f 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/iio.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/iio.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ilnw.c b/Build/source/utils/pmx/pmx-src/libf2c/ilnw.c index e8b3d49cf1f..e8b3d49cf1f 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/ilnw.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/ilnw.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/inquire.c b/Build/source/utils/pmx/pmx-src/libf2c/inquire.c index 5936a674ccc..5936a674ccc 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/inquire.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/inquire.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_ge.c b/Build/source/utils/pmx/pmx-src/libf2c/l_ge.c index a84f0ee4abc..a84f0ee4abc 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_ge.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/l_ge.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_gt.c b/Build/source/utils/pmx/pmx-src/libf2c/l_gt.c index ae6950d1391..ae6950d1391 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_gt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/l_gt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_le.c b/Build/source/utils/pmx/pmx-src/libf2c/l_le.c index 625b49a9ea9..625b49a9ea9 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_le.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/l_le.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_lt.c b/Build/source/utils/pmx/pmx-src/libf2c/l_lt.c index ab21b362de9..ab21b362de9 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/l_lt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/l_lt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lbitbits.c b/Build/source/utils/pmx/pmx-src/libf2c/lbitbits.c index 5b6ccf72d0a..5b6ccf72d0a 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lbitbits.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/lbitbits.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lbitshft.c b/Build/source/utils/pmx/pmx-src/libf2c/lbitshft.c index fbee94f1403..fbee94f1403 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lbitshft.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/lbitshft.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lio.h b/Build/source/utils/pmx/pmx-src/libf2c/lio.h index 012317206aa..012317206aa 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lio.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/lio.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lread.c b/Build/source/utils/pmx/pmx-src/libf2c/lread.c index 9636ae9c46e..9636ae9c46e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lread.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/lread.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lwrite.c b/Build/source/utils/pmx/pmx-src/libf2c/lwrite.c index 9e0d93deb50..9e0d93deb50 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/lwrite.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/lwrite.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/main.c b/Build/source/utils/pmx/pmx-src/libf2c/main.c index 45397490471..45397490471 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/main.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/main.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/open.c b/Build/source/utils/pmx/pmx-src/libf2c/open.c index 49f739a3d7d..8695deb289c 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/open.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/open.c @@ -1,3 +1,119 @@ +#ifdef _WIN32 + +/* On Windows, replace tmpfile() by _cairo_win_tmpfile() defined as follows, + * and presumably more secure than mktemp(). +*/ + +/* _cairo_win_tmpfile (void) - replace tmpfile() in Windows + * extracted from cairo-misc.c in cairo - a vector graphics library + * The functiion name is changed from + * _cairo_win32_tmpfile (void) to + * _cairo_win_tmpfile (void) + * + * + * Copyright 2002 University of Southern California + * Copyright 2005 Red Hat, Inc. + * Copyright 2007 Adrian Johnson + * + * This library is free software; you can redistribute it and/or + * modify it either under the terms of the GNU Lesser General Public + * License version 2.1 as published by the Free Software Foundation + * (the "LGPL") or, at your option, under the terms of the Mozilla + * Public License Version 1.1 (the "MPL"). If you do not alter this + * notice, a recipient may use your version of this file under either + * the MPL or the LGPL. + * + * You should have received a copy of the LGPL along with this library + * in the file COPYING-LGPL-2.1; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA + * You should have received a copy of the MPL along with this library + * in the file COPYING-MPL-1.1 + * + * The contents of this file are subject to the Mozilla Public License + * Version 1.1 (the "License"); you may not use this file except in + * compliance with the License. You may obtain a copy of the License at + * http://www.mozilla.org/MPL/ + * + * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY + * OF ANY KIND, either express or implied. See the LGPL or the MPL for + * the specific language governing rights and limitations. + * + * The Original Code is the cairo graphics library. + * + * The Initial Developer of the Original Code is University of Southern + * California. + * + * Contributor(s): + * Carl D. Worth <cworth@cworth.org> + * Adrian Johnson <ajohnson@redneon.com> + */ + +#include <stdio.h> +#define WIN32_LEAN_AND_MEAN +/* We require Windows 2000 features such as ETO_PDY */ +#if !defined(WINVER) || (WINVER < 0x0500) +# define WINVER 0x0500 +#endif +#if !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0500) +# define _WIN32_WINNT 0x0500 +#endif + +#include <windows.h> +#include <io.h> + +/* tmpfile() replacement for Windows. + * + * On Windows tmpfile() creates the file in the root directory. This + * may fail due to unsufficient privileges. However, this isn't a + * problem on Windows CE so we don't use it there. + */ +FILE * +_cairo_win_tmpfile (void) +{ + DWORD path_len; + WCHAR path_name[MAX_PATH + 1]; + WCHAR file_name[MAX_PATH + 1]; + HANDLE handle; + int fd; + FILE *fp; + + path_len = GetTempPathW (MAX_PATH, path_name); + if (path_len <= 0 || path_len >= MAX_PATH) + return NULL; + + if (GetTempFileNameW (path_name, L"ps_", 0, file_name) == 0) + return NULL; + + handle = CreateFileW (file_name, + GENERIC_READ | GENERIC_WRITE, + 0, + NULL, + CREATE_ALWAYS, + FILE_ATTRIBUTE_NORMAL | FILE_FLAG_DELETE_ON_CLOSE, + NULL); + if (handle == INVALID_HANDLE_VALUE) { + DeleteFileW (file_name); + return NULL; + } + + fd = _open_osfhandle((intptr_t) handle, 0); + if (fd < 0) { + CloseHandle (handle); + return NULL; + } + + fp = _fdopen(fd, "w+b"); + if (fp == NULL) { + _close(fd); + return NULL; + } + + return fp; +} + +#define tmpfile _cairo_win_tmpfile +#endif /* _WIN32 */ + #include "f2c.h" #include "fio.h" #include "string.h" diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-01-binary b/Build/source/utils/pmx/pmx-src/libf2c/patch-01-binary index 02856a74455..02856a74455 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-01-binary +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-01-binary diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-03-DOS-line-endings b/Build/source/utils/pmx/pmx-src/libf2c/patch-03-DOS-line-endings index 2191c6db982..2191c6db982 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-03-DOS-line-endings +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-03-DOS-line-endings diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-04-MSVC-complex b/Build/source/utils/pmx/pmx-src/libf2c/patch-04-MSVC-complex index 17326913552..17326913552 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-04-MSVC-complex +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-04-MSVC-complex diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-05-FreeBSD-off_t b/Build/source/utils/pmx/pmx-src/libf2c/patch-05-FreeBSD-off_t index e3b8a9c3387..e3b8a9c3387 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-05-FreeBSD-off_t +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-05-FreeBSD-off_t diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-06-WIN32 b/Build/source/utils/pmx/pmx-src/libf2c/patch-06-WIN32 index 733d560b737..733d560b737 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-06-WIN32 +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-06-WIN32 diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc b/Build/source/utils/pmx/pmx-src/libf2c/patch-07-MuslLibc index bcfc5489720..bcfc5489720 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/patch-07-MuslLibc +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-07-MuslLibc diff --git a/Build/source/utils/pmx/pmx-src/libf2c/patch-08-WIN64 b/Build/source/utils/pmx/pmx-src/libf2c/patch-08-WIN64 new file mode 100644 index 00000000000..39932ffca8a --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-08-WIN64 @@ -0,0 +1,23 @@ +*** signal_.c.orig 2016-02-02 08:40:45.725142965 -0500 +--- signal_.c 2016-02-01 19:44:44.304546734 -0500 +*************** +*** 14,20 **** + int sig; + sig = (int)*sigp; + +! return (ftnint)signal(sig, proc); + } + #ifdef __cplusplus + } +--- 14,24 ---- + int sig; + sig = (int)*sigp; + +! #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-src/libf2c/patch-09-tmpfile b/Build/source/utils/pmx/pmx-src/libf2c/patch-09-tmpfile new file mode 100644 index 00000000000..81aece17f4b --- /dev/null +++ b/Build/source/utils/pmx/pmx-src/libf2c/patch-09-tmpfile @@ -0,0 +1,136 @@ +*** open.c.orig 2016-02-01 01:11:47.863795221 -0500 +--- open.c 2016-02-02 23:29:46.799174898 -0500 +*************** +*** 1,3 **** +--- 1,119 ---- ++ #ifdef _WIN32 ++ ++ /* On Windows, replace tmpfile() by _cairo_win_tmpfile() defined as follows, ++ * and presumably more secure than mktemp(). ++ */ ++ ++ /* _cairo_win_tmpfile (void) - replace tmpfile() in Windows ++ * extracted from cairo-misc.c in cairo - a vector graphics library ++ * The functiion name is changed from ++ * _cairo_win32_tmpfile (void) to ++ * _cairo_win_tmpfile (void) ++ * ++ * ++ * Copyright 2002 University of Southern California ++ * Copyright 2005 Red Hat, Inc. ++ * Copyright 2007 Adrian Johnson ++ * ++ * This library is free software; you can redistribute it and/or ++ * modify it either under the terms of the GNU Lesser General Public ++ * License version 2.1 as published by the Free Software Foundation ++ * (the "LGPL") or, at your option, under the terms of the Mozilla ++ * Public License Version 1.1 (the "MPL"). If you do not alter this ++ * notice, a recipient may use your version of this file under either ++ * the MPL or the LGPL. ++ * ++ * You should have received a copy of the LGPL along with this library ++ * in the file COPYING-LGPL-2.1; if not, write to the Free Software ++ * Foundation, Inc., 51 Franklin Street, Suite 500, Boston, MA 02110-1335, USA ++ * You should have received a copy of the MPL along with this library ++ * in the file COPYING-MPL-1.1 ++ * ++ * The contents of this file are subject to the Mozilla Public License ++ * Version 1.1 (the "License"); you may not use this file except in ++ * compliance with the License. You may obtain a copy of the License at ++ * http://www.mozilla.org/MPL/ ++ * ++ * This software is distributed on an "AS IS" basis, WITHOUT WARRANTY ++ * OF ANY KIND, either express or implied. See the LGPL or the MPL for ++ * the specific language governing rights and limitations. ++ * ++ * The Original Code is the cairo graphics library. ++ * ++ * The Initial Developer of the Original Code is University of Southern ++ * California. ++ * ++ * Contributor(s): ++ * Carl D. Worth <cworth@cworth.org> ++ * Adrian Johnson <ajohnson@redneon.com> ++ */ ++ ++ #include <stdio.h> ++ #define WIN32_LEAN_AND_MEAN ++ /* We require Windows 2000 features such as ETO_PDY */ ++ #if !defined(WINVER) || (WINVER < 0x0500) ++ # define WINVER 0x0500 ++ #endif ++ #if !defined(_WIN32_WINNT) || (_WIN32_WINNT < 0x0500) ++ # define _WIN32_WINNT 0x0500 ++ #endif ++ ++ #include <windows.h> ++ #include <io.h> ++ ++ /* tmpfile() replacement for Windows. ++ * ++ * On Windows tmpfile() creates the file in the root directory. This ++ * may fail due to unsufficient privileges. However, this isn't a ++ * problem on Windows CE so we don't use it there. ++ */ ++ FILE * ++ _cairo_win_tmpfile (void) ++ { ++ DWORD path_len; ++ WCHAR path_name[MAX_PATH + 1]; ++ WCHAR file_name[MAX_PATH + 1]; ++ HANDLE handle; ++ int fd; ++ FILE *fp; ++ ++ path_len = GetTempPathW (MAX_PATH, path_name); ++ if (path_len <= 0 || path_len >= MAX_PATH) ++ return NULL; ++ ++ if (GetTempFileNameW (path_name, L"ps_", 0, file_name) == 0) ++ return NULL; ++ ++ handle = CreateFileW (file_name, ++ GENERIC_READ | GENERIC_WRITE, ++ 0, ++ NULL, ++ CREATE_ALWAYS, ++ FILE_ATTRIBUTE_NORMAL | FILE_FLAG_DELETE_ON_CLOSE, ++ NULL); ++ if (handle == INVALID_HANDLE_VALUE) { ++ DeleteFileW (file_name); ++ return NULL; ++ } ++ ++ fd = _open_osfhandle((intptr_t) handle, 0); ++ if (fd < 0) { ++ CloseHandle (handle); ++ return NULL; ++ } ++ ++ fp = _fdopen(fd, "w+b"); ++ if (fp == NULL) { ++ _close(fd); ++ return NULL; ++ } ++ ++ return fp; ++ } ++ ++ #define tmpfile _cairo_win_tmpfile ++ #endif /* _WIN32 */ ++ + #include "f2c.h" + #include "fio.h" + #include "string.h" +*************** +*** 30,35 **** +--- 146,154 ---- + #ifdef NON_ANSI_RW_MODES + char *f__r_mode[2] = {"r", "r"}; + char *f__w_mode[4] = {"w", "w", "r+w", "r+w"}; ++ #elif defined(WIN32) ++ char *f__r_mode[2] = {"rb", "rb"}; ++ char *f__w_mode[4] = {"wb", "wb", "rb+", "rb+"}; + #else + char *f__r_mode[2] = {"rb", "r"}; + char *f__w_mode[4] = {"wb", "w", "r+b", "r+"}; diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ci.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_ci.c index 574e0b1ebac..574e0b1ebac 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ci.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_ci.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_dd.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_dd.c index 08fc20884ae..08fc20884ae 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_dd.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_dd.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_di.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_di.c index abf36cb74c0..abf36cb74c0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_di.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_di.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_hh.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_hh.c index 882168501aa..882168501aa 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_hh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_hh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ii.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_ii.c index 748d1217733..748d1217733 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ii.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_ii.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_qq.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_qq.c index 09fe18ec8e7..09fe18ec8e7 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_qq.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_qq.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ri.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_ri.c index e29d416eba2..e29d416eba2 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_ri.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_ri.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_zi.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_zi.c index 1c0a4b07c2d..1c0a4b07c2d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_zi.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_zi.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_zz.c b/Build/source/utils/pmx/pmx-src/libf2c/pow_zz.c index b5ffd334835..b5ffd334835 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/pow_zz.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/pow_zz.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/qbitbits.c b/Build/source/utils/pmx/pmx-src/libf2c/qbitbits.c index ba1b5bd0c97..ba1b5bd0c97 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/qbitbits.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/qbitbits.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/qbitshft.c b/Build/source/utils/pmx/pmx-src/libf2c/qbitshft.c index 78e7b95100d..78e7b95100d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/qbitshft.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/qbitshft.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_abs.c b/Build/source/utils/pmx/pmx-src/libf2c/r_abs.c index f3291fb4d14..f3291fb4d14 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_abs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_abs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_acos.c b/Build/source/utils/pmx/pmx-src/libf2c/r_acos.c index 103c7ff070b..103c7ff070b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_acos.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_acos.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_asin.c b/Build/source/utils/pmx/pmx-src/libf2c/r_asin.c index 432b9406ac7..432b9406ac7 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_asin.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_asin.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_atan.c b/Build/source/utils/pmx/pmx-src/libf2c/r_atan.c index 7656982db45..7656982db45 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_atan.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_atan.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_atn2.c b/Build/source/utils/pmx/pmx-src/libf2c/r_atn2.c index ab957b89d54..ab957b89d54 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_atn2.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_atn2.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cnjg.c b/Build/source/utils/pmx/pmx-src/libf2c/r_cnjg.c index cef0e4b092b..cef0e4b092b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cnjg.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_cnjg.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cos.c b/Build/source/utils/pmx/pmx-src/libf2c/r_cos.c index 4418f0c1bbf..4418f0c1bbf 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cos.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_cos.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cosh.c b/Build/source/utils/pmx/pmx-src/libf2c/r_cosh.c index f5478355809..f5478355809 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_cosh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_cosh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_dim.c b/Build/source/utils/pmx/pmx-src/libf2c/r_dim.c index d573ca36d8d..d573ca36d8d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_dim.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_dim.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_exp.c b/Build/source/utils/pmx/pmx-src/libf2c/r_exp.c index 4e679794f22..4e679794f22 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_exp.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_exp.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_imag.c b/Build/source/utils/pmx/pmx-src/libf2c/r_imag.c index 1b4de14373a..1b4de14373a 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_imag.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_imag.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_int.c b/Build/source/utils/pmx/pmx-src/libf2c/r_int.c index bff87176ff6..bff87176ff6 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_int.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_int.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_lg10.c b/Build/source/utils/pmx/pmx-src/libf2c/r_lg10.c index 64ffddf48b0..64ffddf48b0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_lg10.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_lg10.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_log.c b/Build/source/utils/pmx/pmx-src/libf2c/r_log.c index 94c79b05185..94c79b05185 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_log.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_log.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_mod.c b/Build/source/utils/pmx/pmx-src/libf2c/r_mod.c index 63ed1753689..63ed1753689 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_mod.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_mod.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_nint.c b/Build/source/utils/pmx/pmx-src/libf2c/r_nint.c index 7cc3f1b5aea..7cc3f1b5aea 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_nint.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_nint.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sign.c b/Build/source/utils/pmx/pmx-src/libf2c/r_sign.c index 797db1a4cbf..797db1a4cbf 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sign.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_sign.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sin.c b/Build/source/utils/pmx/pmx-src/libf2c/r_sin.c index 37e0df25fa5..37e0df25fa5 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sin.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_sin.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sinh.c b/Build/source/utils/pmx/pmx-src/libf2c/r_sinh.c index 39878f03ae7..39878f03ae7 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sinh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_sinh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sqrt.c b/Build/source/utils/pmx/pmx-src/libf2c/r_sqrt.c index e7b2c1c704a..e7b2c1c704a 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_sqrt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_sqrt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_tan.c b/Build/source/utils/pmx/pmx-src/libf2c/r_tan.c index 1774bed73a5..1774bed73a5 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_tan.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_tan.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_tanh.c b/Build/source/utils/pmx/pmx-src/libf2c/r_tanh.c index 7739c6ce846..7739c6ce846 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/r_tanh.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/r_tanh.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rawio.h b/Build/source/utils/pmx/pmx-src/libf2c/rawio.h index fd36a482602..fd36a482602 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rawio.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/rawio.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rdfmt.c b/Build/source/utils/pmx/pmx-src/libf2c/rdfmt.c index 62b28053409..62b28053409 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rdfmt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/rdfmt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rewind.c b/Build/source/utils/pmx/pmx-src/libf2c/rewind.c index 9a0e07e6cfa..9a0e07e6cfa 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rewind.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/rewind.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rsfe.c b/Build/source/utils/pmx/pmx-src/libf2c/rsfe.c index abe9724a7b8..abe9724a7b8 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rsfe.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/rsfe.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rsli.c b/Build/source/utils/pmx/pmx-src/libf2c/rsli.c index 3d4ea428fc9..3d4ea428fc9 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rsli.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/rsli.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rsne.c b/Build/source/utils/pmx/pmx-src/libf2c/rsne.c index 3a32c40b259..3a32c40b259 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/rsne.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/rsne.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_cat.c b/Build/source/utils/pmx/pmx-src/libf2c/s_cat.c index 5bf8a628ac0..5bf8a628ac0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_cat.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/s_cat.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_cmp.c b/Build/source/utils/pmx/pmx-src/libf2c/s_cmp.c index 3a2ea67ddf0..3a2ea67ddf0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_cmp.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/s_cmp.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_copy.c b/Build/source/utils/pmx/pmx-src/libf2c/s_copy.c index 9dacfc7d8d2..9dacfc7d8d2 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_copy.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/s_copy.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_paus.c b/Build/source/utils/pmx/pmx-src/libf2c/s_paus.c index 51d80eb0878..51d80eb0878 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_paus.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/s_paus.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_rnge.c b/Build/source/utils/pmx/pmx-src/libf2c/s_rnge.c index 5c12b949634..5c12b949634 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_rnge.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/s_rnge.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_stop.c b/Build/source/utils/pmx/pmx-src/libf2c/s_stop.c index 68233aea7e3..68233aea7e3 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/s_stop.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/s_stop.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sfe.c b/Build/source/utils/pmx/pmx-src/libf2c/sfe.c index 21e1f044645..21e1f044645 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sfe.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/sfe.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sig_die.c b/Build/source/utils/pmx/pmx-src/libf2c/sig_die.c index 8c22cd58113..8c22cd58113 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sig_die.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/sig_die.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal1.h b/Build/source/utils/pmx/pmx-src/libf2c/signal1.h index a383774b82d..a383774b82d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal1.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/signal1.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c b/Build/source/utils/pmx/pmx-src/libf2c/signal_.c index d4a2e6eae84..ad67dae71f6 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signal_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/signal_.c @@ -14,11 +14,11 @@ signal_(integer *sigp, sig_pf proc) int sig; sig = (int)*sigp; -#ifdef _WIN64 - return (ftnint)(__int64)signal(sig, proc); -#else - return (ftnint)(long)signal(sig, proc); -#endif + #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/signbit.c b/Build/source/utils/pmx/pmx-src/libf2c/signbit.c index de95a3b70fd..de95a3b70fd 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/signbit.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/signbit.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sue.c b/Build/source/utils/pmx/pmx-src/libf2c/sue.c index 191e32627cc..191e32627cc 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sue.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/sue.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h b/Build/source/utils/pmx/pmx-src/libf2c/sysdep1.h index 29546db848e..29546db848e 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/sysdep1.h +++ b/Build/source/utils/pmx/pmx-src/libf2c/sysdep1.h diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/system_.c b/Build/source/utils/pmx/pmx-src/libf2c/system_.c index 3220bfb5c2d..3220bfb5c2d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/system_.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/system_.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/typesize.c b/Build/source/utils/pmx/pmx-src/libf2c/typesize.c index 39097f46991..39097f46991 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/typesize.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/typesize.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/uio.c b/Build/source/utils/pmx/pmx-src/libf2c/uio.c index 44f768d9a24..44f768d9a24 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/uio.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/uio.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/uninit.c b/Build/source/utils/pmx/pmx-src/libf2c/uninit.c index 794cd6adee0..794cd6adee0 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/uninit.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/uninit.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/util.c b/Build/source/utils/pmx/pmx-src/libf2c/util.c index f4b3aef2ce7..f4b3aef2ce7 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/util.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/util.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wref.c b/Build/source/utils/pmx/pmx-src/libf2c/wref.c index f2074b75e3a..f2074b75e3a 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wref.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/wref.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wrtfmt.c b/Build/source/utils/pmx/pmx-src/libf2c/wrtfmt.c index a970db95910..a970db95910 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wrtfmt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/wrtfmt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wsfe.c b/Build/source/utils/pmx/pmx-src/libf2c/wsfe.c index 8709f3b3479..8709f3b3479 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wsfe.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/wsfe.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wsle.c b/Build/source/utils/pmx/pmx-src/libf2c/wsle.c index 3e602702c0c..3e602702c0c 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wsle.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/wsle.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wsne.c b/Build/source/utils/pmx/pmx-src/libf2c/wsne.c index e204a51a4f1..e204a51a4f1 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/wsne.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/wsne.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/xwsne.c b/Build/source/utils/pmx/pmx-src/libf2c/xwsne.c index f810d3edbfe..f810d3edbfe 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/xwsne.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/xwsne.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_abs.c b/Build/source/utils/pmx/pmx-src/libf2c/z_abs.c index 4d8a015d384..4d8a015d384 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_abs.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_abs.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_cos.c b/Build/source/utils/pmx/pmx-src/libf2c/z_cos.c index 4abe8bf8820..4abe8bf8820 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_cos.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_cos.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_div.c b/Build/source/utils/pmx/pmx-src/libf2c/z_div.c index b61f03b8efc..b61f03b8efc 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_div.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_div.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_exp.c b/Build/source/utils/pmx/pmx-src/libf2c/z_exp.c index 7b8edfece03..7b8edfece03 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_exp.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_exp.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_log.c b/Build/source/utils/pmx/pmx-src/libf2c/z_log.c index 4f11bbe0c78..4f11bbe0c78 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_log.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_log.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_sin.c b/Build/source/utils/pmx/pmx-src/libf2c/z_sin.c index 01225a9448d..01225a9448d 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_sin.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_sin.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_sqrt.c b/Build/source/utils/pmx/pmx-src/libf2c/z_sqrt.c index 35bd44c8e08..35bd44c8e08 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/libf2c/z_sqrt.c +++ b/Build/source/utils/pmx/pmx-src/libf2c/z_sqrt.c diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmx.test b/Build/source/utils/pmx/pmx-src/pmx.test index 4055a6e47ed..4055a6e47ed 100755 --- a/Build/source/utils/pmx/pmx-2.7.0/pmx.test +++ b/Build/source/utils/pmx/pmx-src/pmx.test diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for b/Build/source/utils/pmx/pmx-src/pmx273.for index 3721bac92d0..7138e7d5ad6 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for +++ b/Build/source/utils/pmx/pmx-src/pmx273.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 @@ -63,8 +63,36 @@ c Undotted chord notes with dotted main note. c Forced line break without line number c Fix dot moving when 2nds in chord get flipped c To do: increase length on notexq in dodyn -c 2.70 -c To do: coda +c 2.73 (160121) +c Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as +c inline TeX. Replace all '~' inside "..." and not preceded with '\', by +c '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\ +c Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ", +c add (as type 2 string) '\\input musixlyr \' +c After inputting pathname, change any '\' to '/', for Linux compatibility. +c 2.72 (160110) +c Really finalize \mbrest...go back to 3 args to deal with clef changes. +c Fine tune centered whole bar rests to deal with clef changes +c Fix bug in wsclef when >1 staff per instrument, since \setclef +c needs to know instrument and specify clefs on all staves for that +c instrument. Ones that were not changed by user will not be printed, +c and will be kept the same as before. +c Fix bug with arpegii from one voice to another in same staff. +c 2.71 (151226) +c Finalize mbrest mods +c 2.705 +c Fix error message +c 2.704 (140614) +c Octave treble clef +c Make horizontal ornament shift (ornhshft) floating +c 2.703 (140323) +c Option v[-]n at end of any figure will alter figdrop for rest of system +c 2.702 +c Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v" +c 2.701 +c oC = coda (\code{10}) +c Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote) +c oG = new seqno c To do: fix grace note spacing problem (partially done) c 2.622 c Redefine midtc(..) and miditran(..); clean up all transpositions/key changes @@ -726,8 +754,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 /'2 Feb 16'/ + data version /'2.73'/ c ccccccccccccccccccccccccc data maxit,ncalls /200,0/ @@ -780,7 +808,7 @@ c read(*,'(a)')jobname numargs = 1 else -c call getarg(1,jobname,idum) ! May need to replace this w/ next line +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) @@ -793,7 +821,7 @@ c call getarg(1,jobname,idum) ! May need to replace this w/ next line 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 +c call getarg(2,jobname,idum) ! May need to replace this w/ next line call getarg(2,jobname) numargs = 1 go to 10 @@ -1172,7 +1200,7 @@ c 130330 end subroutine addblank(noteq,lnoten) character*8 noteq character*1 tchar - tchar = noteq + tchar = noteq(1:1) noteq = ' '//tchar lnoten = 2 return @@ -1347,7 +1375,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 +1471,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 @@ -1651,15 +1679,14 @@ c lsout = lsout+lnote return end - subroutine adjusteskz(ib,squez,istart,istop,poenom) + subroutine adjusteskz(ib,istart,poenom) c c For block ib, this adds accidental spaces to eskz, for use in getting c length of xtup bracket and slopes of brackets and beams. c parameter (nm=24) common /comas1/ naskb,task(40),wask(40),elask(40) - real*4 squez(80) - integer*4 istart(80),istop(80) + integer*4 istart(80) common /comnsp/ space(80),nb,prevtn(nm), * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, @@ -1787,21 +1814,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 +2303,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 @@ -2572,7 +2599,7 @@ c logical novshrinktop,cstuplet,usexnumt common /comnvst/ novshrinktop,cstuplet common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) character*10 figq ibc = ibmcnt(ivx) ipb1 = ibm1(ivx,ibc) @@ -2896,7 +2923,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 +3118,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 +3180,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, @@ -3162,14 +3189,16 @@ 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, * levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/ data EarlyTransOn, LaterInstTrans /2*.false./ data iInstTrans /nm*0/ + data iTransAmt /nm*0/ end subroutine catspace(space,squez,nnsk) parameter (nkb=3999,maxblks=4000) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /comtol/ tol - logical gotclef +c logical gotclef do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1 if (abs(space-durb(iptr)) .lt. tol) then if (abs(squez-sqzb(iptr)) .lt. tol) then @@ -3372,12 +3401,13 @@ c end if end if return end - subroutine chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev,ivmx, - * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) + subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx, +c * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) + * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl) parameter (nm=24) - integer*4 nn(nm),iornq(nm,0:200),islur(nm,200),irest(nm,200), + integer*4 nn(nm),islur(nm,200),irest(nm,200), * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8), - * ivmx(nm,2),mult(nm,200) + * ivmx(nm,2),mult(nm,200),ipl(nm,200) c c On 130127 put this code, formerly in make2bar right before calling notex for c a single note/rest, into this subroutine, so the same logic could also be @@ -3390,7 +3420,8 @@ c c Get reference level: next following note if no intervening blank rests, c otherwise next prior note. Relative to bottom line. c - if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then +c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then + if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then c c Not the last note and not "look-left" for level c @@ -3484,15 +3515,6 @@ c nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) 17 call g1etchar(lineq,iccount,charq) if (charq .eq. chax(92)) then itype = itype+1 -c if (itype .eq. 2) then -c if (iccount .ne. 2 ) then -cc -cc type 2 or 3 tex string not starting in column 1 -cc -c literr = 3 -c return -c end if -c else if (itype .gt. 3) then if (itype .gt. 3) then literr = 1 return @@ -3669,7 +3691,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 +3715,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 +3741,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 +3933,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 +4072,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 +4144,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 +4153,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 +4393,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 @@ -4487,6 +4509,7 @@ c c Arpeggio signal c c call putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) + print*,'Calling putarp chord, iv,ivx:',iv,ivx call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout) end if call addstr(notexq,lnote,soutq,lsout) @@ -4558,11 +4581,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 +4663,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 +4713,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 +4791,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 +4819,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 +4845,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 +4875,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 @@ -5047,7 +5070,7 @@ c character*3 acsymq character*1 sq,chax,udqq,ulq(nm,9) common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) sq = chax(92) isgaft = btest(ipl,29) iswaft = btest(ipl,31) @@ -5063,8 +5086,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 +5189,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 +5399,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 +5540,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 @@ -5581,6 +5604,7 @@ c 27 forced dir'n = up if on, set in sslur; also c final direction, set in doslur when beam is started, used on term. c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. c 18 int(ndxslur/16), ditto. So this allows ndxslur>15. +c 2 stem slur flag c c Bits in isdat2 c 0 Chord switch. Not set on main note. @@ -5657,17 +5681,6 @@ c if (btest(isdata,11)) then c c Turnon -c -c if (nolevs.eq.0 .or. nolevs.gt.60) then -cc -cc Note was a rest, cannot start slur on rest. -cc -c print* -c call printl('Cannot start slur on a rest') -c call stop1() -c nolevs = ncm+5 -c end if -c c Get slur direction c if (btest(isdata,26)) then @@ -5706,6 +5719,18 @@ c c Upper voice of the two, so up slur c end if + if (btest(isdata,2)) then +c +c ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. +c + if (stemup) then + slurudq = 'u' + ivoff = ivoff+4 + else + slurudq = 'd' + ivoff = ivoff-4 + end if + end if c c Set level for slur starting on rest c @@ -5778,7 +5803,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 +5835,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 @@ -5978,6 +6003,18 @@ c call addstr(chax(92)//'psforts'// * chax(48+min(abs(imid),6)),9,soutq,lsout) end if + if (btest(isdata,2)) then +c +c ADjust for stem slur. +c + if (stemup) then + slurudq = 'u' + ivoff = ivoff+4 + else + slurudq = 'd' + ivoff = ivoff-4 + end if + end if c c Shift slur ending for stem on any note? c @@ -6473,7 +6510,7 @@ c c c Dotted slur c - noteq = notexq + noteq(1:8) = notexq notexq = chax(92)//'dotted'//noteq lnote = lnote+7 end if @@ -7143,7 +7180,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 @@ -7311,10 +7348,11 @@ c c Compute an exponent eonk for use in the "flattened" formula for elemskips c vs time. We must solve the eqution f = 0. Initial quess is eonk0. c - logical gotclef +c logical gotclef common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /comtol/ tol common /comeon/ eonk,ewmxk eonk = eonk0 @@ -7448,7 +7486,8 @@ c * rest(nm,200),lenbr0,lenbr1,firstline,newmeter common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 common /compage/ widthpt,ptheight,hoffpt,voffpt, @@ -7484,7 +7523,7 @@ c common /comnvst/ novshrinktop,cstuplet common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur * ,WrotePsslurDefaults,SlurCurve - character*51 literq(3) + character*51 literq(3),lyrerq(5) common /comligfont/ isligfont logical isligfont common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), @@ -7497,6 +7536,12 @@ c * /'Literal TeX string cannot start with 4 backslashes!', * 'TeX string must have <129 char, end with backslash!', * 'Type 2 or 3 TeX string can only start in column 1!'/ + data lyrerq + * /'pmxlyr string must end with " followed by blank!', + * '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!'/ cdot = .false. 1 call g1etchar(lineq,iccount,charq) if (charq .ne. ' ') charlq = charq @@ -7538,7 +7583,7 @@ c c This is a note/rest. gotclef is only used for checking for clef before "/" c if (cdot) go to 28 - if (gotclef) gotclef=.false. +c if (gotclef) gotclef=.false. idotform = 0 numnum = 0 plusmin = .false. @@ -7826,7 +7871,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 @@ -8002,7 +8047,7 @@ c numint = 0 15 call g1etchar(lineq,iccount,dumq) iposn = iposn+1 - if (index('udlbfnht',dumq) .gt. 0) then + if (index('udlbfnhtv',dumq) .gt. 0) then if (dumq.eq.'t' .and. durq.eq.'t') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Cannot use "t" as an option on a tie!') @@ -8086,8 +8131,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 +8158,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. @@ -8150,7 +8195,8 @@ c end if if (usefig .and. ivx.eq.1) ifig = 1 26 call g1etchar(lineq,iccount,durq) - if (index('0123456789#-n_.:',durq) .gt. 0) then +c if (index('0123456789#-n_.:',durq) .gt. 0) then + if (index('0123456789#-n_.:v',durq) .gt. 0) then go to 26 else if (durq .eq. 's') then isligfont = .true. @@ -8256,6 +8302,17 @@ c call stop1() end if go to 110 + else if (durq .eq. '"') then +c +c pmx lyric +c + call chkpmxlyr(lineq,iccount,lyrerr) + if (lyrerr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * lyrerq(lyrerr)) + call stop1() + end if + go to 110 else if (durq .eq. 'M') then c c Temporary trap until I get around putting this in pmxb @@ -8264,7 +8321,7 @@ c * 'Macros not yet allowed in xtuplets!') call stop1() else if (durq .eq. 'X') then - call g1etx(lineq,iccount,.false.,shifton, + call g1etx(lineq,iccount,shifton, * ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt) go to 110 else if (durq .eq. 'z') then @@ -8308,6 +8365,20 @@ c call readnum(lineq,iccount,durq,fnum) iccount = iccount-1 go to 110 +c +c 140215 Allow clef change inside xtup +c + else if (durq .eq. 'C') then + call g1etchar(lineq,iccount,durq) + if (.not.(index('tsmanrbf',durq).gt.0 .or. +c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') + call stop1() + end if +c gotclef = .true. + go to 110 c+++ else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'[' * .and. lineq(iccount+2:iccount+2).eq.' ') then @@ -8471,7 +8542,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) @@ -8736,6 +8807,16 @@ c * literq(literr)) call stop1() end if + else if (charq .eq. '"') then +c +c pmx lyric +c + call chkpmxlyr(lineq,iccount,lyrerr) + if (lyrerr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * lyrerq(lyrerr)) + call stop1() + end if else if (charq .eq. 'o') then c c Ornament on non-xtup note. "o" symbol must come AFTER the affected note @@ -8746,7 +8827,8 @@ c call stop1() end if call g1etchar(lineq,iccount,dumq) - if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then +c if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then + if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal ornament!') call stop1() @@ -8871,7 +8953,7 @@ c * 'Cannot use "t" as an option on a tie!') call stop1() end if - if (index('udltb+-fnhHps ',dumq) .eq. 0) then + if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then c c Check for explicit ID code. c @@ -8915,7 +8997,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 +9116,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 @@ -9083,7 +9165,7 @@ c end if if (usefig) ifig = 1 5 call g1etchar(lineq,iccount,charq) - if (index(' 0123456789#-nx_.:+s',charq) .eq. 0) then + if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal character in figure!') call stop1() @@ -9155,7 +9237,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 "[ "!') @@ -9280,6 +9362,19 @@ c * 'Illegal unit; must be "p","i",or"m"!') call stop1() end if +c +c 151211 fix. May have extra character. +c + if (index('pim',durq) .gt. 0) then +c +c Get another character, see if it's blank +c + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'This character should be a blank!') + call stop1() + end if + end if if (charq .eq. 'h') then ptheight = int(dimen) else @@ -9329,13 +9424,14 @@ c call g1etchar(lineq,iccount,durq) if (.not.(index('tsmanrbf',durq).gt.0 .or. c * (ichar(durq).ge.48 .and. ichar(durq).le.54))) then - * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then +c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, c * 'Must have t,s,m,a,n,r,b,f or 1-6 after C!') - * 'Must have t,s,m,a,n,r,b,f or 1-7 after C!') + * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') call stop1() end if - gotclef = .true. +c gotclef = .true. else if (charq .eq. 'R') then if (ivx .ne. 1) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, @@ -9578,7 +9674,8 @@ c go to 27 else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'After "A" must follow one of the letters abcdeiINprRsST!') +c * 'After "A" must follow one of the letters abcdeiINprRsST!') + * 'After "A" must follow one of the letters abcdeiILNprRsST!') print*,'For AS, since ver. 2.7, must only have noinst args.' write(15,'(a)') * 'For AS, since ver. 2.7, must only have noinst args.' @@ -9691,7 +9788,7 @@ c * 'Cannot yet combine full and instrument transposition!') c call stop1() c end if call GetiTransInfo(.true.,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst,iv) + * ibaroff,nbars,noinst) end if else if (charq .eq. '|') then c @@ -9725,10 +9822,13 @@ c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Bar ended with user-defined shift still on!') call stop1() - else if (gotclef) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'May not enter clef at end of input block!') - call stop1() +c +c 140215 Temporary to allow clef change in stup +c +c else if (gotclef) then +c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'May not enter clef at end of input block!') +c call stop1() end if barend = .false. c @@ -10076,7 +10176,7 @@ c else if (charq .eq. 'F') then usefig = .false. else if (charq .eq. 'X') then - call g1etx(lineq,iccount,.true.,shifton,ibarcnt-ibaroff+nbars+1, + call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1, * udsp(ibarcnt+nbars+1),wheadpt) else if (charq .eq. 'I') then c @@ -10245,8 +10345,8 @@ c nline = nline+1 if (lineq(1:1) .eq. '%') go to 6 do 7 iv = 1 , nv -c if (index('brnamstf0123456',lineq(iv:iv)) .eq. 0) then - if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then +c if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then + if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then call errmsg(lineq,iv,0, * 'There should be a clef symbol here!') call stop1() @@ -10260,9 +10360,10 @@ c if (index('brnamstf0123456',lineq(iv:iv)) .eq. 0) then c c Set flag if voice 1 is treble, since it affects vertical spacing c - bottreb = lineq(1:1).eq.'t' +c bottreb = lineq(1:1).eq.'t' + bottreb = index('t08',lineq(1:1)).gt.0 c -c Mext non-comment line has path name +c Next non-comment line has path name c 8 call getbuf(lineq) nline = nline+1 @@ -10276,12 +10377,12 @@ c end if return end - subroutine g1etx(lineq,iccount,notxtup,shifton,ibar,udsp,wheadpt) + subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt) c c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. c - logical notxtup,shifton,number,btest + logical shifton,number,btest character*128 lineq character*1 charq,dumq number = .false. @@ -10295,9 +10396,6 @@ c if (btest(nPBSc,ipbsc)) then call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!') call stop1() -c else if (.not.notxtup .and. ipbsc.gt.2) then -c call errmsg(lineq,iccount,ibar,'Not allowed in xtuplet!') -c call stop1() end if nPBSc = ibset(nPBSc,ipbsc) go to 1 @@ -10408,9 +10506,6 @@ c iccount = iccount+1 charq = lineq(iccount:iccount) return -999 continue - lastchar = .true. - return end subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount) parameter (nm=24) @@ -10500,7 +10595,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 @@ -10585,24 +10680,15 @@ c return end subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig, - * itsofar,nodur,figq,ivupfig,nfigs) +c * itsofar,nodur,figq,ivupfig,nfigs) + * itsofar,nodur,figq,ivupfig,ivvfig,nfigs) logical isfig character*1 charq character*10 figq character*128 lineq -c -c As of 11/26/08, trapped extra figures in getnote, so no need here. -c -c if (ivx .gt. 2) then -cc -cc Read past the figure -cc -c6 call getchar(lineq,iccount,charq) -c if (charq .ne. ' ') go to 6 -c return -c end if nfigs = nfigs+1 ivupfig = 0 + ivvfig = 0 itoff = 0 if (charq .eq. 'x') then c @@ -10624,8 +10710,8 @@ c lfig = 1 figq = charq 5 call getchar(lineq,iccount,charq) -c if (charq .ne. ' ') then - if (index(' +',charq) .eq. 0) then +c if (index(' +',charq) .eq. 0) then + if (index(' +v',charq) .eq. 0) then figq = figq(1:lfig)//charq lfig = lfig+1 go to 5 @@ -10636,6 +10722,17 @@ c iccount = iccount+1 call readnum(lineq,iccount,charq,fnum) ivupfig = nint(fnum) + else if (charq .eq. 'v') then +c +c Get vertical change in figdrop. Must be last item in figure word. +c + isign = 1 + call getchar(lineq,iccount,charq) + if (charq .eq. '-') then + isign=-1 + call getchar(lineq,iccount,charq) + end if + ivvfig = isign*(ichar(charq)-48) end if return end @@ -10801,7 +10898,7 @@ c return end subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst,iv) + * ibaroff,nbars,noinst) cccccccccccccccccccccccc cc cc GetiTransInfo.for @@ -11053,7 +11150,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 +11173,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 +11196,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) @@ -11350,7 +11447,7 @@ c * inhead common /cominbot/ inbothd common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage, * OptLineBreakTies,HeaderSpecial @@ -11411,7 +11508,7 @@ c character*128 txtdynq logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur, * fontslur,WrotePsslurDefaults - character*128 lineq,lnholdq + character*128 lineq,lnholdq,lineqt character*80 headrq, lowerq character*79 inameq character*59 hdlndq @@ -11432,6 +11529,8 @@ c logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3 common /combibarcnt/ ibarcnt common /commidisig/ midisig + common /comlyr/ inputmlyr + logical inputmlyr cdot = .false. 1 call getchar(lineq,iccount,charq) if (lastchar) return @@ -11882,6 +11981,27 @@ c else if (charq .eq. sq) then call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) go to 7 + else if (charq .eq. '"') then +cc +cc pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ +cc +c do 90 i2nd = iccount+1 , 128 +c if (lineq(i2nd:i2nd) .eq. '"') go to 91 +c90 continue +c91 continue +c if (iccount .eq. 1) then +c lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq +c * //lineq(i2nd+1:128) +c else +c lineqt = lineq(1:iccount-1)//sq//'pmxlyr{' +c * //lineq(iccount+1:i2nd-1)//'}'//sq +c * //lineq(i2nd+1:128) +c end if +c lineq = lineqt + call dopmxlyr(lineq,iccount) + charq = sq + call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) + go to 7 else if (index('0123456789#-nx_',charq) .gt. 0) then c c Figure. Must come AFTER the first note of xtup @@ -11898,9 +12018,11 @@ 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)) +c * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) + * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1), + * nfigs(ivf)) go to 7 else if (charq .eq. 'X') then call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)), @@ -12053,6 +12175,66 @@ c call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1), * iornq(ivx,nnl(ivx)-1),lineq,iccount) go to 7 +c +c 140215 Allow clef change inside xtuplet. With normal code, came out one +c note too late, so try making it come earlier. +c + else if (charq .eq. 'C') then +c +c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. +c +c if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1 + if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1 +c +c 140218 Need to get time differently inside xtup, since itsofar doesn't get +c updated until after xtup is done +c +c tcc(iv,ncc(iv)) = itsofar(iv) + nodurt = ifnodur(nnodur,dotq) + tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1)) +c print*,'itsofar,ncc,nodurt,ntup,itup,tcc:' +c print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv)) +c isl = ibset(islur(iv,nnl(iv)+1),11) + isl = ibset(islur(iv,nnl(iv)),11) + call getchar(lineq,iccount,durq) +c +c Store clef number, or 7 if clef number = 9 (French violin clef) +c + isl = ior(isl,ishft(min(numclef(durq),7),12)) + ncmidcc(iv,ncc(iv)) = ncmidf(durq) + if (durq .eq. '8') then + ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2) + iTransAmt(instno(iv)) = 7 + end if +c +c Set marker on note with lowest voice # starting at same time. +c + if (iv .eq. 1) then + isl = ibset(isl,15) + else + do 70 iiv = 1 , iv +c nnliiv = nnl(iiv) + nnliiv = nnl(iiv)-1 + if (iiv .eq. iv) nnliiv = nnliiv+1 + itother = 0 + do 71 iip = 1 , nnliiv + if (itother .lt. itsofar(iv)) then + itother = itother+nodur(iiv,iip) + go to 71 + else if (itother .eq. itsofar(iv)) then + islur(iiv,iip) = ibset(islur(iiv,iip),15) + go to 72 + end if +71 continue +70 continue +72 continue + end if +c +c Need 'or' since may have set bit 15 in the above loop +c +c islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) + islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv))) + go to 7 c+++ else if (charq .eq. ']') then c @@ -12308,7 +12490,8 @@ c c c With keyboard rest option, look left c - iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) +c iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1) go to 2 else if (index('DF',durq) .gt. 0) then c @@ -12477,7 +12660,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 +12680,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) @@ -12619,7 +12802,6 @@ c else if (charq .eq. 'G') then call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, * lastlev,iv,nv) - continue c c Grace, comes *before* main note: c UNLESS there's an 'A' or 'W' after the 'G' @@ -12634,137 +12816,24 @@ c slashg(ngrace) = T if slash; default is F, input 'x' c These data MUST precede note name of first note c nolevg, naccg: lists of levels and accid's, indexed as described above. c -c ngrace = ngrace+1 -c ivg(ngrace) = ivx -c ipg(ngrace) = nnl(ivx)+1 -c if (ngrace .eq. 1) then -c ngstrt(ngrace) = 1 -c else -c ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1) -c end if -c islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4) -c nng(ngrace) = 1 -c multg(ngrace) = 1 -c upg(ngrace) = .true. -c slurg(ngrace) = .false. -c slashg(ngrace) = .false. -c18 call getchar(lineq,iccount,charq) -c if (index('WA',charq) .gt. 0) then -cc -cc Grace is on note that was already done, so shift flags forward one note. -cc This puts flag on actual note with grace; later for W will go ahead one more. -cc -c ipg(ngrace) = nnl(ivx) -c islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4) -c islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4) -c if (slurg(ngrace)) -c * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24) -c if (charq .eq. 'A') then -cc -cc close After, clear way-after bit, to ensure priority of most recent A/W -cc -c ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29) -c else -cc -cc Way after; later assign to following note, and position like normal grace. -cc -c ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31) -c end if -c else if (charq .eq. 'm') then -c call getchar(lineq,iccount,charq) -c multg(ngrace) = ichar(charq)-48 -c else if (index('123456789',charq) .gt. 0) then -c call readnum(lineq,iccount,durq,fnum) -c iccount = iccount-1 -c nng(ngrace) = nint(fnum) -c else if (charq .eq. 'l') then -c upg(ngrace) = .false. -c else if (charq .eq. 's') then -c slurg(ngrace) = .true. -c if (nnl(ivx) .gt. 0) then -cc -cc If A- or W-grace, set signal to start slur on main note. -cc -c if(btest(ipl(ivx,nnl(ivx)),31) .or. -c * btest(ipl(ivx,nnl(ivx)),29)) -c * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24) -c end if -c else if (charq .eq. 'x') then -c slashg(ngrace) = .true. -c else if (charq .eq. 'u') then -c else if (charq .eq. 'X') then -cc -cc Space before main note of grace. Number will come next. -cc -c iccount = iccount+1 -c call readnum(lineq,iccount,durq,graspace(ngrace)) -c iccount = iccount-1 -c end if -c if (index('abcdefg',charq) .eq. 0) go to 18 -cc -cc At this point, charq is first note name in grace -cc -c do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1 -c naccg(ing) = 0 -c ioct = 0 -c if (ing .gt. ngstrt(ngrace)) then -c55 call getchar(lineq,iccount,charq) -c if (charq .eq. ' ') go to 55 -c endif -c iclastlev = 0 -c9 call getchar(lineq,iccount,durq) -c if (durq .ne. ' ') then -c if (durq.eq.'+') then -c lastlev = lastlev+7 -c iclastlev = iclastlev+7 -c else if (durq.eq.'-') then -c lastlev = lastlev-7 -c iclastlev = iclastlev-7 -c else if (index('fsn',durq) .gt. 0) then -c if (naccg(ing) .eq. 0) then -c naccg(ing) = index('fsn',durq) -c else -cc -cc Double accidental -cc -c naccg(ing) = ibset(naccg(ing),2) -c end if -c else -c ioct = ichar(durq)-48 -c end if -c go to 9 -c end if -c if (ioct .gt. 0) then -c lastlev = ifnolev(charq,ioct) -c else -c if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then -c if (ivx .le. nv) then -c kv = 1 -c else -c kv = 2 -c end if -c lastlev = ndlev(iv,kv)+iclastlev -c end if -c lastlev = lastlev-3+mod(ifnolev(charq,10)-lastlev+3,7) -c end if -c nolevg(ing) = lastlev -c19 continue -cc -cc Grace could come before first note of block, so reset end level. -cc -c if (nnl(ivx).eq.0) then -c if (ivx .le. nv) then -c kv = 1 -c else -c kv = 2 -c end if -c ndlev(iv,kv) = lastlev -c end if else if (charq .eq. sq) then c c Literal TeX string c call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) + else if (charq .eq. '"') then +c +c pmxlyr string. Expand "..." to \pmxlyr{...}\ +c + if (.not. inputmlyr) then + ictemp = 0 + lineqt = sq//sq//sq//'input musixlyr '//sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp) + inputmlyr = .true. + end if + call dopmxlyr(lineq,iccount) + charq = sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) else if (charq .eq. 'o') then c c Ornament on non-xtup note. Symbol must come AFTER the affected note @@ -12855,7 +12924,8 @@ c call getfig(itoff(ivf,nfig1),charq,lineq,iccount, * isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx), * nodur(ivx,nnl(ivx)),figq(ivf,nfig1), - * ivupfig(ivf,nfig1),nfigs(ivf)) +c * ivupfig(ivf,nfig1),nfigs(ivf)) + * ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf)) else if (charq .eq. '[') then c c Start forced beam. Record barno & time since start of inp. blk. Set signal @@ -13134,6 +13204,20 @@ c * //chax(48+iinow)//chax(48+nspern(iinow))//'%' write(11,'(a)')sq//'setclef'//chax(48+iinow) * //hdlndq(1:lclf)//'%' + if (fullsize(iiorig(iinow)).gt.0.9) then + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'normalvalue%' +c +c 140526 Account for staff size specs when noinst changes. May be confusion +c here if more than one staff per instrument +c + else if (fullsize(iiorig(iinow)).gt..7) then + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'smallvalue%' + else + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'tinyvalue%' + end if else write(11,'(a11,i2,a)')sq//'setstaffs{',iinow, * '}'//chax(48+nspern(iinow))//'%' @@ -13246,7 +13330,13 @@ c c Store clef number, or 7 if clef number = 9 (French violin clef) c isl = ior(isl,ishft(min(numclef(durq),7),12)) - ncmidcc(iv,ncc(iv)) = ncmidf(durq) + ncmidcc(iv,ncc(iv)) = ncmidf(durq) + if (durq .eq. '8') then + ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2) + iTransAmt(instno(iv)) = 7 + else + if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0 + end if c c Set marker on note with lowest voice # starting at same time. c @@ -13294,7 +13384,8 @@ c else if (durq .eq. 'b') then islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25) else if (durq .eq. 'z') then - iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) +c iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) + ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0) end if rptprev = .true. rptfq1 = durq @@ -13447,7 +13538,7 @@ c c A kluge for parts from separate score file for later movements. c if (instrq(1:1) .eq. ' ') headlog = .false. - cheadq = instrq + cheadq = instrq(1:60) else if (durq .eq. 't') then call getchar(lineq,iccount,durq) c @@ -13622,7 +13713,7 @@ c else if (durq .eq. 'c') then call g1etchar(lineq,iccount,durq) c -c Just eat the input; it was used in pmax +c Just eat the input; it was used in pmxa c go to 27 end if @@ -13692,7 +13783,7 @@ c c Instrument specific transposition. c call GetiTransInfo(.false.,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst,iv) + * ibaroff,nbars,noinst) c c The sig parameters will have been set 1st time but that's OK c @@ -13849,7 +13940,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 +13962,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), @@ -13931,11 +14022,14 @@ c c Isolate 21 bits defining exisiting ornaments c if (notcrd) then - iorni = iand(4194303,iornq) +c iorni = iand(4194303,iornq) +c iorni = iand(541065215,iornq) + iorni = iand(1614807039,iornq) else iorni = iand(4194303,icrdorn(ncrd)) end if - korn = index('stmgx+Tupf._)e:XXX>^',charq) +c korn = index('stmgx+Tupf._)e:XXX>^',charq) + korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq) if (korn .ne. 15) iorni = ibset(iorni,korn) c c Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later @@ -13945,10 +14039,13 @@ c if (korn .eq. 15) then c cc 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 +cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq +c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq c c iorni = ior(iorni,iand(iornq0,1638383)) - iorni = ior(iorni,iand(iornq0,3735535)) +c iorni = ior(iorni,iand(iornq0,3735535)) +c iorni = ior(iorni,iand(iornq0,540606447)) + iorni = ior(iorni,iand(iornq0,1614348271)) ornrpt = .false. call getchar(lineq,iccount,durq) c @@ -14060,7 +14157,8 @@ c xofforn = 44-ichar(durq) iccount = iccount+1 call readnum(lineq,iccount,durq,fnum) - ornhshft(nudorn) = nint(xofforn*fnum) +c 141226 ornhshft(nudorn) = nint(xofforn*fnum) + ornhshft(nudorn) = xofforn*fnum end if else if (durq .eq. ':') then c @@ -14307,7 +14405,7 @@ c if (inameq(i)(1:1) .eq. '%') go to 5 4 continue c -c Mext non-comment line has nv clef names +c Next non-comment line has nv clef names c 6 call getbuf(lineq) if (lineq(1:1) .eq. '%') go to 6 @@ -14331,6 +14429,15 @@ c 8 call getbuf(pathnameq) if (pathnameq(1:1) .eq. '%') go to 8 lpath = index(pathnameq,' ')-1 +c +c 160130 Replace '\' by '/' +c +12 ipos = index(pathnameq,'\') + if (ipos .gt. 0) then + pathnameq(ipos:ipos)='/' + print*,'Changed pathname to ',pathnameq(1:lpath) + go to 12 + end if return end function getsquez(n,ntot,space,tnote,to) @@ -14352,7 +14459,6 @@ c c Since to() is ordered by start times, exit loop after first note that c starts later than note of interest. c - if (to(in) .gt. to(n)+tol) go to 2 if (to(in)+tnote(in) .gt. tend-tol) then c @@ -14615,7 +14721,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 +14812,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 +14824,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 @@ -14977,6 +15083,9 @@ c end if end if else +c +c Type 2 or 3. +c if (itype .eq. 3) then c c Write the string NOW @@ -15098,7 +15207,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 +15266,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 @@ -15205,7 +15314,7 @@ c logical beamon,firstgulp,figbass,figchk,isfig,bar1syst common /comeskz2/ eskz2(nm,200) common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /combeam/ ibmtyp common /comask/ bar1syst,fixednew,scaldold, * wheadpt,fbar,poenom @@ -15766,7 +15875,7 @@ c * isbj2 common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2 common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /combeam/ ibmtyp common /comask/ bar1syst,fixednew,scaldold, * wheadpt,fbar,poenom @@ -15860,7 +15969,8 @@ c c 130316 common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) -c + common /comclefrests/ centrests + logical centrests c c Set up main ib loop within which a block (notes group) is written c @@ -15927,8 +16037,21 @@ c In preceding line, fl32 gave wrong result for ... .gt.0 !!! c do 140 in = istart(ib) , istop(ib) if (btest(islur(ivxo(in),ipo(in)),11)) then - call wsclef(ivxo(in),ninow,clefq, + call wsclef(ivxo(in),ninow, * iand(ishft(islur(ivxo(in),ipo(in)),-12),7)) +c +c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% +c +c if (clefq(ivxo(in)) .eq. '8') then + if (btest(ipl(ivxo(in),ipo(in)),2)) then + if (iv .le. 9) then + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + else + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + end if + end if end if 140 continue if (islast) write(11,'(a)')sq//'pmxnewclefs' @@ -16335,7 +16458,7 @@ c End of ask analysis for this block. c c Adjust eskz if there are added spaces. Corrects length of xtup brackets. c - if (naskb.gt.0) call adjusteskz(ib,squez,istart,istop,poenom) + if (naskb.gt.0) call adjusteskz(ib,istart,poenom) c c Check for internal repeat or sig change. c @@ -16543,6 +16666,11 @@ c print*,'At clef insertion, ptclef:',ptclef(iv) c print*,'Just added: ',notexq(1:lnote) end if call clefsym(islur(iv,ip),notexq,lnote,nclef) +c +c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' +c + if (btest(ipl(ivx,ip),2)) notexq = + * notexq(1:8)//'8'//notexq(10:10) call addstr(notexq,lnote,soutq,lsout) if (ptclef(iv) .gt. 0.) then notexq = sq//'off{' @@ -16590,6 +16718,7 @@ c Arpeggio on a main (non-chordal) note? c if (btest(iornq(ivx,ip),27)) then c call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), + print*,'Calling putarp main, iv,ivx:',iv,ivx call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip), * soutq,lsout) end if @@ -16606,9 +16735,10 @@ c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib) c c Shift beam start if notehead was shifted @@ -16695,7 +16825,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 +16926,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) @@ -16848,7 +16978,9 @@ c Check for main-note ornaments. ')' on dotted notes go in with note, not here. c Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F c 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD c - isacc = iand(iornq(ivx,ip),4194287) .gt. 0 +c isacc = iand(iornq(ivx,ip),4194287) .gt. 0 +c isacc = iand(iornq(ivx,ip),541065199) .gt. 0 + isacc = iand(iornq(ivx,ip),1614807023) .gt. 0 c c isacc=.true. if any ornament except segno c @@ -16982,9 +17114,10 @@ c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) call beamn1(notexq,lnote) end if bspend = .false. @@ -17018,9 +17151,10 @@ c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) call beamid(notexq,lnote) c c Or whole-bar rest @@ -17139,11 +17273,12 @@ c nolev(ivx,ip) = 100+iraise c c The new subroutine call, to replace above code c - call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) end if -2 continue +c2 continue c c Write a separate note or rest c @@ -17437,31 +17572,7 @@ c c Write multibar rest. Assuming nv = 1 and do not worry about cwbrest c This has to be the only use of atnextbar c -c if (ibar .eq. ibarmbr) then if (ibar.eq.ibarmbr .and. islast) then -c call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes'//sq// -c * 'mbrest{',30,soutq,lsout) -c ndig = int(alog10(mbrest+.01))+1 -c write(soutq(31:33),'(i'//chax(48+ndig)//')')mbrest -c lsout = lsout+ndig -c call addstr('}{',2,soutq,lsout) -c mtrspc = .5+xb4mbr -c xb4mbr = 0. -c if (mtrspc .eq. 0) then -c ndig = 1 -c else -c ndig = int(alog10(mtrspc+.01))+1 -c end if -c write(soutq(lsout+1:lsout+2),'(i'//chax(48+ndig)//')')mtrspc -c lsout = lsout+ndig -c call addstr('}0'//sq//'en}%',7,soutq,lsout) -c if (islast) write(11,'(a)')soutq(1:lsout) -c lsout = 0 -c ndig = int(alog10(mbrest-1+.01))+1 -c if (mbrest.eq.1) ndig=1 -c if (islast) write(11,'(a14,i'//chax(48+ndig)//',a1)') -c * sq//'advance'//sq//'barno',mbrest-1,'%' -c++ soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes' lsout = 22 notexq = sq//'mbrest' @@ -17469,7 +17580,7 @@ c++ call istring(mbrest,noteq,len) notexq = notexq(1:lnote)//noteq(1:len) lnote = lnote+len - mtrspc = .5+xb4mbr + mtrspc = nint(xb4mbr) xb4mbr = 0. call istring(mtrspc,noteq,len) notexq = notexq(1:lnote)//noteq(1:len)//'0' @@ -17488,19 +17599,21 @@ c++ end if else if (iscwr) then c -c Centered whole-bar rests +c Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar +c to check for new clef and add space by redefining \CenterBar c + centrests = .true. + call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout) call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22, * soutq,lsout) do 60 iv = 1 , nv +c added lnote = 0 +c do 61 kv = 1 , nvmx(iv) ivx = ivmx(iv,kv) if (cwrest(ivx)) then - if (lnote .eq. 0) then - notexq = sq//'centerbar{' - lnote = 11 - end if + call addstr(sq//'CenterBar{',11,soutq,lsout) if (.not.cwrferm(ivx)) then if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then c @@ -17510,30 +17623,29 @@ c * cwrq(ivx)(2:10).eq.'liftPAuse') * cwrq(ivx)(10:10) = 'c' end if - notexq = notexq(1:lnote)//cwrq(ivx)(1:lcwr(ivx)) - lnote = lnote+lcwr(ivx) + call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq, + * lsout) + call addstr('}{-2}{'//sq//'value}',13,soutq,lsout) else c c Fermata on centered rest. Will need to fix up level. c 12/6/07 shift it left so it's centered over rest c -c notexq = notexq(1:lnote) -c * //sq//'fermataup7'//cwrq(ivx)(1:lcwr(ivx)) -c lnote = lnote+11+lcwr(ivx) -c - notexq = notexq(1:lnote)//sq//'loffset{.39}{' + notexq = notexq(1:lnote)//sq//'loffset{.33}{' * //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx)) - lnote = lnote+26+lcwr(ivx) + * //'}{-2}{'//sq//'value}' + lnote = lnote+26+lcwr(ivx)+13 + call addstr(notexq,lnote,soutq,lsout) cwrferm(ivx) = .false. end if end if 61 continue - if (lnote .gt. 0) call addstr(notexq(1:lnote)//'}',lnote+1, - * soutq,lsout) if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout) 60 continue - call addstr(sq//'en}',4,soutq,lsout) - if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%' + if (islast) then + call addstr(sq//'en}%',5,soutq,lsout) + if (lsout.gt.0)write(11,'(a)')soutq(1:lsout) + end if end if c c End of block for centered whole-bar rests and multi-bar rests @@ -17545,7 +17657,6 @@ c do 63 iv = 1 , nv do 63 kv = 1 , nvmx(iv) ivx = ivmx(iv,kv) -c prevtn(ivx) = tnote(iand(ipl(ivx,nn(ivx)),255)) prevtn(ivx) = tnote(ipl2(ivx,nn(ivx))) 63 continue end if @@ -17603,9 +17714,11 @@ c common /linecom/ elskb,tnminb(nkb) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) - logical rest,firstline,newmeter,gotclef +c logical rest,firstline,newmeter,gotclef + logical rest,firstline,newmeter integer cnn(nm),istart(80),istop(80) real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600) elskb = 0. @@ -17945,7 +18058,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 @@ -17982,7 +18095,14 @@ c ncmidf = 37 c else c ncmidf = 23 c end if - ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2 + if (clefq .eq. '8') then +c +c treblelowoct; will treat as treble for this purpose +c + ncmidf = 35 + else + ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2 + end if return end subroutine newvoice(jv,clefq,change) @@ -18094,7 +18214,7 @@ c character*40 restq common /compoi/ ispoi common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) character*10 figq ip = ipo(jn) nole = nolev(ivx,ip) @@ -18511,12 +18631,20 @@ c call istring(mod(iv,12),tempq,len) end function numclef(clefq) c -c Returns the number to be used as argument of \setclef (for MusiXTeX only) +c Returns the number to be used as argument of \setclef for MusiXTeX +c For input 0-6 or tsmanrb return 0-7 +c 7 f 9 +c 8 0 +c character*1 clefq -c if (ichar(clefq) .lt. 55) then - if (ichar(clefq) .le. 55) then + if (ichar(clefq) .lt. 55) then +c if (ichar(clefq) .le. 55) then numclef = ichar(clefq)-48 - if (numclef .eq. 7) numclef = 9 +c if (numclef .eq. 7) numclef = 9 + else if (clefq .eq. '7') then + numclef = 9 + else if (clefq .eq. '8') then + numclef = 0 else numclef = index('tsmanrbxxf',clefq)-1 end if @@ -18575,7 +18703,8 @@ ccccccccccccccccccccccccccccccccccc * nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /compage/ widthpt,ptheight,hoffpt,voffpt, * nsyst,nflb,ibarflb(0:40), * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), @@ -18604,7 +18733,8 @@ ccccccccccccccccccccccccccccccccccc common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac common /commus/ musize,whead20 common /comeon/ eonk,ewmxk - logical mrecord,mplay,endmac,gotclef,cstuplet +c logical mrecord,mplay,endmac,gotclef,cstuplet + logical mrecord,mplay,endmac,cstuplet logical novshrinktop,upslur,fontslur,WrotePsslurDefaults common /comnvst/ novshrinktop,cstuplte common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur @@ -18636,7 +18766,7 @@ ccccccccccccccccccccccccccccccccccc mplay = .false. lastchar = .false. novshrinktop = .false. - cstuplet = .false. + cstuplet = .false. fontslur = .true. isligfont = .false. fulltrans = .false. @@ -18734,7 +18864,7 @@ c newmeter = .false. ihead = 0 isheadr = .false. - gotclef = .false. +c gotclef = .false. idsig = 0 iddot = 0 fintstf = -1. @@ -18746,7 +18876,7 @@ c issegno = .false. nbars = 0 ibarmbr = 0 -3 do 4 iv = 1 , nv + do 4 iv = 1 , nv nvmx(iv) = 1 ivmx(iv,1) = iv itsofar(iv) = 0 @@ -18833,7 +18963,7 @@ c call makeabar() elsk(ibarcnt) = elskb+fbar 10 continue - newmeter = .false. + newmeter = .false. firstline = .false. go to 30 20 continue @@ -19366,7 +19496,12 @@ ccccccccccccc cc ipl cc ccccccccccccc cc 0-7 Location in list [0,200] -c 0-7 Unused +cc 0-7 Unused +c 0 blank barline (must be iv=1) (would have used islur but no room) +c 1 look left for K rests, moved here from iornq(30) +c 2 treblelowoct +cc 2-7 Unused +c 3-7 unused c 8 left offset main note one headwidth c 9 right offset main note one headwidth c 10 chord present? @@ -19401,8 +19536,10 @@ c 25 Tweak orn ht. Same in icrdorn for chord note c 26 Insert user-defined space before this note (was 22) c 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord c 28 caesura or breath -c 29 blank barline (must be iv=1) (would have used islur but no room) -c 30 "Look-left" option for keyboard rest +cc 29 blank barline (must be iv=1) (would have used islur but no room) +c 29 coda +cc 30 "Look-left" option for keyboard rest +c 30 Part-by-part segno oG c 31 Set if any note (main or chord) has cautionary accid, for space checks ccccccccccccc cc irest cc @@ -19561,7 +19698,7 @@ cccccccccccccccccccccccccccccccc * inhead common /cominbot/ inbothd common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /comnsp/ space(80),nb,prevtn(nm), * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) common /comstart/ facmtr @@ -19648,12 +19785,19 @@ cccccccccccccccccccccccccccccccc common /combibarcnt/ ibarcnt character*40 nmq common /commidisig/ midisig + common /comclefrests/ centrests + logical newclef, centrests + common /comlyr/ inputmlyr + logical inputmlyr + data inputmlyr /.false./ if (.not.optimize) then print* print*,'Starting second PMX pass' print* write(15,'(a)')'Starting second PMX pass' end if + newclef = .false. + centrests = .false. ncalls = ncalls+1 islast = inlast macuse = 0 @@ -19665,7 +19809,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 +19962,7 @@ c nobar1 = .false. equalize = .false. usevshrink = .true. - WrotePsslurDefaults = .false. + WrotePsslurDefaults = .false. OptLineBreakTies = .false. HeaderSpecial = .false. c @@ -19968,11 +20112,10 @@ c jprntb = 0 end if ibcoff = ibcoff+mbrest-1 +c if (ibar.eq.1 .and. firstgulp .and. +c * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize if (ibar.eq.1 .and. firstgulp .and. - * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize -c -c The above may be he only case where the space-before option is used in \mbrest -c + * .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize end if c c Move the read to after end-of-bar hardspace checks, so we get right poenom @@ -19995,13 +20138,18 @@ c putmbr = .false. if (ismbr) then if (clchb) then -c -c Clef change and multi-bar rest coming up. Kluge to get space at end of rest. -c +ccc +ccc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. +ccc write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest' * //sq//'def'//sq//'mbrest#1#2#3{%' write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55, * '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%' +cc +cc RDT suggestion is inset blank barline - 160103 Abandoned +cc +c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' +c * //sq//'advance'//sq//'barno-1' end if ismbr = .false. putmbr = .true. @@ -20103,16 +20251,64 @@ c c Must call clefsym to get nclef, even if there is a movement break c call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef) +c +c If clefq = '8', must change '0' in pos'n 9 to '8' +c + if (btest(ipl(iv,ioff+1),2)) fmtq = + * fmtq(1:8)//'8'//fmtq(10:10) if (movbrk.eq.0 .and. * islast) * write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%' - call wsclef(iv,ninow,clefq,nclef) +c call wsclef(iv,ninow,clefq,nclef) + call wsclef(iv,ninow,nclef) +c +c Set new flag to be used just outside this loop, to kluge +c any calls to \CenterBar for full-bar rests, to make room for clef. +c + newclef = .true. +c +c 151220 +c wrong test: +c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% +c Replaced with right one. But also, clefq(iv) seems to stay at 8 here, +c and if we change from TLO to normal clef, need to resetclefsymbols +c +c if (clefq(iv) .eq. '8') then + if (btest(ipl(iv,ioff+1),2)) then + if (iv .le. 9) then + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + else + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + end if + else + if (clefq(iv) .eq. '8') then + write(11,'(a20)')sq//'resetclefsymbols' + end if + end if end if 17 continue if (islast) write(11,'(a)')sq//'pmxnewclefs' end if 23 continue c +c Kluge \CenterBar for whole bar rests if necessary +c + if (newclef .and. centrests) then +c write(11,'(a)')sq//'def'//sq//'value{11}%' + nvalue = nint(.55*musicsize) + if (nvalue .gt. 10) then + write(11,'(a11,i2,a2)') + * sq//'def'//sq//'value{',nvalue,'}%' + else + write(11,'(a11,i1,a2)') + * sq//'def'//sq//'value{',nvalue,'}%' + end if + end if + newclef = .false. + centrests = .false. +c c End of loop for end-of-bar hardspaces and non-movbrk clef symbol. c if (bar1syst) then @@ -20123,10 +20319,12 @@ c Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) c if (ibar .eq. 1) then islnow = islur(1,1) - iornqnow = iornq(1,1) +c iornqnow = iornq(1,1) + iplnow = ipl(1,1) else islnow = islur(1,nib(1,ibar-1)+1) - iornqnow = iornq(1,nib(1,ibar-1)+1) +c iornqnow = iornq(1,nib(1,ibar-1)+1) + iplnow = ipl(1,nib(1,ibar-1)+1) end if c c Check for R-symbols set at end of prior input block @@ -20176,7 +20374,8 @@ c doubleBAR c if (islast) write(11,'(a)')sq//'setdoubleBAR' fixednew = fixednew+wheadpt*ddbarfac-0.4 - else if (btest(iornqnow,29)) then +c else if (btest(iornqnow,29)) then + else if (btest(iplnow,0)) then c c no bar line c @@ -20241,6 +20440,11 @@ c c c End an old system, Start a new system c +c Reduce space before mbrest at start of system +c Need this even if no accidentals in key signature +c + if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize +c if (iline .ne. 1) then c c Not first line. @@ -20397,7 +20601,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 @@ -20577,7 +20781,7 @@ c if (islast) call wgmeter(mtrnmp,mtrdnp) if (mtrdnp .gt. 0) then if (islast) write(11,'(a)')sq//'newtimes2%' - if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize end if end if end if @@ -20671,7 +20875,7 @@ c write(11,'(a)')sq//'addspace{-'//sq// * 'afterruleskip}'//sq//'zchangecontext' end if - if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize else if (islast) write(11,'(a)')sq//'alaligne' end if @@ -20755,7 +20959,8 @@ c else naccs = abs(lastisig-isig) end if - xb4mbr = (facmtr+naccs*.24)*musicsize +c xb4mbr = (facmtr+naccs*.24)*musicsize + xb4mbr = -.2*musicsize end if else c @@ -20787,7 +20992,8 @@ c else naccs = abs(lastisig-isig) end if - xb4mbr = naccs*.24*musicsize +c xb4mbr = naccs*.24*musicsize + xb4mbr = -.2*musicsize end if end if else if (mtrnuml .eq. 0) then @@ -20803,8 +21009,17 @@ c if (movbrk .eq. 0) then if (islast) call wgmeter(mtrnmp,mtrdnp) if (mtrdnp .gt. 0) then - if (islast) write(11,'(a,2i1,a)')sq//'newtimes0%' - if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (islast) then +c if (mbrest .gt. 0) then +cc write(11,'(a)')sq//'addspace{-2'//sq// +cc * 'afterruleskip}'//sq//'setemptybar'//sq//'bar' +c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq// +c * 'advance'//sq//'barno-1%' +c end if + write(11,'(a,2i1,a)')sq//'newtimes0%' + end if +c if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize else if (islast) write(11,'(a)')sq//'xbar' end if @@ -20971,6 +21186,7 @@ c figq(ivx,jfig-islide) = figq(ivx,jfig) itoff(ivx,jfig-islide) = itoff(ivx,jfig) ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig) + ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig) end if 20 continue nfigs(ivx) = nfigs(ivx)-islide @@ -21125,7 +21341,6 @@ c sumx = sumx+poe(isyst) sumxx = sumxx+poe(isyst)**2 1 continue -2 continue devnorm = sqrt(nsyst*sumxx/sumx**2-1) poebar = sumx/nsyst return @@ -21168,7 +21383,7 @@ c minlev = nolevm levtabl(nolevm) = -1 is2nd = .false. - naccid = 0 + naccid = 0 levmaxacc = -100 levminacc = 1000 c @@ -21347,18 +21562,21 @@ c return end subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) + parameter (nm=24) common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), * xinsnow,lowdot common /comtol/ tol common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), * ArpShift(20) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx logical lowdot,IsArpShift character*80 soutq character*79 notexq character*8 symq(2) character*1 chax data symq /'raisearp','arpeggio'/ - +c +c NOTE iv in arg list is really ivx, referring to voice rather than staff. c c Find which iarp, if any c @@ -21377,7 +21595,7 @@ c return 2 continue c -c If here, this is *second* call at this time, iarp points to values from 1st. +c If here, this is *second* call at this time, narp points to values from 1st. c c Check for shift. Set IsArpShift and iarps c @@ -21396,16 +21614,43 @@ c 4 continue if (iv .eq. ivar1(iarp)) then c -c Arp is in a single staff. +c Arp is in a single voice. c levbot = min(levar1(iarp),nolev)-ncm+3 invert = abs(levar1(iarp)-nolev)+1 else c -c Arp covers >1 staff. Lower staff has to be the first, upper is current and -c is where the symbol will be written. +c Arp covers >1 voice. Lower voice has to be the first, upper is current and +c is where the symbol will be written. +c Check whether ivx's ivar1(iarp) & iv are in same staff +c + do 5 iiv = 1 , nm + if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and. + * ivmx(iiv,2).eq.ivar1(iarp))) then + iivivx1 = iiv + go to 6 + end if +5 continue + print*,'Screwup#1 in putarp' + stop +6 continue + do 7 iiv = 1 , nm + if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and. + * ivmx(iiv,2).eq.iv)) go to 8 +c +c Found iv for both voices (iivivx1, iiv), done looking c - levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) +7 continue + print*,'Screwup#2 in putarp' + stop +8 continue + if (iivivx1 .eq. iiv) then + nstaffshift = 0 + else + nstaffshift = -nint(2*xinsnow) + end if +c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) + levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp) invert = -levbot+4+nolev-ncm c print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' c write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), @@ -21456,7 +21701,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 +21748,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,11 +21810,11 @@ 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), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) character*10 figqq,figq character*80 soutq,notexq character*1 ch1q,ch2q,sq,chax @@ -21584,6 +21829,20 @@ c Conttq = 'Cott' end if sq = chax(92) + if (ivvfig(ivx,ifig) .ne. 0) then +c +c Alter figdrop +c + notexq = sq//'global'//sq//'advance'//sq//'figdrop' + lnote = 23 + if (ivvfig(ivx,ifig) .lt. 0) then + notexq = notexq(1:lnote)//'-' + lnote = lnote+1 + endif + notexq = notexq(1:lnote)//char(48+abs(ivvfig(ivx,ifig))) + lnote = lnote+1 + call addstr(notexq,lnote,soutq,lsout) + end if if (abs(offnsk) .gt. .0001) then c c Write offset for floating figure, to two decimal places @@ -21799,15 +22058,23 @@ c To enable >1 ornament on a note, next line is top of manual loop. c 2 continue c -c Bit # of last ornament (last of bits 0-21) +cc Bit # of last ornament (last of bits 0-21) cc Bit # of last ornament (last of bits 0-24) - ibit = log2(iand(iornq,4194303)) +c Bit # of last ornament (last of bits 0-24,29-30) + if (btest(iornq,29)) then + ibit = 29 + else if (btest(iornq,30)) then + ibit = 30 + else + ibit = log2(iand(iornq,4194303)) c ibit = log2(iand(iornq,33554431)) + end if iornt = 2**ibit c c Begin routine to set height. Bits 0-13: (stmgx+Tupf._) c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n c 19-20: >^, 21: ? (with or w/o 16-18) +c and 29-30: C (coda), G (new segno) c c Do not use beam height for . or _ c @@ -21868,6 +22135,11 @@ c c (iscrd and nolev=maxlev) or (.not.iscrd) c ihorn = max(nolev+stemlen+2,ncm+5.) + else if (ibit.eq.29 .or. ibit.eq.30) then +c +c coda or new segno, no height tweak +c + ihorn = ncm+5 else ihorn = max(nolev+2,ncm+5) end if @@ -21974,6 +22246,12 @@ c notexq = sq//'usfz' lnote = 5 ioff = -2 + else if (btest(iornt,29)) then + notexq = sq//'ccoda' + lnote = 6 + else if (btest(iornt,30)) then + notexq = sq//'ssegno' + lnote = 7 end if iudorn = 0 c @@ -21984,7 +22262,9 @@ c c Find which (if any) element of kudorn has the shift. c do 3 iudorn = 1 , nudorn - if (ibit .lt. 21) then +c if (ibit .lt. 21) then +c if (ibit.lt.21 .or. ibit.eq.29) then + if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then ibitt = ibit c c Could have oes, but not oe? or oes? @@ -22069,6 +22349,8 @@ c lout = lout+lnote c c Check bits 0-21, go back if any are still set +c If bit 29 or 30 had been set, would have been used first time thru, +c and you wouldn't use both coda and segno on same note c if (iand(iornq,4194303) .gt. 0) go to 2 if (usehornb) nornb(ivx) = nornb(ivx)+1 @@ -22984,13 +23266,14 @@ 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 call getchar(lineq,iccount,durq) - if (index('uldtb+-hfnHps ',durq) .gt. 0) then +c if (index('uldtb+-hfnHps ',durq) .gt. 0) then + if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then c c Null id. Note for ps slurs, 'H' cannot be an ID c @@ -23170,18 +23453,21 @@ 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 + else if (durq .eq. 'v') then ! Stem slur + isdat1(nsdat) = ibset(isdat1(nsdat),2) + go to 1 end if c c Record shifts @@ -23421,7 +23707,7 @@ c character*44 basenameq character*24 fmtq character*5 fbarq - character*1 clefq(nm),sq,chax + character*1 clefq(nm),sq,chax,clefqiv common /comstart/ facmtr logical vshrink,lowdot,rename logical novshrinktop,cstuplet @@ -23546,6 +23832,11 @@ c * //chax(48+nstaves) end if iv = iv+1 + clefqiv = clefq(iv) + if (clefqiv.eq.'8') then + clefqiv='t' + iTransAmt(instno(iv)) = 7 + end if if (nstaves .eq. 1) then fmtq = chax(48+numclef(clefq(iv))) lfmtq = 1 @@ -23565,6 +23856,15 @@ c else write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq) end if + if (clefq(iv) .eq. '8') then + if (iinst .lt. 10) then + write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)// + * sq//'treblelowoct%' + else + write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'// + * sq//'treblelowoct%' + end if + end if do 3 lname = 79 , 2 , -1 if (inameq(iinst)(lname:lname) .ne. ' ') go to 4 3 continue @@ -23780,8 +24080,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 +24268,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 +24294,7 @@ c write(11,'(a)')notexq(1:lnote)//'%' 1 continue flag = .false. - return + return end subroutine writflot(x,notexq,lenline) character*(*) notexq @@ -24010,16 +24310,22 @@ c end if return end - subroutine wsclef(iv,ninow,clefq,nclef) -c -c Writes \setclef for instrument containing voice iv + subroutine wsclef(iv,ninow,nclef) +c subroutine wsclef(iv,ninow,clefq,nclef) c +c Writes \setclef for instrument containing *staff* iv +c parameter (nm=24) common /comlast/ islast,usevshrink logical islast,usevshrink common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) logical rename - character*1 clefq(nm),chax +c +c In pmx271, had removed clefq, so with 2 or more staves in +c an instrument, had problems. So replace in 272 +c + common /comclefq/ clefq(nm) + character*1 clefq,chax character*20 temq if (nclef .lt. 7) then clefq(iv) = chax(48+nclef) @@ -24036,6 +24342,9 @@ c print*,'Should not be here in wsclef!' call stop1() 2 continue +c +c Here, iinst is the instrument number with staff of clef change +c iv2 = iv1+nspern(iinst)-1 if (iinst .lt. 10) then temq = chax(92)//'setclef'//chax(48+iinst) @@ -24045,10 +24354,16 @@ c ltem = 12 end if if (iv1 .eq. iv2) then +c +c Only one staff (iv) in instrument with clef change +c write(11,'(a)')temq(1:ltem)//clefq(iv)//'%' else temq = temq(1:ltem)//'{' ltem = ltem+1 +c +c Loop over staves, but clefq has only changed for one of them +c do 3 iiv = iv1 , iv2 temq = temq(1:ltem)//chax(48+numclef(clefq(iiv))) ltem = ltem+1 @@ -24057,3 +24372,99 @@ c end if return end + subroutine chkpmxlyr(lineq,iccount,lyrerr) + character*128 lineq + character*1 charq + lyrerr = 0 +c +c On entry, last char was " +c +18 call g1etchar(lineq,iccount,charq) + if (iccount .eq. 121) then + lyrerr = 2 + return + else if (charq.eq.'"') then + call g1etchar(lineq,iccount,charq) +c +c Check for raise/lower command +c + if (charq .eq. '@') then +c +c @ positions lyrics vertically for current voice +c [a,b] above or below of the staff +c +/- i offset, \internotes +c + call g1etchar(lineq,iccount,charq) + if (index('ab',charq).eq.0) then + lyrerr = 3 + return + end if + call g1etchar(lineq,iccount,charq) + if (index('+-',charq).eq.0) then + lyrerr = 4 + return + end if + call g1etchar(lineq,iccount,charq) + if (index('123456789',charq).eq.0) then + lyrerr = 5 + return + end if + else if (charq .ne. ' ') then +c +c 2nd " must be followed by ' ' +c + lyrerr = 1 + return + end if + return + end if + go to 18 + end + subroutine dopmxlyr(lineq,iccount) +c +c lineq has " at iccount. Find end of lyrics string, replace "..." +c with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', +c (unless preceded with '\'), check length +c + character*128 lineq,lineqt + character*1 sq + data sq /'\'/ + iend = lenstr(lineq,128) + i2nd = iccount+index(lineq(iccount+1:128),'"') + istart = iccount +1 itilde = istart+index(lineq(istart+1:i2nd-1),'~') + if (itilde.gt.istart.and.itilde.lt.i2nd) then +c +c Replace tilde if not preceded by \ +c + if (iend .ge. 117) then + print*,'Sorry, lyric string is too long, stopping' + call stop1() + else if (lineq(itilde-1:itilde-1) .eq. sq) then + istart = itilde + go to 1 + end if + lineqt = lineq(1:itilde-1)//sq//'lk ' + * //lineq(itilde+1:iend) + iend = lenstr(lineqt,128) + i2nd = i2nd+3 + lineq = lineqt + go to 1 + end if + 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 + i2nd = i2nd+8 + lineq = lineqt + if (lineq(i2nd+1:i2nd+1) .eq. '@') then + lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq + * //lineq(i2nd+5:128) + lineq = lineqt + end if + return + end diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig b/Build/source/utils/pmx/pmx-src/pmx273.for.orig index df86e657986..9a00d71adab 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/pmx270.for.orig +++ b/Build/source/utils/pmx/pmx-src/pmx273.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 @@ -63,8 +63,36 @@ c Undotted chord notes with dotted main note. c Forced line break without line number c Fix dot moving when 2nds in chord get flipped c To do: increase length on notexq in dodyn -c 2.70 -c To do: coda +c 2.73 (160121) +c Dirk's "..." command, to convert "text" into \pmxlyr{text}\ and insert as +c inline TeX. Replace all '~' inside "..." and not preceded with '\', by +c '\lk '. Right after 2nd ", replace @[a,b][+,-]n with \at{[a,b][+,-]n}\ +c Include definitions of \ly and \at in pmx.tex (2 Feb 16). After first ", +c add (as type 2 string) '\\input musixlyr \' +c After inputting pathname, change any '\' to '/', for Linux compatibility. +c 2.72 (160110) +c Really finalize \mbrest...go back to 3 args to deal with clef changes. +c Fine tune centered whole bar rests to deal with clef changes +c Fix bug in wsclef when >1 staff per instrument, since \setclef +c needs to know instrument and specify clefs on all staves for that +c instrument. Ones that were not changed by user will not be printed, +c and will be kept the same as before. +c Fix bug with arpegii from one voice to another in same staff. +c 2.71 (151226) +c Finalize mbrest mods +c 2.705 +c Fix error message +c 2.704 (140614) +c Octave treble clef +c Make horizontal ornament shift (ornhshft) floating +c 2.703 (140323) +c Option v[-]n at end of any figure will alter figdrop for rest of system +c 2.702 +c Stem slurs. Only for ps, assume no other pos'n adjustments. Option "v" +c 2.701 +c oC = coda (\code{10}) +c Move iornq(29) (blank barline) to ipl(0) (changes in pmxb, getnote) +c oG = new seqno c To do: fix grace note spacing problem (partially done) c 2.622 c Redefine midtc(..) and miditran(..); clean up all transpositions/key changes @@ -726,8 +754,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 /'2 Feb 16'/ + data version /'2.73'/ c ccccccccccccccccccccccccc data maxit,ncalls /200,0/ @@ -780,8 +808,8 @@ c read(*,'(a)')jobname numargs = 1 else - call getarg(1,jobname,idum) ! May need to replace this w/ next line -c call getarg(1,jobname) +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,8 +821,8 @@ c call getarg(1,jobname) 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) +c call getarg(2,jobname,idum) ! May need to replace this w/ next line + call getarg(2,jobname) numargs = 1 go to 10 else @@ -1172,7 +1200,7 @@ c 130330 end subroutine addblank(noteq,lnoten) character*8 noteq character*1 tchar - tchar = noteq + tchar = noteq(1:1) noteq = ' '//tchar lnoten = 2 return @@ -1347,7 +1375,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 +1471,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 @@ -1651,15 +1679,14 @@ c lsout = lsout+lnote return end - subroutine adjusteskz(ib,squez,istart,istop,poenom) + subroutine adjusteskz(ib,istart,poenom) c c For block ib, this adds accidental spaces to eskz, for use in getting c length of xtup bracket and slopes of brackets and beams. c parameter (nm=24) common /comas1/ naskb,task(40),wask(40),elask(40) - real*4 squez(80) - integer*4 istart(80),istop(80) + integer*4 istart(80) common /comnsp/ space(80),nb,prevtn(nm), * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) common /all/ mult(nm,200),iv,nnl(nm),nv,ibar, @@ -1787,21 +1814,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 +2303,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 @@ -2572,7 +2599,7 @@ c logical novshrinktop,cstuplet,usexnumt common /comnvst/ novshrinktop,cstuplet common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) character*10 figq ibc = ibmcnt(ivx) ipb1 = ibm1(ivx,ibc) @@ -2896,7 +2923,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 +3118,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 +3180,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, @@ -3162,14 +3189,16 @@ 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, * levtopr /9,7,5,5,7,5,6,6/, levbotr /0,0,0,2,1,4,5,4/ data EarlyTransOn, LaterInstTrans /2*.false./ data iInstTrans /nm*0/ + data iTransAmt /nm*0/ end subroutine catspace(space,squez,nnsk) parameter (nkb=3999,maxblks=4000) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /comtol/ tol - logical gotclef +c logical gotclef do 16 iptr = nptr(ibarcnt) , nptr(ibarcnt+1)-1 if (abs(space-durb(iptr)) .lt. tol) then if (abs(squez-sqzb(iptr)) .lt. tol) then @@ -3372,12 +3401,13 @@ c end if end if return end - subroutine chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev,ivmx, - * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) + subroutine chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev,ivmx, +c * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult) + * nib,nv,ibar,tnow,tol,nodur,mode,levtopr,levbotr,mult,ipl) parameter (nm=24) - integer*4 nn(nm),iornq(nm,0:200),islur(nm,200),irest(nm,200), + integer*4 nn(nm),islur(nm,200),irest(nm,200), * nolev(nm,200),nib(nm,15),nodur(nm,200),levbotr(8),levtopr(8), - * ivmx(nm,2),mult(nm,200) + * ivmx(nm,2),mult(nm,200),ipl(nm,200) c c On 130127 put this code, formerly in make2bar right before calling notex for c a single note/rest, into this subroutine, so the same logic could also be @@ -3390,7 +3420,8 @@ c c Get reference level: next following note if no intervening blank rests, c otherwise next prior note. Relative to bottom line. c - if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then +c if (ip.ne.nn(ivx).and..not.btest(iornq(ivx,ip),30)) then + if (ip.ne.nn(ivx).and..not.btest(ipl(ivx,ip),1)) then c c Not the last note and not "look-left" for level c @@ -3484,15 +3515,6 @@ c nodu = 2**(4-(iand(mult(ivx,ip),15)-8)) 17 call g1etchar(lineq,iccount,charq) if (charq .eq. chax(92)) then itype = itype+1 -c if (itype .eq. 2) then -c if (iccount .ne. 2 ) then -cc -cc type 2 or 3 tex string not starting in column 1 -cc -c literr = 3 -c return -c end if -c else if (itype .gt. 3) then if (itype .gt. 3) then literr = 1 return @@ -3669,7 +3691,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 +3715,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 +3741,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 +3933,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 +4072,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 +4144,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 +4153,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 +4393,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 @@ -4487,6 +4509,7 @@ c c Arpeggio signal c c call putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) + print*,'Calling putarp chord, iv,ivx:',iv,ivx call putarp(tnow,ivx,ip,nolev,ncm,soutq,lsout) end if call addstr(notexq,lnote,soutq,lsout) @@ -4558,11 +4581,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 +4663,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 +4713,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 +4791,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 +4819,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 +4845,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 +4875,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 @@ -5047,7 +5070,7 @@ c character*3 acsymq character*1 sq,chax,udqq,ulq(nm,9) common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) sq = chax(92) isgaft = btest(ipl,29) iswaft = btest(ipl,31) @@ -5063,8 +5086,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 +5189,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 +5399,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 +5540,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 @@ -5581,6 +5604,7 @@ c 27 forced dir'n = up if on, set in sslur; also c final direction, set in doslur when beam is started, used on term. c 28-31 mod(ndxslur,16), set in doslur when slur is started, used on term. c 18 int(ndxslur/16), ditto. So this allows ndxslur>15. +c 2 stem slur flag c c Bits in isdat2 c 0 Chord switch. Not set on main note. @@ -5657,17 +5681,6 @@ c if (btest(isdata,11)) then c c Turnon -c -c if (nolevs.eq.0 .or. nolevs.gt.60) then -cc -cc Note was a rest, cannot start slur on rest. -cc -c print* -c call printl('Cannot start slur on a rest') -c call stop1() -c nolevs = ncm+5 -c end if -c c Get slur direction c if (btest(isdata,26)) then @@ -5706,6 +5719,18 @@ c c Upper voice of the two, so up slur c end if + if (btest(isdata,2)) then +c +c ADjust for stem slur. ASSUME this is the ONLY pos'n adjustment. +c + if (stemup) then + slurudq = 'u' + ivoff = ivoff+4 + else + slurudq = 'd' + ivoff = ivoff-4 + end if + end if c c Set level for slur starting on rest c @@ -5778,7 +5803,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 +5835,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 @@ -5978,6 +6003,18 @@ c call addstr(chax(92)//'psforts'// * chax(48+min(abs(imid),6)),9,soutq,lsout) end if + if (btest(isdata,2)) then +c +c ADjust for stem slur. +c + if (stemup) then + slurudq = 'u' + ivoff = ivoff+4 + else + slurudq = 'd' + ivoff = ivoff-4 + end if + end if c c Shift slur ending for stem on any note? c @@ -6473,7 +6510,7 @@ c c c Dotted slur c - noteq = notexq + noteq(1:8) = notexq notexq = chax(92)//'dotted'//noteq lnote = lnote+7 end if @@ -7143,7 +7180,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 @@ -7311,10 +7348,11 @@ c c Compute an exponent eonk for use in the "flattened" formula for elemskips c vs time. We must solve the eqution f = 0. Initial quess is eonk0. c - logical gotclef +c logical gotclef common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /comtol/ tol common /comeon/ eonk,ewmxk eonk = eonk0 @@ -7448,7 +7486,8 @@ c * rest(nm,200),lenbr0,lenbr1,firstline,newmeter common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /c1omget/ lastchar,fbon,issegno,ihead,isheadr,nline,isvolt, * fracindent,nsperi(nm),linesinpmxmod,line1pmxmod,lenbuf0 common /compage/ widthpt,ptheight,hoffpt,voffpt, @@ -7484,7 +7523,7 @@ c common /comnvst/ novshrinktop,cstuplet common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur * ,WrotePsslurDefaults,SlurCurve - character*51 literq(3) + character*51 literq(3),lyrerq(5) common /comligfont/ isligfont logical isligfont common /comInstTrans/ iInstTrans(nm),iTransKey(nm),iTransAmt(nm), @@ -7497,6 +7536,12 @@ c * /'Literal TeX string cannot start with 4 backslashes!', * 'TeX string must have <129 char, end with backslash!', * 'Type 2 or 3 TeX string can only start in column 1!'/ + data lyrerq + * /'pmxlyr string must end with " followed by blank!', + * '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!'/ cdot = .false. 1 call g1etchar(lineq,iccount,charq) if (charq .ne. ' ') charlq = charq @@ -7538,7 +7583,7 @@ c c This is a note/rest. gotclef is only used for checking for clef before "/" c if (cdot) go to 28 - if (gotclef) gotclef=.false. +c if (gotclef) gotclef=.false. idotform = 0 numnum = 0 plusmin = .false. @@ -7826,7 +7871,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 @@ -8002,7 +8047,7 @@ c numint = 0 15 call g1etchar(lineq,iccount,dumq) iposn = iposn+1 - if (index('udlbfnht',dumq) .gt. 0) then + if (index('udlbfnhtv',dumq) .gt. 0) then if (dumq.eq.'t' .and. durq.eq.'t') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Cannot use "t" as an option on a tie!') @@ -8086,8 +8131,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 +8158,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. @@ -8150,7 +8195,8 @@ c end if if (usefig .and. ivx.eq.1) ifig = 1 26 call g1etchar(lineq,iccount,durq) - if (index('0123456789#-n_.:',durq) .gt. 0) then +c if (index('0123456789#-n_.:',durq) .gt. 0) then + if (index('0123456789#-n_.:v',durq) .gt. 0) then go to 26 else if (durq .eq. 's') then isligfont = .true. @@ -8256,6 +8302,17 @@ c call stop1() end if go to 110 + else if (durq .eq. '"') then +c +c pmx lyric +c + call chkpmxlyr(lineq,iccount,lyrerr) + if (lyrerr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * lyrerq(lyrerr)) + call stop1() + end if + go to 110 else if (durq .eq. 'M') then c c Temporary trap until I get around putting this in pmxb @@ -8264,7 +8321,7 @@ c * 'Macros not yet allowed in xtuplets!') call stop1() else if (durq .eq. 'X') then - call g1etx(lineq,iccount,.false.,shifton, + call g1etx(lineq,iccount,shifton, * ibarcnt-ibaroff+nbars+1,udsp(ibarcnt+nbars+1),wheadpt) go to 110 else if (durq .eq. 'z') then @@ -8308,6 +8365,20 @@ c call readnum(lineq,iccount,durq,fnum) iccount = iccount-1 go to 110 +c +c 140215 Allow clef change inside xtup +c + else if (durq .eq. 'C') then + call g1etchar(lineq,iccount,durq) + if (.not.(index('tsmanrbf',durq).gt.0 .or. +c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') + call stop1() + end if +c gotclef = .true. + go to 110 c+++ else if (durq.eq.']' .and. lineq(iccount+1:iccount+1).eq.'[' * .and. lineq(iccount+2:iccount+2).eq.' ') then @@ -8471,7 +8542,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) @@ -8736,6 +8807,16 @@ c * literq(literr)) call stop1() end if + else if (charq .eq. '"') then +c +c pmx lyric +c + call chkpmxlyr(lineq,iccount,lyrerr) + if (lyrerr .gt. 0) then + call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, + * lyrerq(lyrerr)) + call stop1() + end if else if (charq .eq. 'o') then c c Ornament on non-xtup note. "o" symbol must come AFTER the affected note @@ -8746,7 +8827,8 @@ c call stop1() end if call g1etchar(lineq,iccount,dumq) - if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then +c if (index('(stmgx+Tupf._)e:>^bc',dumq) .eq. 0 ) then + if (index('(stmgx+Tupf._)e:>^bcCG',dumq) .eq. 0 ) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal ornament!') call stop1() @@ -8871,7 +8953,7 @@ c * 'Cannot use "t" as an option on a tie!') call stop1() end if - if (index('udltb+-fnhHps ',dumq) .eq. 0) then + if (index('udltb+-fnhHpsv ',dumq) .eq. 0) then c c Check for explicit ID code. c @@ -8915,7 +8997,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 +9116,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 @@ -9083,7 +9165,7 @@ c end if if (usefig) ifig = 1 5 call g1etchar(lineq,iccount,charq) - if (index(' 0123456789#-nx_.:+s',charq) .eq. 0) then + if (index(' 0123456789#-nx_.:+sv',charq) .eq. 0) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Illegal character in figure!') call stop1() @@ -9155,7 +9237,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 "[ "!') @@ -9280,6 +9362,19 @@ c * 'Illegal unit; must be "p","i",or"m"!') call stop1() end if +c +c 151211 fix. May have extra character. +c + if (index('pim',durq) .gt. 0) then +c +c Get another character, see if it's blank +c + if (lineq(iccount+1:iccount+1) .ne. ' ') then + call errmsg(lineq,iccount+1,ibarcnt-ibaroff+nbars+1, + * 'This character should be a blank!') + call stop1() + end if + end if if (charq .eq. 'h') then ptheight = int(dimen) else @@ -9329,13 +9424,14 @@ c call g1etchar(lineq,iccount,durq) if (.not.(index('tsmanrbf',durq).gt.0 .or. c * (ichar(durq).ge.48 .and. ichar(durq).le.54))) then - * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then +c * (ichar(durq).ge.48 .and. ichar(durq).le.55))) then + * (ichar(durq).ge.48 .and. ichar(durq).le.56))) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, c * 'Must have t,s,m,a,n,r,b,f or 1-6 after C!') - * 'Must have t,s,m,a,n,r,b,f or 1-7 after C!') + * 'Must have t,s,m,a,n,r,b,f or 0-8 after C!') call stop1() end if - gotclef = .true. +c gotclef = .true. else if (charq .eq. 'R') then if (ivx .ne. 1) then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, @@ -9578,7 +9674,8 @@ c go to 27 else if (durq .ne. ' ') then call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'After "A" must follow one of the letters abcdeiINprRsST!') +c * 'After "A" must follow one of the letters abcdeiINprRsST!') + * 'After "A" must follow one of the letters abcdeiILNprRsST!') print*,'For AS, since ver. 2.7, must only have noinst args.' write(15,'(a)') * 'For AS, since ver. 2.7, must only have noinst args.' @@ -9691,7 +9788,7 @@ c * 'Cannot yet combine full and instrument transposition!') c call stop1() c end if call GetiTransInfo(.true.,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst,iv) + * ibaroff,nbars,noinst) end if else if (charq .eq. '|') then c @@ -9725,10 +9822,13 @@ c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, * 'Bar ended with user-defined shift still on!') call stop1() - else if (gotclef) then - call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, - * 'May not enter clef at end of input block!') - call stop1() +c +c 140215 Temporary to allow clef change in stup +c +c else if (gotclef) then +c call errmsg(lineq,iccount,ibarcnt-ibaroff+nbars+1, +c * 'May not enter clef at end of input block!') +c call stop1() end if barend = .false. c @@ -10076,7 +10176,7 @@ c else if (charq .eq. 'F') then usefig = .false. else if (charq .eq. 'X') then - call g1etx(lineq,iccount,.true.,shifton,ibarcnt-ibaroff+nbars+1, + call g1etx(lineq,iccount,shifton,ibarcnt-ibaroff+nbars+1, * udsp(ibarcnt+nbars+1),wheadpt) else if (charq .eq. 'I') then c @@ -10245,8 +10345,8 @@ c nline = nline+1 if (lineq(1:1) .eq. '%') go to 6 do 7 iv = 1 , nv -c if (index('brnamstf0123456',lineq(iv:iv)) .eq. 0) then - if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then +c if (index('brnamstf01234567',lineq(iv:iv)) .eq. 0) then + if (index('brnamstf012345678',lineq(iv:iv)) .eq. 0) then call errmsg(lineq,iv,0, * 'There should be a clef symbol here!') call stop1() @@ -10260,9 +10360,10 @@ c if (index('brnamstf0123456',lineq(iv:iv)) .eq. 0) then c c Set flag if voice 1 is treble, since it affects vertical spacing c - bottreb = lineq(1:1).eq.'t' +c bottreb = lineq(1:1).eq.'t' + bottreb = index('t08',lineq(1:1)).gt.0 c -c Mext non-comment line has path name +c Next non-comment line has path name c 8 call getbuf(lineq) nline = nline+1 @@ -10276,12 +10377,12 @@ c end if return end - subroutine g1etx(lineq,iccount,notxtup,shifton,ibar,udsp,wheadpt) + subroutine g1etx(lineq,iccount,shifton,ibar,udsp,wheadpt) c c Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. c In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. c - logical notxtup,shifton,number,btest + logical shifton,number,btest character*128 lineq character*1 charq,dumq number = .false. @@ -10295,9 +10396,6 @@ c if (btest(nPBSc,ipbsc)) then call errmsg(lineq,iccount,ibar,'Only one allowed per symbol!') call stop1() -c else if (.not.notxtup .and. ipbsc.gt.2) then -c call errmsg(lineq,iccount,ibar,'Not allowed in xtuplet!') -c call stop1() end if nPBSc = ibset(nPBSc,ipbsc) go to 1 @@ -10408,9 +10506,6 @@ c iccount = iccount+1 charq = lineq(iccount:iccount) return -999 continue - lastchar = .true. - return end subroutine getdyn(ivx,ip,irest,iornq,lineq,iccount) parameter (nm=24) @@ -10500,7 +10595,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 @@ -10585,24 +10680,15 @@ c return end subroutine getfig(itoff,charq,lineq,iccount,isfig,itfig, - * itsofar,nodur,figq,ivupfig,nfigs) +c * itsofar,nodur,figq,ivupfig,nfigs) + * itsofar,nodur,figq,ivupfig,ivvfig,nfigs) logical isfig character*1 charq character*10 figq character*128 lineq -c -c As of 11/26/08, trapped extra figures in getnote, so no need here. -c -c if (ivx .gt. 2) then -cc -cc Read past the figure -cc -c6 call getchar(lineq,iccount,charq) -c if (charq .ne. ' ') go to 6 -c return -c end if nfigs = nfigs+1 ivupfig = 0 + ivvfig = 0 itoff = 0 if (charq .eq. 'x') then c @@ -10624,8 +10710,8 @@ c lfig = 1 figq = charq 5 call getchar(lineq,iccount,charq) -c if (charq .ne. ' ') then - if (index(' +',charq) .eq. 0) then +c if (index(' +',charq) .eq. 0) then + if (index(' +v',charq) .eq. 0) then figq = figq(1:lfig)//charq lfig = lfig+1 go to 5 @@ -10636,6 +10722,17 @@ c iccount = iccount+1 call readnum(lineq,iccount,charq,fnum) ivupfig = nint(fnum) + else if (charq .eq. 'v') then +c +c Get vertical change in figdrop. Must be last item in figure word. +c + isign = 1 + call getchar(lineq,iccount,charq) + if (charq .eq. '-') then + isign=-1 + call getchar(lineq,iccount,charq) + end if + ivvfig = isign*(ichar(charq)-48) end if return end @@ -10801,7 +10898,7 @@ c return end subroutine GetiTransInfo(From1,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst,iv) + * ibaroff,nbars,noinst) cccccccccccccccccccccccc cc cc GetiTransInfo.for @@ -11053,7 +11150,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 +11173,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 +11196,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) @@ -11350,7 +11447,7 @@ c * inhead common /cominbot/ inbothd common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /comnotes/ nnodur,lastlev,ndlev(nm,2),shifton,setis,notcrd, * npreslur,was2(nm),ninow,nobar1,nsystp(40),ipage, * OptLineBreakTies,HeaderSpecial @@ -11411,7 +11508,7 @@ c character*128 txtdynq logical mrecord,mplay,endmac,lowdot,rename,bar1syst,upslur, * fontslur,WrotePsslurDefaults - character*128 lineq,lnholdq + character*128 lineq,lnholdq,lineqt character*80 headrq, lowerq character*79 inameq character*59 hdlndq @@ -11432,6 +11529,8 @@ c logical barend,iskchb,kchmid,logdumm1,logdumm2,logdumm3 common /combibarcnt/ ibarcnt common /commidisig/ midisig + common /comlyr/ inputmlyr + logical inputmlyr cdot = .false. 1 call getchar(lineq,iccount,charq) if (lastchar) return @@ -11882,6 +11981,27 @@ c else if (charq .eq. sq) then call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) go to 7 + else if (charq .eq. '"') then +cc +cc pmxlyr string in xtup. Expand "..." to \pmxlyr{...}\ +cc +c do 90 i2nd = iccount+1 , 128 +c if (lineq(i2nd:i2nd) .eq. '"') go to 91 +c90 continue +c91 continue +c if (iccount .eq. 1) then +c lineqt = sq//'pmxlyr{'//lineq(2:i2nd-1)//'}'//sq +c * //lineq(i2nd+1:128) +c else +c lineqt = lineq(1:iccount-1)//sq//'pmxlyr{' +c * //lineq(iccount+1:i2nd-1)//'}'//sq +c * //lineq(i2nd+1:128) +c end if +c lineq = lineqt + call dopmxlyr(lineq,iccount) + charq = sq + call littex(islur,nnl(ivx),ivx,topmods,lineq,iccount) + go to 7 else if (index('0123456789#-nx_',charq) .gt. 0) then c c Figure. Must come AFTER the first note of xtup @@ -11898,9 +12018,11 @@ 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)) +c * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),nfigs(ivf)) + * 0,figq(ivf,nfig1),ivupfig(ivf,nfig1),ivvfig(ivf,nfig1), + * nfigs(ivf)) go to 7 else if (charq .eq. 'X') then call getx(lineq,iccount,irest(ivx,max(1,nnl(ivx)-1)), @@ -12053,6 +12175,66 @@ c call getdyn(ivx,nnl(ivx)-1,irest(ivx,nnl(ivx)-1), * iornq(ivx,nnl(ivx)-1),lineq,iccount) go to 7 +c +c 140215 Allow clef change inside xtuplet. With normal code, came out one +c note too late, so try making it come earlier. +c + else if (charq .eq. 'C') then +c +c Clef change on next note. Set bits 11-15. Won't allow in 2nd line of music. +c +c if (nnl(iv) .gt. 0) ncc(iv) = ncc(iv)+1 + if (nnl(iv)-1 .gt. 0) ncc(iv) = ncc(iv)+1 +c +c 140218 Need to get time differently inside xtup, since itsofar doesn't get +c updated until after xtup is done +c +c tcc(iv,ncc(iv)) = itsofar(iv) + nodurt = ifnodur(nnodur,dotq) + tcc(iv,ncc(iv)) = itsofar(iv)+int(1.*nodurt/ntup*(itup-1)) +c print*,'itsofar,ncc,nodurt,ntup,itup,tcc:' +c print*,itsofar(iv),ncc(iv),nodurt,ntup,itup,tcc(iv,ncc(iv)) +c isl = ibset(islur(iv,nnl(iv)+1),11) + isl = ibset(islur(iv,nnl(iv)),11) + call getchar(lineq,iccount,durq) +c +c Store clef number, or 7 if clef number = 9 (French violin clef) +c + isl = ior(isl,ishft(min(numclef(durq),7),12)) + ncmidcc(iv,ncc(iv)) = ncmidf(durq) + if (durq .eq. '8') then + ipl(iv,nnl(iv))=ibset(ipl(iv,nnl(iv)),2) + iTransAmt(instno(iv)) = 7 + end if +c +c Set marker on note with lowest voice # starting at same time. +c + if (iv .eq. 1) then + isl = ibset(isl,15) + else + do 70 iiv = 1 , iv +c nnliiv = nnl(iiv) + nnliiv = nnl(iiv)-1 + if (iiv .eq. iv) nnliiv = nnliiv+1 + itother = 0 + do 71 iip = 1 , nnliiv + if (itother .lt. itsofar(iv)) then + itother = itother+nodur(iiv,iip) + go to 71 + else if (itother .eq. itsofar(iv)) then + islur(iiv,iip) = ibset(islur(iiv,iip),15) + go to 72 + end if +71 continue +70 continue +72 continue + end if +c +c Need 'or' since may have set bit 15 in the above loop +c +c islur(iv,nnl(iv)+1) = ior(isl,islur(iv,nnl(iv)+1)) + islur(iv,nnl(iv)) = ior(isl,islur(iv,nnl(iv))) + go to 7 c+++ else if (charq .eq. ']') then c @@ -12308,7 +12490,8 @@ c c c With keyboard rest option, look left c - iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) +c iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),30) + ipl(ivx,nnl(ivx)) = ibset(ipl(ivx,nnl(ivx)),1) go to 2 else if (index('DF',durq) .gt. 0) then c @@ -12477,7 +12660,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 +12680,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) @@ -12619,7 +12802,6 @@ c else if (charq .eq. 'G') then call getgrace(ivx,nnl,lineq,iccount,islur,iornq,ipl,ndlev, * lastlev,iv,nv) - continue c c Grace, comes *before* main note: c UNLESS there's an 'A' or 'W' after the 'G' @@ -12634,137 +12816,24 @@ c slashg(ngrace) = T if slash; default is F, input 'x' c These data MUST precede note name of first note c nolevg, naccg: lists of levels and accid's, indexed as described above. c -c ngrace = ngrace+1 -c ivg(ngrace) = ivx -c ipg(ngrace) = nnl(ivx)+1 -c if (ngrace .eq. 1) then -c ngstrt(ngrace) = 1 -c else -c ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1) -c end if -c islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4) -c nng(ngrace) = 1 -c multg(ngrace) = 1 -c upg(ngrace) = .true. -c slurg(ngrace) = .false. -c slashg(ngrace) = .false. -c18 call getchar(lineq,iccount,charq) -c if (index('WA',charq) .gt. 0) then -cc -cc Grace is on note that was already done, so shift flags forward one note. -cc This puts flag on actual note with grace; later for W will go ahead one more. -cc -c ipg(ngrace) = nnl(ivx) -c islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4) -c islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4) -c if (slurg(ngrace)) -c * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24) -c if (charq .eq. 'A') then -cc -cc close After, clear way-after bit, to ensure priority of most recent A/W -cc -c ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29) -c else -cc -cc Way after; later assign to following note, and position like normal grace. -cc -c ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31) -c end if -c else if (charq .eq. 'm') then -c call getchar(lineq,iccount,charq) -c multg(ngrace) = ichar(charq)-48 -c else if (index('123456789',charq) .gt. 0) then -c call readnum(lineq,iccount,durq,fnum) -c iccount = iccount-1 -c nng(ngrace) = nint(fnum) -c else if (charq .eq. 'l') then -c upg(ngrace) = .false. -c else if (charq .eq. 's') then -c slurg(ngrace) = .true. -c if (nnl(ivx) .gt. 0) then -cc -cc If A- or W-grace, set signal to start slur on main note. -cc -c if(btest(ipl(ivx,nnl(ivx)),31) .or. -c * btest(ipl(ivx,nnl(ivx)),29)) -c * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24) -c end if -c else if (charq .eq. 'x') then -c slashg(ngrace) = .true. -c else if (charq .eq. 'u') then -c else if (charq .eq. 'X') then -cc -cc Space before main note of grace. Number will come next. -cc -c iccount = iccount+1 -c call readnum(lineq,iccount,durq,graspace(ngrace)) -c iccount = iccount-1 -c end if -c if (index('abcdefg',charq) .eq. 0) go to 18 -cc -cc At this point, charq is first note name in grace -cc -c do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1 -c naccg(ing) = 0 -c ioct = 0 -c if (ing .gt. ngstrt(ngrace)) then -c55 call getchar(lineq,iccount,charq) -c if (charq .eq. ' ') go to 55 -c endif -c iclastlev = 0 -c9 call getchar(lineq,iccount,durq) -c if (durq .ne. ' ') then -c if (durq.eq.'+') then -c lastlev = lastlev+7 -c iclastlev = iclastlev+7 -c else if (durq.eq.'-') then -c lastlev = lastlev-7 -c iclastlev = iclastlev-7 -c else if (index('fsn',durq) .gt. 0) then -c if (naccg(ing) .eq. 0) then -c naccg(ing) = index('fsn',durq) -c else -cc -cc Double accidental -cc -c naccg(ing) = ibset(naccg(ing),2) -c end if -c else -c ioct = ichar(durq)-48 -c end if -c go to 9 -c end if -c if (ioct .gt. 0) then -c lastlev = ifnolev(charq,ioct) -c else -c if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then -c if (ivx .le. nv) then -c kv = 1 -c else -c kv = 2 -c end if -c lastlev = ndlev(iv,kv)+iclastlev -c end if -c lastlev = lastlev-3+mod(ifnolev(charq,10)-lastlev+3,7) -c end if -c nolevg(ing) = lastlev -c19 continue -cc -cc Grace could come before first note of block, so reset end level. -cc -c if (nnl(ivx).eq.0) then -c if (ivx .le. nv) then -c kv = 1 -c else -c kv = 2 -c end if -c ndlev(iv,kv) = lastlev -c end if else if (charq .eq. sq) then c c Literal TeX string c call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) + else if (charq .eq. '"') then +c +c pmxlyr string. Expand "..." to \pmxlyr{...}\ +c + if (.not. inputmlyr) then + ictemp = 0 + lineqt = sq//sq//sq//'input musixlyr '//sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineqt,ictemp) + inputmlyr = .true. + end if + call dopmxlyr(lineq,iccount) + charq = sq + call littex(islur,nnl(ivx)+1,ivx,topmods,lineq,iccount) else if (charq .eq. 'o') then c c Ornament on non-xtup note. Symbol must come AFTER the affected note @@ -12855,7 +12924,8 @@ c call getfig(itoff(ivf,nfig1),charq,lineq,iccount, * isfig(ivf,nnl(ivx)),itfig(ivf,nfig1),itsofar(ivx), * nodur(ivx,nnl(ivx)),figq(ivf,nfig1), - * ivupfig(ivf,nfig1),nfigs(ivf)) +c * ivupfig(ivf,nfig1),nfigs(ivf)) + * ivupfig(ivf,nfig1),ivvfig(ivf,nfig1),nfigs(ivf)) else if (charq .eq. '[') then c c Start forced beam. Record barno & time since start of inp. blk. Set signal @@ -13134,6 +13204,20 @@ c * //chax(48+iinow)//chax(48+nspern(iinow))//'%' write(11,'(a)')sq//'setclef'//chax(48+iinow) * //hdlndq(1:lclf)//'%' + if (fullsize(iiorig(iinow)).gt.0.9) then + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'normalvalue%' +c +c 140526 Account for staff size specs when noinst changes. May be confusion +c here if more than one staff per instrument +c + else if (fullsize(iiorig(iinow)).gt..7) then + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'smallvalue%' + else + write(11,'(a)')sq//'setsize'//chax(48+iinow) + * //sq//'tinyvalue%' + end if else write(11,'(a11,i2,a)')sq//'setstaffs{',iinow, * '}'//chax(48+nspern(iinow))//'%' @@ -13246,7 +13330,13 @@ c c Store clef number, or 7 if clef number = 9 (French violin clef) c isl = ior(isl,ishft(min(numclef(durq),7),12)) - ncmidcc(iv,ncc(iv)) = ncmidf(durq) + ncmidcc(iv,ncc(iv)) = ncmidf(durq) + if (durq .eq. '8') then + ipl(iv,nnl(iv)+1)=ibset(ipl(iv,nnl(iv)+1),2) + iTransAmt(instno(iv)) = 7 + else + if (iTransAmt(instno(iv)).eq.7)iTransAmt(instno(iv))=0 + end if c c Set marker on note with lowest voice # starting at same time. c @@ -13294,7 +13384,8 @@ c else if (durq .eq. 'b') then islur(1,nnl(1)+1) = ibset(islur(1,nnl(1)+1),25) else if (durq .eq. 'z') then - iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) +c iornq(1,nnl(1)+1) = ibset(iornq(1,nnl(1)+1),29) + ipl(1,nnl(1)+1) = ibset(ipl(1,nnl(1)+1),0) end if rptprev = .true. rptfq1 = durq @@ -13447,7 +13538,7 @@ c c A kluge for parts from separate score file for later movements. c if (instrq(1:1) .eq. ' ') headlog = .false. - cheadq = instrq + cheadq = instrq(1:60) else if (durq .eq. 't') then call getchar(lineq,iccount,durq) c @@ -13622,7 +13713,7 @@ c else if (durq .eq. 'c') then call g1etchar(lineq,iccount,durq) c -c Just eat the input; it was used in pmax +c Just eat the input; it was used in pmxa c go to 27 end if @@ -13692,7 +13783,7 @@ c c Instrument specific transposition. c call GetiTransInfo(.false.,ibarcnt,lineq,iccount, - * ibaroff,nbars,noinst,iv) + * ibaroff,nbars,noinst) c c The sig parameters will have been set 1st time but that's OK c @@ -13849,7 +13940,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 +13962,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), @@ -13931,11 +14022,14 @@ c c Isolate 21 bits defining exisiting ornaments c if (notcrd) then - iorni = iand(4194303,iornq) +c iorni = iand(4194303,iornq) +c iorni = iand(541065215,iornq) + iorni = iand(1614807039,iornq) else iorni = iand(4194303,icrdorn(ncrd)) end if - korn = index('stmgx+Tupf._)e:XXX>^',charq) +c korn = index('stmgx+Tupf._)e:XXX>^',charq) + korn = index('stmgx+Tupf._)e:XXX>^XXXXXXXXCG',charq) if (korn .ne. 15) iorni = ibset(iorni,korn) c c Note that korn=0 => charq='(', and we set bit 0. if "e" (14), alter later @@ -13945,10 +14039,13 @@ c if (korn .eq. 15) then c cc 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 +cc Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 prev iornq +c Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21,29 prev iornq c c iorni = ior(iorni,iand(iornq0,1638383)) - iorni = ior(iorni,iand(iornq0,3735535)) +c iorni = ior(iorni,iand(iornq0,3735535)) +c iorni = ior(iorni,iand(iornq0,540606447)) + iorni = ior(iorni,iand(iornq0,1614348271)) ornrpt = .false. call getchar(lineq,iccount,durq) c @@ -14060,7 +14157,8 @@ c xofforn = 44-ichar(durq) iccount = iccount+1 call readnum(lineq,iccount,durq,fnum) - ornhshft(nudorn) = nint(xofforn*fnum) +c 141226 ornhshft(nudorn) = nint(xofforn*fnum) + ornhshft(nudorn) = xofforn*fnum end if else if (durq .eq. ':') then c @@ -14307,7 +14405,7 @@ c if (inameq(i)(1:1) .eq. '%') go to 5 4 continue c -c Mext non-comment line has nv clef names +c Next non-comment line has nv clef names c 6 call getbuf(lineq) if (lineq(1:1) .eq. '%') go to 6 @@ -14331,6 +14429,15 @@ c 8 call getbuf(pathnameq) if (pathnameq(1:1) .eq. '%') go to 8 lpath = index(pathnameq,' ')-1 +c +c 160130 Replace '\' by '/' +c +12 ipos = index(pathnameq,'\') + if (ipos .gt. 0) then + pathnameq(ipos:ipos)='/' + print*,'Changed pathname to ',pathnameq(1:lpath) + go to 12 + end if return end function getsquez(n,ntot,space,tnote,to) @@ -14352,7 +14459,6 @@ c c Since to() is ordered by start times, exit loop after first note that c starts later than note of interest. c - if (to(in) .gt. to(n)+tol) go to 2 if (to(in)+tnote(in) .gt. tend-tol) then c @@ -14615,7 +14721,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 +14812,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 +14824,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 @@ -14977,6 +15083,9 @@ c end if end if else +c +c Type 2 or 3. +c if (itype .eq. 3) then c c Write the string NOW @@ -15098,7 +15207,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 +15266,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 @@ -15205,7 +15314,7 @@ c logical beamon,firstgulp,figbass,figchk,isfig,bar1syst common /comeskz2/ eskz2(nm,200) common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /combeam/ ibmtyp common /comask/ bar1syst,fixednew,scaldold, * wheadpt,fbar,poenom @@ -15766,7 +15875,7 @@ c * isbj2 common /combjmp/ ivbj1,ivbj2,isbjmp,isbj2 common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /combeam/ ibmtyp common /comask/ bar1syst,fixednew,scaldold, * wheadpt,fbar,poenom @@ -15860,7 +15969,8 @@ c c 130316 common /commvel/ midivel(nm),midvelc(0:nm),midibal(nm),midbc(0:nm) * ,miditran(nm),midtc(0:nm),noinst,iinsiv(nm) -c + common /comclefrests/ centrests + logical centrests c c Set up main ib loop within which a block (notes group) is written c @@ -15927,8 +16037,21 @@ c In preceding line, fl32 gave wrong result for ... .gt.0 !!! c do 140 in = istart(ib) , istop(ib) if (btest(islur(ivxo(in),ipo(in)),11)) then - call wsclef(ivxo(in),ninow,clefq, + call wsclef(ivxo(in),ninow, * iand(ishft(islur(ivxo(in),ipo(in)),-12),7)) +c +c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% +c +c if (clefq(ivxo(in)) .eq. '8') then + if (btest(ipl(ivxo(in),ipo(in)),2)) then + if (iv .le. 9) then + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + else + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + end if + end if end if 140 continue if (islast) write(11,'(a)')sq//'pmxnewclefs' @@ -16335,7 +16458,7 @@ c End of ask analysis for this block. c c Adjust eskz if there are added spaces. Corrects length of xtup brackets. c - if (naskb.gt.0) call adjusteskz(ib,squez,istart,istop,poenom) + if (naskb.gt.0) call adjusteskz(ib,istart,poenom) c c Check for internal repeat or sig change. c @@ -16543,6 +16666,11 @@ c print*,'At clef insertion, ptclef:',ptclef(iv) c print*,'Just added: ',notexq(1:lnote) end if call clefsym(islur(iv,ip),notexq,lnote,nclef) +c +c 151220 If clef is treblelowoct, change '0' in pos'n 9 to '8' +c + if (btest(ipl(ivx,ip),2)) notexq = + * notexq(1:8)//'8'//notexq(10:10) call addstr(notexq,lnote,soutq,lsout) if (ptclef(iv) .gt. 0.) then notexq = sq//'off{' @@ -16590,6 +16718,7 @@ c Arpeggio on a main (non-chordal) note? c if (btest(iornq(ivx,ip),27)) then c call putarp(tnow,iv,ip,nolev(ivx,ip),ncmid(iv,ip), + print*,'Calling putarp main, iv,ivx:',iv,ivx call putarp(tnow,ivx,ip,nolev(ivx,ip),ncmid(iv,ip), * soutq,lsout) end if @@ -16606,9 +16735,10 @@ c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) call beamstrt(notexq,lnote,nornb,ihornb,space,squez,ib) c c Shift beam start if notehead was shifted @@ -16695,7 +16825,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 +16926,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) @@ -16848,7 +16978,9 @@ c Check for main-note ornaments. ')' on dotted notes go in with note, not here. c Bits 0-13: (stmgx+Tupf._) ; 14: Down fermata, was F c 15: Trill w/o "tr", was U , 16-18 edit. accid., 19-21 TBD c - isacc = iand(iornq(ivx,ip),4194287) .gt. 0 +c isacc = iand(iornq(ivx,ip),4194287) .gt. 0 +c isacc = iand(iornq(ivx,ip),541065199) .gt. 0 + isacc = iand(iornq(ivx,ip),1614807023) .gt. 0 c c isacc=.true. if any ornament except segno c @@ -16982,9 +17114,10 @@ c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) call beamn1(notexq,lnote) end if bspend = .false. @@ -17018,9 +17151,10 @@ c if (kbdrests .and. btest(irest(ivx,ip),0) .and. * .not.btest(islur(ivx,ip),29).and. nvmx(iv).eq.2 .and. * nolev(ivx,ip).le.50) - * call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + * call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,2,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) call beamid(notexq,lnote) c c Or whole-bar rest @@ -17139,11 +17273,12 @@ c nolev(ivx,ip) = 100+iraise c c The new subroutine call, to replace above code c - call chkkbdrests(ip,iv,ivx,nn,iornq,islur,irest,nolev, + call chkkbdrests(ip,iv,ivx,nn,islur,irest,nolev, * ivmx,nib,nv,ibar,tnow,tol,nodur,1,levtopr,levbotr, - * mult) +c * mult) + * mult,ipl) end if -2 continue +c2 continue c c Write a separate note or rest c @@ -17437,31 +17572,7 @@ c c Write multibar rest. Assuming nv = 1 and do not worry about cwbrest c This has to be the only use of atnextbar c -c if (ibar .eq. ibarmbr) then if (ibar.eq.ibarmbr .and. islast) then -c call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes'//sq// -c * 'mbrest{',30,soutq,lsout) -c ndig = int(alog10(mbrest+.01))+1 -c write(soutq(31:33),'(i'//chax(48+ndig)//')')mbrest -c lsout = lsout+ndig -c call addstr('}{',2,soutq,lsout) -c mtrspc = .5+xb4mbr -c xb4mbr = 0. -c if (mtrspc .eq. 0) then -c ndig = 1 -c else -c ndig = int(alog10(mtrspc+.01))+1 -c end if -c write(soutq(lsout+1:lsout+2),'(i'//chax(48+ndig)//')')mtrspc -c lsout = lsout+ndig -c call addstr('}0'//sq//'en}%',7,soutq,lsout) -c if (islast) write(11,'(a)')soutq(1:lsout) -c lsout = 0 -c ndig = int(alog10(mbrest-1+.01))+1 -c if (mbrest.eq.1) ndig=1 -c if (islast) write(11,'(a14,i'//chax(48+ndig)//',a1)') -c * sq//'advance'//sq//'barno',mbrest-1,'%' -c++ soutq = sq//'def'//sq//'atnextbar{'//sq//'znotes' lsout = 22 notexq = sq//'mbrest' @@ -17469,7 +17580,7 @@ c++ call istring(mbrest,noteq,len) notexq = notexq(1:lnote)//noteq(1:len) lnote = lnote+len - mtrspc = .5+xb4mbr + mtrspc = nint(xb4mbr) xb4mbr = 0. call istring(mtrspc,noteq,len) notexq = notexq(1:lnote)//noteq(1:len)//'0' @@ -17488,19 +17599,21 @@ c++ end if else if (iscwr) then c -c Centered whole-bar rests +c Centered whole-bar rests. Set flag to pass to pmxb at start of NEXT bar +c to check for new clef and add space by redefining \CenterBar c + centrests = .true. + call addstr(sq//'def'//sq//'value{0}',13,soutq,lsout) call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes',22, * soutq,lsout) do 60 iv = 1 , nv +c added lnote = 0 +c do 61 kv = 1 , nvmx(iv) ivx = ivmx(iv,kv) if (cwrest(ivx)) then - if (lnote .eq. 0) then - notexq = sq//'centerbar{' - lnote = 11 - end if + call addstr(sq//'CenterBar{',11,soutq,lsout) if (.not.cwrferm(ivx)) then if (lcwr(ivx).ge.11 .and. cwrq(ivx)(11:11).ne.'p') then c @@ -17510,30 +17623,29 @@ c * cwrq(ivx)(2:10).eq.'liftPAuse') * cwrq(ivx)(10:10) = 'c' end if - notexq = notexq(1:lnote)//cwrq(ivx)(1:lcwr(ivx)) - lnote = lnote+lcwr(ivx) + call addstr(cwrq(ivx)(1:lcwr(ivx)),lcwr(ivx),soutq, + * lsout) + call addstr('}{-2}{'//sq//'value}',13,soutq,lsout) else c c Fermata on centered rest. Will need to fix up level. c 12/6/07 shift it left so it's centered over rest c -c notexq = notexq(1:lnote) -c * //sq//'fermataup7'//cwrq(ivx)(1:lcwr(ivx)) -c lnote = lnote+11+lcwr(ivx) -c - notexq = notexq(1:lnote)//sq//'loffset{.39}{' + notexq = notexq(1:lnote)//sq//'loffset{.33}{' * //sq//'fermataup7}'//cwrq(ivx)(1:lcwr(ivx)) - lnote = lnote+26+lcwr(ivx) + * //'}{-2}{'//sq//'value}' + lnote = lnote+26+lcwr(ivx)+13 + call addstr(notexq,lnote,soutq,lsout) cwrferm(ivx) = .false. end if end if 61 continue - if (lnote .gt. 0) call addstr(notexq(1:lnote)//'}',lnote+1, - * soutq,lsout) if (iv .ne. nv) call addstr(sepsymq(iv),1,soutq,lsout) 60 continue - call addstr(sq//'en}',4,soutq,lsout) - if (islast.and.lsout .gt. 0) write(11,'(a)')soutq(1:lsout)//'%' + if (islast) then + call addstr(sq//'en}%',5,soutq,lsout) + if (lsout.gt.0)write(11,'(a)')soutq(1:lsout) + end if end if c c End of block for centered whole-bar rests and multi-bar rests @@ -17545,7 +17657,6 @@ c do 63 iv = 1 , nv do 63 kv = 1 , nvmx(iv) ivx = ivmx(iv,kv) -c prevtn(ivx) = tnote(iand(ipl(ivx,nn(ivx)),255)) prevtn(ivx) = tnote(ipl2(ivx,nn(ivx))) 63 continue end if @@ -17603,9 +17714,11 @@ c common /linecom/ elskb,tnminb(nkb) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /c1ommvl/ nvmx(nm),ivmx(nm,2),ivx,fbar,nacc(nm,200) - logical rest,firstline,newmeter,gotclef +c logical rest,firstline,newmeter,gotclef + logical rest,firstline,newmeter integer cnn(nm),istart(80),istop(80) real*4 xit(nm),space(80),tstart(80),squez(80),tnote(600) elskb = 0. @@ -17945,7 +18058,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 @@ -17982,7 +18095,14 @@ c ncmidf = 37 c else c ncmidf = 23 c end if - ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2 + if (clefq .eq. '8') then +c +c treblelowoct; will treat as treble for this purpose +c + ncmidf = 35 + else + ncmidf = 21+index(' b6r5n4a3m2s1t0f7',clefq)/2*2 + end if return end subroutine newvoice(jv,clefq,change) @@ -18094,7 +18214,7 @@ c character*40 restq common /compoi/ ispoi common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) character*10 figq ip = ipo(jn) nole = nolev(ivx,ip) @@ -18511,12 +18631,20 @@ c call istring(mod(iv,12),tempq,len) end function numclef(clefq) c -c Returns the number to be used as argument of \setclef (for MusiXTeX only) +c Returns the number to be used as argument of \setclef for MusiXTeX +c For input 0-6 or tsmanrb return 0-7 +c 7 f 9 +c 8 0 +c character*1 clefq -c if (ichar(clefq) .lt. 55) then - if (ichar(clefq) .le. 55) then + if (ichar(clefq) .lt. 55) then +c if (ichar(clefq) .le. 55) then numclef = ichar(clefq)-48 - if (numclef .eq. 7) numclef = 9 +c if (numclef .eq. 7) numclef = 9 + else if (clefq .eq. '7') then + numclef = 9 + else if (clefq .eq. '8') then + numclef = 0 else numclef = index('tsmanrbxxf',clefq)-1 end if @@ -18575,7 +18703,8 @@ ccccccccccccccccccccccccccccccccccc * nnl(nm),itsofar(nm),nib(nm,15),lastbar(0:nks),nbarss(nks) common /c1omnotes/ nnodur,wminnh(nkb),nnpd(maxblks),durb(maxblks), * iddot,nptr(nkb),ibarcnt,mbrest,ibarmbr, - * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) +c * ibaroff,udsp(nkb),wheadpt,gotclef,sqzb(maxblks) + * ibaroff,udsp(nkb),wheadpt,sqzb(maxblks) common /compage/ widthpt,ptheight,hoffpt,voffpt, * nsyst,nflb,ibarflb(0:40), * isysflb(0:40),npages,nfpb,ipagfpb(0:18),isysfpb(0:18), @@ -18604,7 +18733,8 @@ ccccccccccccccccccccccccccccccccccc common /commac/ macnum,mrecord,mplay,macuse,icchold,lnholdq,endmac common /commus/ musize,whead20 common /comeon/ eonk,ewmxk - logical mrecord,mplay,endmac,gotclef,cstuplet +c logical mrecord,mplay,endmac,gotclef,cstuplet + logical mrecord,mplay,endmac,cstuplet logical novshrinktop,upslur,fontslur,WrotePsslurDefaults common /comnvst/ novshrinktop,cstuplte common /comslur/ listslur,upslur(nm,2),ndxslur,fontslur @@ -18636,7 +18766,7 @@ ccccccccccccccccccccccccccccccccccc mplay = .false. lastchar = .false. novshrinktop = .false. - cstuplet = .false. + cstuplet = .false. fontslur = .true. isligfont = .false. fulltrans = .false. @@ -18734,7 +18864,7 @@ c newmeter = .false. ihead = 0 isheadr = .false. - gotclef = .false. +c gotclef = .false. idsig = 0 iddot = 0 fintstf = -1. @@ -18746,7 +18876,7 @@ c issegno = .false. nbars = 0 ibarmbr = 0 -3 do 4 iv = 1 , nv + do 4 iv = 1 , nv nvmx(iv) = 1 ivmx(iv,1) = iv itsofar(iv) = 0 @@ -18833,7 +18963,7 @@ c call makeabar() elsk(ibarcnt) = elskb+fbar 10 continue - newmeter = .false. + newmeter = .false. firstline = .false. go to 30 20 continue @@ -19366,7 +19496,12 @@ ccccccccccccc cc ipl cc ccccccccccccc cc 0-7 Location in list [0,200] -c 0-7 Unused +cc 0-7 Unused +c 0 blank barline (must be iv=1) (would have used islur but no room) +c 1 look left for K rests, moved here from iornq(30) +c 2 treblelowoct +cc 2-7 Unused +c 3-7 unused c 8 left offset main note one headwidth c 9 right offset main note one headwidth c 10 chord present? @@ -19401,8 +19536,10 @@ c 25 Tweak orn ht. Same in icrdorn for chord note c 26 Insert user-defined space before this note (was 22) c 27 Arpeggio stop or start (if 2 at same time), or all-in-this-chord c 28 caesura or breath -c 29 blank barline (must be iv=1) (would have used islur but no room) -c 30 "Look-left" option for keyboard rest +cc 29 blank barline (must be iv=1) (would have used islur but no room) +c 29 coda +cc 30 "Look-left" option for keyboard rest +c 30 Part-by-part segno oG c 31 Set if any note (main or chord) has cautionary accid, for space checks ccccccccccccc cc irest cc @@ -19561,7 +19698,7 @@ cccccccccccccccccccccccccccccccc * inhead common /cominbot/ inbothd common /comfig/ itfig(2,74),figq(2,74),ivupfig(2,74),nfigs(2), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) common /comnsp/ space(80),nb,prevtn(nm), * flgndv(nm),flgndb,eskgnd,ptsgnd,ivmxsav(nm,2),nvmxsav(nm) common /comstart/ facmtr @@ -19648,12 +19785,18 @@ cccccccccccccccccccccccccccccccc common /combibarcnt/ ibarcnt character*40 nmq common /commidisig/ midisig + common /comclefrests/ centrests + logical newclef, centrests + common /comlyr/ inputmlyr + logical inputmlyr /.false./ if (.not.optimize) then print* print*,'Starting second PMX pass' print* write(15,'(a)')'Starting second PMX pass' end if + newclef = .false. + centrests = .false. ncalls = ncalls+1 islast = inlast macuse = 0 @@ -19665,7 +19808,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 +19961,7 @@ c nobar1 = .false. equalize = .false. usevshrink = .true. - WrotePsslurDefaults = .false. + WrotePsslurDefaults = .false. OptLineBreakTies = .false. HeaderSpecial = .false. c @@ -19968,11 +20111,10 @@ c jprntb = 0 end if ibcoff = ibcoff+mbrest-1 +c if (ibar.eq.1 .and. firstgulp .and. +c * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize if (ibar.eq.1 .and. firstgulp .and. - * .not.btest(islur(1,1),5)) xb4mbr = facmtr*musicsize -c -c The above may be he only case where the space-before option is used in \mbrest -c + * .not.btest(islur(1,1),5)) xb4mbr = -.2*musicsize end if c c Move the read to after end-of-bar hardspace checks, so we get right poenom @@ -19995,13 +20137,18 @@ c putmbr = .false. if (ismbr) then if (clchb) then -c -c Clef change and multi-bar rest coming up. Kluge to get space at end of rest. -c +ccc +ccc Clef change and multi-bar rest coming up. Kluge to get space at end of rest. +ccc write(11,'(a)')sq//'let'//sq//'mbrt'//sq//'mbrest' * //sq//'def'//sq//'mbrest#1#2#3{%' write(11,'(a14,f4.1,a)')sq//'mbrt{#1}{#2}{',musicsize*.55, * '}'//sq//'global'//sq//'let'//sq//'mbrest'//sq//'mbrt}%' +cc +cc RDT suggestion is inset blank barline - 160103 Abandoned +cc +c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq//'qspace' +c * //sq//'advance'//sq//'barno-1' end if ismbr = .false. putmbr = .true. @@ -20103,16 +20250,64 @@ c c Must call clefsym to get nclef, even if there is a movement break c call clefsym(islur(iv,ioff+1),fmtq,lclef,nclef) +c +c If clefq = '8', must change '0' in pos'n 9 to '8' +c + if (btest(ipl(iv,ioff+1),2)) fmtq = + * fmtq(1:8)//'8'//fmtq(10:10) if (movbrk.eq.0 .and. * islast) * write(11,'(a)')notexq(1:lnote)//fmtq(1:lclef)//sq//'en%' - call wsclef(iv,ninow,clefq,nclef) +c call wsclef(iv,ninow,clefq,nclef) + call wsclef(iv,ninow,nclef) +c +c Set new flag to be used just outside this loop, to kluge +c any calls to \CenterBar for full-bar rests, to make room for clef. +c + newclef = .true. +c +c 151220 +c wrong test: +c If clefq = '8', must add eg \settrebleclefsymbol3\treblelowoct% +c Replaced with right one. But also, clefq(iv) seems to stay at 8 here, +c and if we change from TLO to normal clef, need to resetclefsymbols +c +c if (clefq(iv) .eq. '8') then + if (btest(ipl(iv,ioff+1),2)) then + if (iv .le. 9) then + write(11,'(a20,i1,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + else + write(11,'(a20,i2,a)')sq//'settrebleclefsymbol',nv, + * sq//'treblelowoct%' + end if + else + if (clefq(iv) .eq. '8') then + write(11,'(a20)')sq//'resetclefsymbols' + end if + end if end if 17 continue if (islast) write(11,'(a)')sq//'pmxnewclefs' end if 23 continue c +c Kluge \CenterBar for whole bar rests if necessary +c + if (newclef .and. centrests) then +c write(11,'(a)')sq//'def'//sq//'value{11}%' + nvalue = nint(.55*musicsize) + if (nvalue .gt. 10) then + write(11,'(a11,i2,a2)') + * sq//'def'//sq//'value{',nvalue,'}%' + else + write(11,'(a11,i1,a2)') + * sq//'def'//sq//'value{',nvalue,'}%' + end if + end if + newclef = .false. + centrests = .false. +c c End of loop for end-of-bar hardspaces and non-movbrk clef symbol. c if (bar1syst) then @@ -20123,10 +20318,12 @@ c Repeat symbols. Haven't slid down yet, so use islur(1,nib(1,ibar-1)+1) c if (ibar .eq. 1) then islnow = islur(1,1) - iornqnow = iornq(1,1) +c iornqnow = iornq(1,1) + iplnow = ipl(1,1) else islnow = islur(1,nib(1,ibar-1)+1) - iornqnow = iornq(1,nib(1,ibar-1)+1) +c iornqnow = iornq(1,nib(1,ibar-1)+1) + iplnow = ipl(1,nib(1,ibar-1)+1) end if c c Check for R-symbols set at end of prior input block @@ -20176,7 +20373,8 @@ c doubleBAR c if (islast) write(11,'(a)')sq//'setdoubleBAR' fixednew = fixednew+wheadpt*ddbarfac-0.4 - else if (btest(iornqnow,29)) then +c else if (btest(iornqnow,29)) then + else if (btest(iplnow,0)) then c c no bar line c @@ -20241,6 +20439,11 @@ c c c End an old system, Start a new system c +c Reduce space before mbrest at start of system +c Need this even if no accidentals in key signature +c + if (ibar.eq.ibarmbr) xb4mbr = -.2*musicsize +c if (iline .ne. 1) then c c Not first line. @@ -20397,7 +20600,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 @@ -20577,7 +20780,7 @@ c if (islast) call wgmeter(mtrnmp,mtrdnp) if (mtrdnp .gt. 0) then if (islast) write(11,'(a)')sq//'newtimes2%' - if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize end if end if end if @@ -20671,7 +20874,7 @@ c write(11,'(a)')sq//'addspace{-'//sq// * 'afterruleskip}'//sq//'zchangecontext' end if - if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize else if (islast) write(11,'(a)')sq//'alaligne' end if @@ -20755,7 +20958,8 @@ c else naccs = abs(lastisig-isig) end if - xb4mbr = (facmtr+naccs*.24)*musicsize +c xb4mbr = (facmtr+naccs*.24)*musicsize + xb4mbr = -.2*musicsize end if else c @@ -20787,7 +20991,8 @@ c else naccs = abs(lastisig-isig) end if - xb4mbr = naccs*.24*musicsize +c xb4mbr = naccs*.24*musicsize + xb4mbr = -.2*musicsize end if end if else if (mtrnuml .eq. 0) then @@ -20803,8 +21008,17 @@ c if (movbrk .eq. 0) then if (islast) call wgmeter(mtrnmp,mtrdnp) if (mtrdnp .gt. 0) then - if (islast) write(11,'(a,2i1,a)')sq//'newtimes0%' - if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (islast) then +c if (mbrest .gt. 0) then +cc write(11,'(a)')sq//'addspace{-2'//sq// +cc * 'afterruleskip}'//sq//'setemptybar'//sq//'bar' +c write(11,'(a)')sq//'setemptybar'//sq//'bar'//sq// +c * 'advance'//sq//'barno-1%' +c end if + write(11,'(a,2i1,a)')sq//'newtimes0%' + end if +c if (ibar .eq. ibarmbr) xb4mbr = facmtr*musicsize + if (ibar .eq. ibarmbr) xb4mbr = -.2*musicsize else if (islast) write(11,'(a)')sq//'xbar' end if @@ -20971,6 +21185,7 @@ c figq(ivx,jfig-islide) = figq(ivx,jfig) itoff(ivx,jfig-islide) = itoff(ivx,jfig) ivupfig(ivx,jfig-islide) = ivupfig(ivx,jfig) + ivvfig(ivx,jfig-islide) = ivvfig(ivx,jfig) end if 20 continue nfigs(ivx) = nfigs(ivx)-islide @@ -21125,7 +21340,6 @@ c sumx = sumx+poe(isyst) sumxx = sumxx+poe(isyst)**2 1 continue -2 continue devnorm = sqrt(nsyst*sumxx/sumx**2-1) poebar = sumx/nsyst return @@ -21168,7 +21382,7 @@ c minlev = nolevm levtabl(nolevm) = -1 is2nd = .false. - naccid = 0 + naccid = 0 levmaxacc = -100 levminacc = 1000 c @@ -21347,18 +21561,21 @@ c return end subroutine putarp(tnow,iv,ip,nolev,ncm,soutq,lsout) + parameter (nm=24) common /comarp/ narp,tar(8),ivar1(8),ipar1(8),levar1(8),ncmar1(8), * xinsnow,lowdot common /comtol/ tol common /comArpShift/NumArpShift,IvArpShift(20),IpArpShift(20), * ArpShift(20) + common /commvl/ nvmx(nm),ivmx(nm,2),ivx logical lowdot,IsArpShift character*80 soutq character*79 notexq character*8 symq(2) character*1 chax data symq /'raisearp','arpeggio'/ - +c +c NOTE iv in arg list is really ivx, referring to voice rather than staff. c c Find which iarp, if any c @@ -21377,7 +21594,7 @@ c return 2 continue c -c If here, this is *second* call at this time, iarp points to values from 1st. +c If here, this is *second* call at this time, narp points to values from 1st. c c Check for shift. Set IsArpShift and iarps c @@ -21396,16 +21613,43 @@ c 4 continue if (iv .eq. ivar1(iarp)) then c -c Arp is in a single staff. +c Arp is in a single voice. c levbot = min(levar1(iarp),nolev)-ncm+3 invert = abs(levar1(iarp)-nolev)+1 else c -c Arp covers >1 staff. Lower staff has to be the first, upper is current and -c is where the symbol will be written. +c Arp covers >1 voice. Lower voice has to be the first, upper is current and +c is where the symbol will be written. +c Check whether ivx's ivar1(iarp) & iv are in same staff +c + do 5 iiv = 1 , nm + if (ivmx(iiv,1).eq.ivar1(iarp) .or. (nvmx(iiv).eq.2.and. + * ivmx(iiv,2).eq.ivar1(iarp))) then + iivivx1 = iiv + go to 6 + end if +5 continue + print*,'Screwup#1 in putarp' + stop +6 continue + do 7 iiv = 1 , nm + if (ivmx(iiv,1).eq.iv .or. (nvmx(iiv).eq.2.and. + * ivmx(iiv,2).eq.iv)) go to 8 +c +c Found iv for both voices (iivivx1, iiv), done looking c - levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) +7 continue + print*,'Screwup#2 in putarp' + stop +8 continue + if (iivivx1 .eq. iiv) then + nstaffshift = 0 + else + nstaffshift = -nint(2*xinsnow) + end if +c levbot = -nint(2*xinsnow)+3+levar1(iarp)-ncmar1(iarp) + levbot = nstaffshift+3+levar1(iarp)-ncmar1(iarp) invert = -levbot+4+nolev-ncm c print*,'xinsnow,levar1,ncmar1,levbot,nolev,ncm:' c write(*,'(f5.1,5i5)')xinsnow,levar1(iarp),ncmar1(iarp), @@ -21456,7 +21700,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 +21747,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,11 +21809,11 @@ 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), - * fullsize(nm),ivxfig2 + * fullsize(nm),ivxfig2,ivvfig(2,74) character*10 figqq,figq character*80 soutq,notexq character*1 ch1q,ch2q,sq,chax @@ -21584,6 +21828,20 @@ c Conttq = 'Cott' end if sq = chax(92) + if (ivvfig(ivx,ifig) .ne. 0) then +c +c Alter figdrop +c + notexq = sq//'global'//sq//'advance'//sq//'figdrop' + lnote = 23 + if (ivvfig(ivx,ifig) .lt. 0) then + notexq = notexq(1:lnote)//'-' + lnote = lnote+1 + endif + notexq = notexq(1:lnote)//char(48+abs(ivvfig(ivx,ifig))) + lnote = lnote+1 + call addstr(notexq,lnote,soutq,lsout) + end if if (abs(offnsk) .gt. .0001) then c c Write offset for floating figure, to two decimal places @@ -21799,15 +22057,23 @@ c To enable >1 ornament on a note, next line is top of manual loop. c 2 continue c -c Bit # of last ornament (last of bits 0-21) +cc Bit # of last ornament (last of bits 0-21) cc Bit # of last ornament (last of bits 0-24) - ibit = log2(iand(iornq,4194303)) +c Bit # of last ornament (last of bits 0-24,29-30) + if (btest(iornq,29)) then + ibit = 29 + else if (btest(iornq,30)) then + ibit = 30 + else + ibit = log2(iand(iornq,4194303)) c ibit = log2(iand(iornq,33554431)) + end if iornt = 2**ibit c c Begin routine to set height. Bits 0-13: (stmgx+Tupf._) c 14: Down fermata, was F 15: Trill w/o "tr", was U, 16-18: edit. s,f,n c 19-20: >^, 21: ? (with or w/o 16-18) +c and 29-30: C (coda), G (new segno) c c Do not use beam height for . or _ c @@ -21868,6 +22134,11 @@ c c (iscrd and nolev=maxlev) or (.not.iscrd) c ihorn = max(nolev+stemlen+2,ncm+5.) + else if (ibit.eq.29 .or. ibit.eq.30) then +c +c coda or new segno, no height tweak +c + ihorn = ncm+5 else ihorn = max(nolev+2,ncm+5) end if @@ -21974,6 +22245,12 @@ c notexq = sq//'usfz' lnote = 5 ioff = -2 + else if (btest(iornt,29)) then + notexq = sq//'ccoda' + lnote = 6 + else if (btest(iornt,30)) then + notexq = sq//'ssegno' + lnote = 7 end if iudorn = 0 c @@ -21984,7 +22261,9 @@ c c Find which (if any) element of kudorn has the shift. c do 3 iudorn = 1 , nudorn - if (ibit .lt. 21) then +c if (ibit .lt. 21) then +c if (ibit.lt.21 .or. ibit.eq.29) then + if (ibit.lt.21 .or. ibit.eq.29 .or. ibit.eq.30) then ibitt = ibit c c Could have oes, but not oe? or oes? @@ -22069,6 +22348,8 @@ c lout = lout+lnote c c Check bits 0-21, go back if any are still set +c If bit 29 or 30 had been set, would have been used first time thru, +c and you wouldn't use both coda and segno on same note c if (iand(iornq,4194303) .gt. 0) go to 2 if (usehornb) nornb(ivx) = nornb(ivx)+1 @@ -22984,13 +23265,14 @@ 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 call getchar(lineq,iccount,durq) - if (index('uldtb+-hfnHps ',durq) .gt. 0) then +c if (index('uldtb+-hfnHps ',durq) .gt. 0) then + if (index('uldtb+-hfnHpsv ',durq) .gt. 0) then c c Null id. Note for ps slurs, 'H' cannot be an ID c @@ -23170,18 +23452,21 @@ 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 + else if (durq .eq. 'v') then ! Stem slur + isdat1(nsdat) = ibset(isdat1(nsdat),2) + go to 1 end if c c Record shifts @@ -23421,7 +23706,7 @@ c character*44 basenameq character*24 fmtq character*5 fbarq - character*1 clefq(nm),sq,chax + character*1 clefq(nm),sq,chax,clefqiv common /comstart/ facmtr logical vshrink,lowdot,rename logical novshrinktop,cstuplet @@ -23546,6 +23831,11 @@ c * //chax(48+nstaves) end if iv = iv+1 + clefqiv = clefq(iv) + if (clefqiv.eq.'8') then + clefqiv='t' + iTransAmt(instno(iv)) = 7 + end if if (nstaves .eq. 1) then fmtq = chax(48+numclef(clefq(iv))) lfmtq = 1 @@ -23565,6 +23855,15 @@ c else write(11,'(a9,i2,a)')sq//'setclef{',iinst,'}'//fmtq(1:lfmtq) end if + if (clefq(iv) .eq. '8') then + if (iinst .lt. 10) then + write(11,'(a)')sq//'settrebleclefsymbol'//chax(48+iinst)// + * sq//'treblelowoct%' + else + write(11,'(a21,i2,a)')sq//'settrebleclefsymbol{',iinst,'}'// + * sq//'treblelowoct%' + end if + end if do 3 lname = 79 , 2 , -1 if (inameq(iinst)(lname:lname) .ne. ' ') go to 4 3 continue @@ -23780,8 +24079,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 +24267,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 +24293,7 @@ c write(11,'(a)')notexq(1:lnote)//'%' 1 continue flag = .false. - return + return end subroutine writflot(x,notexq,lenline) character*(*) notexq @@ -24010,16 +24309,22 @@ c end if return end - subroutine wsclef(iv,ninow,clefq,nclef) -c -c Writes \setclef for instrument containing voice iv + subroutine wsclef(iv,ninow,nclef) +c subroutine wsclef(iv,ninow,clefq,nclef) c +c Writes \setclef for instrument containing *staff* iv +c parameter (nm=24) common /comlast/ islast,usevshrink logical islast,usevshrink common /comnvi/ nsperi(nm),nspern(nm),rename,iiorig(nm) logical rename - character*1 clefq(nm),chax +c +c In pmx271, had removed clefq, so with 2 or more staves in +c an instrument, had problems. So replace in 272 +c + common /comclefq/ clefq(nm) + character*1 clefq,chax character*20 temq if (nclef .lt. 7) then clefq(iv) = chax(48+nclef) @@ -24036,6 +24341,9 @@ c print*,'Should not be here in wsclef!' call stop1() 2 continue +c +c Here, iinst is the instrument number with staff of clef change +c iv2 = iv1+nspern(iinst)-1 if (iinst .lt. 10) then temq = chax(92)//'setclef'//chax(48+iinst) @@ -24045,10 +24353,16 @@ c ltem = 12 end if if (iv1 .eq. iv2) then +c +c Only one staff (iv) in instrument with clef change +c write(11,'(a)')temq(1:ltem)//clefq(iv)//'%' else temq = temq(1:ltem)//'{' ltem = ltem+1 +c +c Loop over staves, but clefq has only changed for one of them +c do 3 iiv = iv1 , iv2 temq = temq(1:ltem)//chax(48+numclef(clefq(iiv))) ltem = ltem+1 @@ -24057,3 +24371,98 @@ c end if return end + subroutine chkpmxlyr(lineq,iccount,lyrerr) + character*128 lineq + character*1 charq + lyrerr = 0 +c +c On entry, last char was " +c +18 call g1etchar(lineq,iccount,charq) + if (iccount .eq. 121) then + lyrerr = 2 + return + else if (charq.eq.'"') then + call g1etchar(lineq,iccount,charq) +c +c Check for raise/lower command +c + if (charq .eq. '@') then +c +c @ positions lyrics vertically for current voice +c [a,b] above or below of the staff +c +/- i offset, \internotes +c + call g1etchar(lineq,iccount,charq) + if (index('ab',charq).eq.0) then + lyrerr = 3 + return + end if + call g1etchar(lineq,iccount,charq) + if (index('+-',charq).eq.0) then + lyrerr = 4 + return + end if + call g1etchar(lineq,iccount,charq) + if (index('123456789',charq).eq.0) then + lyrerr = 5 + return + end if + else if (charq .ne. ' ') then +c +c 2nd " must be followed by ' ' +c + lyrerr = 1 + return + end if + return + end if + go to 18 + end + subroutine dopmxlyr(lineq,iccount) +c +c lineq has " at iccount. Find end of lyrics string, replace "..." +c with \pmxlyr{...}\, but also look for ~ in lyrics and replace with '\ll ', +c (unless preceded with '\'), check length +c + character*128 lineq,lineqt + character*1 sq /'\'/ + iend = lenstr(lineq,128) + i2nd = iccount+index(lineq(iccount+1:128),'"') + istart = iccount +1 itilde = istart+index(lineq(istart+1:i2nd-1),'~') + if (itilde.gt.istart.and.itilde.lt.i2nd) then +c +c Replace tilde if not preceded by \ +c + if (iend .ge. 117) then + print*,'Sorry, lyric string is too long, stopping' + call stop1() + else if (lineq(itilde-1:itilde-1) .eq. sq) then + istart = itilde + go to 1 + end if + lineqt = lineq(1:itilde-1)//sq//'lk ' + * //lineq(itilde+1:iend) + iend = lenstr(lineqt,128) + i2nd = i2nd+3 + lineq = lineqt + go to 1 + end if + 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 + i2nd = i2nd+8 + lineq = lineqt + if (lineq(i2nd+1:i2nd+1) .eq. '@') then + lineqt = lineq(1:i2nd)//'at{'//lineq(i2nd+2:i2nd+4)//'}'//sq + * //lineq(i2nd+5:128) + lineq = lineqt + end if + return + end diff --git a/Build/source/utils/pmx/pmx-2.7.0/pmxab.c b/Build/source/utils/pmx/pmx-src/pmxab.c index 5768ca634c3..66a62200a33 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/pmxab.c +++ b/Build/source/utils/pmx/pmx-src/pmxab.c @@ -1,4 +1,5 @@ -/* -- translated by f2c (version 20031025). +#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 @@ -12,6 +13,7 @@ #include "f2c.h" +#line 1 "" /* Common Block Declarations */ struct { @@ -381,14 +383,14 @@ union { char figq[1480] /* was [2][74] */; integer ivupfig[148] /* was [2][74] */, nfigs[2]; real fullsize[24]; - integer ivxfig2; + 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; + integer ivxfig2, ivvfig[148] /* was [2][74] */; } _2; } comfig_; @@ -492,9 +494,7 @@ struct { integer nnpd[4000]; real durb[4000]; integer iddot, nptr[3999], ibarcnt, mbrest, ibarmbr, ibaroff; - real udsp[3999], wheadpt; - logical gotclef; - real sqzb[4000]; + real udsp[3999], wheadpt, sqzb[4000]; } c1omnotes_; #define c1omnotes_1 c1omnotes_ @@ -710,6 +710,12 @@ struct { #define combibarcnt_1 combibarcnt_ +struct comlyr_1_ { + logical inputmlyr; +}; + +#define comlyr_1 (*(struct comlyr_1_ *) &comlyr_) + struct { integer ivxudorn[63]; } comivxudorn_; @@ -736,6 +742,12 @@ struct { #define comcwrf_1 comcwrf_ struct { + logical centrests; +} comclefrests_; + +#define comclefrests_1 comclefrests_ + +struct { real elskb, tnminb[3999]; } linecom_; @@ -811,10 +823,13 @@ struct { struct { integer e_1[24]; - integer fill_2[73]; - logical e_3[2]; + 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}, FALSE_, FALSE_ }; + 0, 0, 0, 0, 0, 0, {0}, 0, 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]; @@ -822,6 +837,10 @@ struct { 0, 0, 0, 0 }; struct { + logical e_1; + } comlyr_ = { FALSE_ }; + +struct { real e_1; } comtol_ = { .001f }; @@ -853,7 +872,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_b807 = 1.f; +static real c_b814 = 1.f; static integer c__8 = 8; static integer c__16 = 16; static integer c__23 = 23; @@ -865,7 +884,7 @@ static integer c__24 = 24; static integer c__13 = 13; static integer c__28 = 28; static integer c__18 = 18; -static real c_b1659 = 2.f; +static real c_b1670 = 2.f; static integer c__30 = 30; static integer c__60 = 60; static integer c__80 = 80; @@ -880,8 +899,8 @@ static integer c__47 = 47; { /* Initialized data */ - static char date[9] = "3 Apr 13 "; - static char version[5] = "2.7 "; + 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_; @@ -1033,8 +1052,36 @@ static integer c__47 = 47; /* Forced line break without line number */ /* Fix dot moving when 2nds in chord get flipped */ /* To do: increase length on notexq in dodyn */ -/* 2.70 */ -/* To do: coda */ +/* 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 */ @@ -1656,389 +1703,673 @@ static integer c__47 = 47; /* 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); - do_lio(&c__9, &c__1, "You could have entered a jobname on the comman" +#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 */ +/* 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 */ +/* call getarg(2,jobname,idum) ! May need to replace this w/ next line */ +#line 825 "" getarg_(&c__2, jobname, (ftnlen)44); +#line 826 "" numargs = 1; +#line 827 "" goto L10; +#line 828 "" } else { +#line 829 "" s_wsle(&io___17); +#line 829 "" do_lio(&c__9, &c__1, "Illegal option on command line", (ftnlen)30) ; +#line 829 "" e_wsle(); +#line 830 "" stop1_(); +#line 831 "" } +#line 832 "" } /* Strip ".pmx" if necessary */ /* Computing MAX */ +#line 836 "" i__1 = i_indx(jobname, ".pmx", (ftnlen)44, (ftnlen)4), i__2 = i_indx( jobname, ".PMX", (ftnlen)44, (ftnlen)4); +#line 836 "" ndxpmx = max(i__1,i__2); +#line 837 "" if (ndxpmx > 0) { +#line 838 "" s_copy(jobname, jobname, (ftnlen)44, ndxpmx - 1); +#line 839 "" ljob += -4; +#line 840 "" } /* Check for existence of input file */ /* Writing concatenation */ +#line 844 "" i__3[0] = ljob, a__1[0] = jobname; +#line 844 "" i__3[1] = 4, a__1[1] = ".pmx"; +#line 844 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); +#line 845 "" ioin__1.inerr = 0; +#line 845 "" ioin__1.infilen = 47; +#line 845 "" ioin__1.infile = infileq; +#line 845 "" ioin__1.inex = &fexist; +#line 845 "" ioin__1.inopen = 0; +#line 845 "" ioin__1.innum = 0; +#line 845 "" ioin__1.innamed = 0; +#line 845 "" ioin__1.inname = 0; +#line 845 "" ioin__1.inacc = 0; +#line 845 "" ioin__1.inseq = 0; +#line 845 "" ioin__1.indir = 0; +#line 845 "" ioin__1.infmt = 0; +#line 845 "" ioin__1.inform = 0; +#line 845 "" ioin__1.inunf = 0; +#line 845 "" ioin__1.inrecl = 0; +#line 845 "" ioin__1.innrec = 0; +#line 845 "" ioin__1.inblank = 0; +#line 845 "" f_inqu(&ioin__1); +#line 846 "" if (! fexist) { +#line 847 "" ioin__1.inerr = 0; +#line 847 "" ioin__1.infilen = ljob + 4; /* Writing concatenation */ +#line 847 "" i__3[0] = ljob, a__1[0] = jobname; +#line 847 "" i__3[1] = 4, a__1[1] = ".PMX"; +#line 847 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 847 "" ioin__1.infile = ch__1; +#line 847 "" ioin__1.inex = &fexist; +#line 847 "" ioin__1.inopen = 0; +#line 847 "" ioin__1.innum = 0; +#line 847 "" ioin__1.innamed = 0; +#line 847 "" ioin__1.inname = 0; +#line 847 "" ioin__1.inacc = 0; +#line 847 "" ioin__1.inseq = 0; +#line 847 "" ioin__1.indir = 0; +#line 847 "" ioin__1.infmt = 0; +#line 847 "" ioin__1.inform = 0; +#line 847 "" ioin__1.inunf = 0; +#line 847 "" ioin__1.inrecl = 0; +#line 847 "" ioin__1.innrec = 0; +#line 847 "" ioin__1.inblank = 0; +#line 847 "" f_inqu(&ioin__1); +#line 848 "" if (! fexist) { +#line 849 "" s_wsle(&io___21); /* Writing concatenation */ +#line 849 "" i__3[0] = 17, a__1[0] = "Cannot find file "; +#line 849 "" i__3[1] = 47, a__1[1] = infileq; +#line 849 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)64); +#line 849 "" do_lio(&c__9, &c__1, ch__2, (ftnlen)64); +#line 849 "" e_wsle(); +#line 850 "" stop1_(); +#line 851 "" } else { /* Writing concatenation */ +#line 852 "" i__3[0] = ljob, a__1[0] = jobname; +#line 852 "" i__3[1] = 4, a__1[1] = ".PMX"; +#line 852 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)47); +#line 853 "" } +#line 854 "" } /* Open a log file */ +#line 858 "" o__1.oerr = 0; +#line 858 "" o__1.ounit = 15; +#line 858 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 858 "" i__3[0] = ljob, a__1[0] = jobname; +#line 858 "" i__3[1] = 4, a__1[1] = ".pml"; +#line 858 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 858 "" o__1.ofnm = ch__1; +#line 858 "" o__1.orl = 0; +#line 858 "" o__1.osta = 0; +#line 858 "" o__1.oacc = 0; +#line 858 "" o__1.ofm = 0; +#line 858 "" o__1.oblnk = 0; +#line 858 "" f_open(&o__1); /* Writing concatenation */ +#line 859 "" i__4[0] = 21, a__2[0] = "This is PMX, Version "; +#line 859 "" i__4[1] = 5, a__2[1] = version; +#line 859 "" i__4[2] = 2, a__2[2] = ", "; +#line 859 "" i__4[3] = 9, a__2[3] = date; +#line 859 "" s_cat(ch__3, a__2, i__4, &c__4, (ftnlen)37); +#line 859 "" printl_(ch__3, (ftnlen)37); +#line 860 "" ljob4 = ljob; /* Writing concatenation */ +#line 861 "" i__3[0] = 8, a__1[0] = "Opening "; +#line 861 "" i__3[1] = 47, a__1[1] = infileq; +#line 861 "" s_cat(ch__4, a__1, i__3, &c__2, (ftnlen)55); +#line 861 "" printl_(ch__4, (ftnlen)55); +#line 862 "" o__1.oerr = 0; +#line 862 "" o__1.ounit = 18; +#line 862 "" o__1.ofnmlen = 47; +#line 862 "" o__1.ofnm = infileq; +#line 862 "" o__1.orl = 0; +#line 862 "" o__1.osta = 0; +#line 862 "" o__1.oacc = 0; +#line 862 "" o__1.ofm = 0; +#line 862 "" o__1.oblnk = 0; +#line 862 "" f_open(&o__1); /* Copy input file into common buffer */ +#line 866 "" inbuff_1.ipbuf = 0; +#line 867 "" truelinecount_1.linewcom[0] = 1; +#line 868 "" for (inbuff_1.ilbuf = 1; inbuff_1.ilbuf <= 4000; ++inbuff_1.ilbuf) { +#line 869 "" ncomments = 0; +#line 870 "" L14: +#line 870 "" i__1 = s_rsfe(&io___24); +#line 870 "" if (i__1 != 0) { +#line 870 "" goto L9; +#line 870 "" } +#line 870 "" i__1 = do_fio(&c__1, lnholdq, (ftnlen)128); +#line 870 "" if (i__1 != 0) { +#line 870 "" goto L9; +#line 870 "" } +#line 870 "" i__1 = e_rsfe(); +#line 870 "" if (i__1 != 0) { +#line 870 "" goto L9; +#line 870 "" } +#line 871 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = (shortint) lenstr_(lnholdq, & c__128, (ftnlen)128); +#line 872 "" if (inbuff_1.lbuf[inbuff_1.ilbuf - 1] == 0) { /* Blank line. Make it a single blank with length 1 */ +#line 876 "" inbuff_1.lbuf[inbuff_1.ilbuf - 1] = 1; +#line 877 "" s_copy(lnholdq, " ", (ftnlen)128, (ftnlen)1); +#line 878 "" } /* Now line has at least one non blank character. Check for comment */ /* As of Version 260, do not copy comments into bufq */ /* But need to count %'s for error messaging */ /* if (lnholdq(1:1).eq.'%') go to 14 */ +#line 884 "" if (*(unsigned char *)lnholdq == '%') { +#line 885 "" ++ncomments; +#line 886 "" goto L14; +#line 887 "" } /* When here, have counted all preceding comments and have a real line */ +#line 891 "" if (inbuff_1.ilbuf > 1) { +#line 892 "" truelinecount_1.linewcom[inbuff_1.ilbuf - 1] = truelinecount_1.linewcom[inbuff_1.ilbuf - 2] + 1 + ncomments; +#line 893 "" } else { +#line 894 "" truelinecount_1.linewcom[0] = ncomments + 1; +#line 895 "" } +#line 896 "" if (inbuff_1.ipbuf + inbuff_1.lbuf[inbuff_1.ilbuf - 1] > 65536) { +#line 897 "" s_wsle(&io___26); +#line 897 "" do_lio(&c__9, &c__1, "Too many characters in file, stopping", ( ftnlen)37); +#line 897 "" e_wsle(); +#line 898 "" stop1_(); +#line 899 "" } +#line 900 "" i__1 = inbuff_1.ipbuf; +#line 900 "" s_copy(inbuff_1.bufq + i__1, lnholdq, inbuff_1.ipbuf + inbuff_1.lbuf[ inbuff_1.ilbuf - 1] - i__1, (ftnlen)128); +#line 901 "" inbuff_1.ipbuf += inbuff_1.lbuf[inbuff_1.ilbuf - 1]; +#line 902 "" /* L8: */ +#line 902 "" } +#line 903 "" printl_("Too many lines in input file", (ftnlen)28); +#line 904 "" stop1_(); +#line 905 "" L9: /* Insert dummy line to handle input files w/o CR-LF at end. */ +#line 909 "" inbuff_1.nlbuf = inbuff_1.ilbuf - 1; /* nlbuf = ilbuf */ /* bufq(ipbuf+1:ipbuf+3) = ' / ' */ /* lbuf(nlbuf) = 3 */ +#line 913 "" cl__1.cerr = 0; +#line 913 "" cl__1.cunit = 18; +#line 913 "" cl__1.csta = 0; +#line 913 "" f_clos(&cl__1); +#line 914 "" i__1 = maxit; +#line 914 "" for (numit = 1; numit <= i__1; ++numit) { +#line 915 "" if (optimize) { +#line 915 "" printl_("Starting an iteration", (ftnlen)21); +#line 915 "" } /* When isfirst=.true., pmxa() generates linebreaks normally, output in nbars0. */ /* Otherwise, nbars0 is the input */ /* When islast=.false., pmxb only returns poe's, otherwise does whole job */ +#line 921 "" pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars0, &optimize, (ftnlen) 44); +#line 922 "" if (! optimize) { +#line 923 "" if (commidi_1.ismidi) { /* This was moved here from writemidi 130302 to allow midivel,bal,tran, to be */ /* set up here as functions of instrument rather than iv (staff). */ /* Count up staves(iv,nv) vs instruments. Store instr# for iv in iinsiv(iv) */ +#line 929 "" nstaves = 0; +#line 930 "" ivt = 0; +#line 931 "" for (iinst = 1; iinst <= 24; ++iinst) { +#line 932 "" nstaves += c1omget_1.nsperi[iinst - 1]; +#line 933 "" i__2 = c1omget_1.nsperi[iinst - 1]; +#line 933 "" for (ivtt = 1; ivtt <= i__2; ++ivtt) { +#line 934 "" ++ivt; +#line 935 "" commvel_1.iinsiv[ivt - 1] = (shortint) iinst; +#line 936 "" /* L17: */ +#line 936 "" } +#line 937 "" if (nstaves == a1ll_1.nv) { +#line 937 "" goto L18; +#line 937 "" } +#line 938 "" /* L16: */ +#line 938 "" } +#line 939 "" s_wsle(&io___34); +#line 939 "" do_lio(&c__9, &c__1, "Screwup!", (ftnlen)8); +#line 939 "" e_wsle(); +#line 940 "" stop1_(); +#line 941 "" L18: /* Set up channel numbers for midi. */ +#line 945 "" commidi_1.numchan = 0; +#line 946 "" for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { +#line 947 "" if (commidi_1.twoline[a1ll_1.iv - 1]) { +#line 948 "" commidi_1.midchan[a1ll_1.iv + 23] = commidi_1.numchan; +#line 949 "" ++commidi_1.numchan; +#line 950 "" } +#line 951 "" commidi_1.midchan[a1ll_1.iv - 1] = commidi_1.numchan; +#line 952 "" ++commidi_1.numchan; +#line 953 "" /* L11: */ +#line 953 "" } /* numchan will now be the number of channels, but max channel # is numchan-1 */ /* Set up velocities, balances, and midi-transpositions */ +#line 959 "" for (a1ll_1.iv = a1ll_1.nv; a1ll_1.iv >= 1; --a1ll_1.iv) { +#line 960 "" if (commidi_1.twoline[a1ll_1.iv - 1]) { /* 130302 Make these functions of instrument rather than staff (iv) */ /* midvelc(midchan(iv,2)) = midivel(iv) */ /* midbc(midchan(iv,2)) = midibal(iv) */ /* midtc(midchan(iv,2)) = miditran(iv) */ +#line 965 "" commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 966 "" commvel_1.midbc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 967 "" commvel_1.midtc[commidi_1.midchan[a1ll_1.iv + 23]] = commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 968 "" } /* midvelc(midchan(iv,1)) = midivel(iv) */ /* midbc(midchan(iv,1)) = midibal(iv) */ /* midtc(midchan(iv,1)) = miditran(iv) */ +#line 972 "" commvel_1.midvelc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.midivel[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 973 "" commvel_1.midbc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.midibal[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 974 "" commvel_1.midtc[commidi_1.midchan[a1ll_1.iv - 1]] = commvel_1.miditran[commvel_1.iinsiv[a1ll_1.iv - 1] - 1]; +#line 975 "" /* L13: */ +#line 975 "" } +#line 976 "" } /* TEMPORARY!!! */ +#line 980 "" s_wsle(&io___35); +#line 980 "" do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); +#line 980 "" do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof( integer)); +#line 980 "" e_wsle(); +#line 981 "" ip1 = 1; +#line 982 "" i__2 = inbuff_1.nlbuf; +#line 982 "" for (ilb = 1; ilb <= i__2; ++ilb) { /* write(15,'(2i5,a40,3i5)')ilb,lbuf(ilb), */ /* * bufq(ip1:ip1+lbuf(ilb)-1), */ /* * (ichar(bufq(ip1+lbuf(ilb)-k:ip1+lbuf(ilb)-k)), */ /* * k=min(3,lbuf(ilb)),1,-1) */ +#line 987 "" ip1 += inbuff_1.lbuf[ilb - 1]; +#line 988 "" /* L10000: */ +#line 988 "" } +#line 989 "" iplast = ip1 - 1; /* Check to see if (1) last line is "<blank><blank>/" and (2) next to last */ @@ -2049,261 +2380,480 @@ L18: /* 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); - do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl" +#line 1001 "" + do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\ "ank>/\"", (ftnlen)39); +#line 1001 "" e_wsle(); +#line 1002 "" s_wsle(&io___40); - do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl" +#line 1002 "" + do_lio(&c__9, &c__1, "Removing last line of \"<blank><bl"\ "ank>/\"", (ftnlen)39); +#line 1002 "" e_wsle(); +#line 1003 "" --inbuff_1.nlbuf; +#line 1004 "" } +#line 1005 "" } +#line 1007 "" pmxb_(&c_true, poe0, &ncalls, &optimize); +#line 1008 "" if (commidi_1.ismidi) { /* Write midi file */ +#line 1012 "" o__1.oerr = 0; +#line 1012 "" o__1.ounit = 51; +#line 1012 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 1012 "" i__3[0] = ljob, a__1[0] = jobname; +#line 1012 "" i__3[1] = 4, a__1[1] = ".mid"; +#line 1012 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 1012 "" o__1.ofnm = ch__1; +#line 1012 "" o__1.orl = 0; +#line 1012 "" o__1.osta = 0; +#line 1012 "" o__1.oacc = 0; +#line 1012 "" o__1.ofm = 0; +#line 1012 "" o__1.oblnk = 0; +#line 1012 "" f_open(&o__1); +#line 1013 "" if (commidi_1.debugmidi) { +#line 1013 "" o__1.oerr = 0; +#line 1013 "" o__1.ounit = 52; +#line 1013 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 1013 "" i__3[0] = ljob, a__1[0] = jobname; +#line 1013 "" i__3[1] = 4, a__1[1] = ".dbm"; +#line 1013 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)48); +#line 1013 "" o__1.ofnm = ch__1; +#line 1013 "" o__1.orl = 0; +#line 1013 "" o__1.osta = 0; +#line 1013 "" o__1.oacc = 0; +#line 1013 "" o__1.ofm = 0; +#line 1013 "" o__1.oblnk = 0; +#line 1013 "" f_open(&o__1); +#line 1013 "" } +#line 1014 "" printl_(" ", (ftnlen)1); /* Writing concatenation */ +#line 1015 "" i__5[0] = 8, a__3[0] = "Writing "; +#line 1015 "" i__5[1] = ljob, a__3[1] = jobname; +#line 1015 "" i__5[2] = 4, a__3[2] = ".mid"; +#line 1015 "" s_cat(ch__5, a__3, i__5, &c__3, (ftnlen)56); +#line 1015 "" printl_(ch__5, ljob + 12); +#line 1016 "" writemidi_(jobname, &ljob, (ftnlen)44); +#line 1017 "" } +#line 1018 "" cl__1.cerr = 0; +#line 1018 "" cl__1.cunit = 15; +#line 1018 "" cl__1.csta = 0; +#line 1018 "" f_clos(&cl__1); +#line 1019 "" s_stop("", (ftnlen)0); +#line 1020 "" } +#line 1021 "" s_wsle(&io___42); +#line 1021 "" do_lio(&c__9, &c__1, "nlbuf: ", (ftnlen)7); +#line 1021 "" do_lio(&c__3, &c__1, (char *)&inbuff_1.nlbuf, (ftnlen)sizeof(integer)) ; +#line 1021 "" e_wsle(); +#line 1022 "" ip1 = 1; +#line 1023 "" pmxb_(&c_false, poe0, &ncalls, &optimize); +#line 1024 "" poestats_(&nsyst, poe0, &poebar0, &devnorm0); /* Save initial deviation and line breaks for later comparison */ +#line 1028 "" if (numit == 1) { +#line 1029 "" devpmx = devnorm0; +#line 1030 "" i__2 = nsyst; +#line 1030 "" for (isys = 1; isys <= i__2; ++isys) { +#line 1031 "" nbari[isys - 1] = nbars0[isys - 1]; +#line 1032 "" /* L20: */ +#line 1032 "" } +#line 1033 "" } +#line 1034 "" sortpoe_(&nsyst, poe0, ipoe); +#line 1035 "" for (iupord = nsyst; iupord >= 1; --iupord) { +#line 1036 "" isysu = ipoe[iupord - 1]; +#line 1037 "" s_wsle(&io___51); +#line 1037 "" do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); +#line 1037 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); +#line 1037 "" e_wsle(); +#line 1038 "" s_wsle(&io___52); +#line 1038 "" do_lio(&c__9, &c__1, "isysu=", (ftnlen)6); +#line 1038 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof(integer)); +#line 1038 "" e_wsle(); /* Skip if system isysu has poe0 < avg or isysd has poe0 > avg */ +#line 1042 "" if (poe0[isysu - 1] < poebar0) { +#line 1042 "" goto L1; +#line 1042 "" } +#line 1043 "" i__2 = nsyst; +#line 1043 "" for (idnord = 1; idnord <= i__2; ++idnord) { +#line 1044 "" isysd = ipoe[idnord - 1]; +#line 1045 "" if (isysu == isysd || nbars0[isysd - 1] == 1 || poe0[isysd - 1] > poebar0) { +#line 1045 "" goto L5; +#line 1045 "" } +#line 1047 "" i__6 = nsyst; +#line 1047 "" for (isyst = 1; isyst <= i__6; ++isyst) { +#line 1048 "" nbars[isyst - 1] = nbars0[isyst - 1]; +#line 1049 "" if (isyst == isysu) { +#line 1050 "" ++nbars[isyst - 1]; +#line 1051 "" } else if (isyst == isysd) { +#line 1052 "" --nbars[isyst - 1]; +#line 1053 "" } +#line 1054 "" /* L2: */ +#line 1054 "" } +#line 1055 "" pmxa_(jobname, &ljob4, &isfirst, &nsyst, nbars, &optimize, ( ftnlen)44); +#line 1056 "" pmxb_(&c_false, poe, &ncalls, &optimize); +#line 1057 "" poestats_(&nsyst, poe, &poebar, &devnorm); +#line 1058 "" if (devnorm < devnorm0) { +#line 1059 "" devnorm0 = devnorm; +#line 1060 "" poebar0 = poebar; +#line 1061 "" i__6 = nsyst; +#line 1061 "" for (isys = 1; isys <= i__6; ++isys) { +#line 1062 "" nbars0[isys - 1] = nbars[isys - 1]; +#line 1063 "" poe0[isys - 1] = poe[isys - 1]; +#line 1064 "" /* L4: */ +#line 1064 "" } +#line 1065 "" s_wsle(&io___60); +#line 1065 "" do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( ftnlen)32); +#line 1065 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( integer)); +#line 1065 "" do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( integer)); +#line 1065 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( real)); +#line 1065 "" e_wsle(); +#line 1067 "" s_wsle(&io___61); +#line 1067 "" do_lio(&c__9, &c__1, "Improved with iup,idown,devnorm:", ( ftnlen)32); +#line 1067 "" do_lio(&c__3, &c__1, (char *)&isysu, (ftnlen)sizeof( integer)); +#line 1067 "" do_lio(&c__3, &c__1, (char *)&isysd, (ftnlen)sizeof( integer)); +#line 1067 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof( real)); +#line 1067 "" e_wsle(); +#line 1069 "" s_wsfe(&io___62); +#line 1069 "" i__6 = nsyst; +#line 1069 "" for (isys = 1; isys <= i__6; ++isys) { +#line 1069 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) sizeof(integer)); +#line 1069 "" } +#line 1069 "" e_wsfe(); +#line 1070 "" s_wsfe(&io___63); +#line 1070 "" i__6 = nsyst; +#line 1070 "" for (isys = 1; isys <= i__6; ++isys) { +#line 1070 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen) sizeof(integer)); +#line 1070 "" } +#line 1070 "" e_wsfe(); +#line 1071 "" sortpoe_(&nsyst, poe0, ipoe); +#line 1072 "" goto L6; +#line 1073 "" } +#line 1074 "" L5: +#line 1074 "" ; +#line 1074 "" } +#line 1075 "" L1: +#line 1075 "" ; +#line 1075 "" } /* If we get here, must have gone thru all switches and found nothing better, */ /* so done! */ +#line 1080 "" goto L7; +#line 1081 "" L6: +#line 1081 "" ; +#line 1081 "" } +#line 1082 "" L7: +#line 1083 "" s_wsle(&io___64); +#line 1083 "" do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1083 "" do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1083 "" do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1083 "" do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1083 "" e_wsle(); +#line 1084 "" s_wsle(&io___65); +#line 1084 "" do_lio(&c__9, &c__1, "Optimum located, numit:", (ftnlen)23); +#line 1084 "" do_lio(&c__3, &c__1, (char *)&numit, (ftnlen)sizeof(integer)); +#line 1084 "" do_lio(&c__9, &c__1, ", ncalls:", (ftnlen)10); +#line 1084 "" do_lio(&c__3, &c__1, (char *)&ncalls, (ftnlen)sizeof(integer)); +#line 1084 "" e_wsle(); +#line 1085 "" s_wsle(&io___66); +#line 1085 "" do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); +#line 1085 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); +#line 1085 "" do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); +#line 1085 "" do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); +#line 1085 "" e_wsle(); +#line 1086 "" s_wsle(&io___67); +#line 1086 "" do_lio(&c__9, &c__1, "Final error:", (ftnlen)12); +#line 1086 "" do_lio(&c__4, &c__1, (char *)&devnorm0, (ftnlen)sizeof(real)); +#line 1086 "" do_lio(&c__9, &c__1, ", initial error:", (ftnlen)16); +#line 1086 "" do_lio(&c__4, &c__1, (char *)&devpmx, (ftnlen)sizeof(real)); +#line 1086 "" e_wsle(); +#line 1087 "" s_wsle(&io___68); +#line 1087 "" do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); +#line 1087 "" r__1 = (1 - devnorm0 / devpmx) * 100.f; +#line 1087 "" do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 1087 "" e_wsle(); +#line 1088 "" s_wsle(&io___69); +#line 1088 "" do_lio(&c__9, &c__1, "Percentage improvement:", (ftnlen)23); +#line 1088 "" r__1 = (1 - devnorm0 / devpmx) * 100.f; +#line 1088 "" do_lio(&c__4, &c__1, (char *)&r__1, (ftnlen)sizeof(real)); +#line 1088 "" e_wsle(); +#line 1089 "" printl_("Initial bars/system:", (ftnlen)20); +#line 1090 "" s_wsfe(&io___70); +#line 1090 "" i__1 = nsyst; +#line 1090 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1090 "" do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1090 "" } +#line 1090 "" e_wsfe(); +#line 1091 "" s_wsfe(&io___71); +#line 1091 "" i__1 = nsyst; +#line 1091 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1091 "" do_fio(&c__1, (char *)&nbari[isys - 1], (ftnlen)sizeof(integer)); +#line 1091 "" } +#line 1091 "" e_wsfe(); +#line 1092 "" printl_("Final bars/system:", (ftnlen)18); +#line 1093 "" s_wsfe(&io___72); +#line 1093 "" i__1 = nsyst; +#line 1093 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1093 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1093 "" } +#line 1093 "" e_wsfe(); +#line 1094 "" s_wsfe(&io___73); +#line 1094 "" i__1 = nsyst; +#line 1094 "" for (isys = 1; isys <= i__1; ++isys) { +#line 1094 "" do_fio(&c__1, (char *)&nbars0[isys - 1], (ftnlen)sizeof(integer)); +#line 1094 "" } +#line 1094 "" e_wsfe(); +#line 1095 "" pmxa_(jobname, &ljob4, &c_false, &nsyst, nbars0, &optimize, (ftnlen)44); +#line 1096 "" pmxb_(&c_true, poe0, &ncalls, &optimize); /* itend = mytime() */ /* print*,'Elapsed time in ms:',itend-itstart */ /* write(15,*)'Elapsed time in ms:',itend-itstart */ +#line 1100 "" cl__1.cerr = 0; +#line 1100 "" cl__1.cunit = 15; +#line 1100 "" cl__1.csta = 0; +#line 1100 "" f_clos(&cl__1); +#line 1101 "" return 0; } /* MAIN__ */ @@ -2322,28 +2872,51 @@ L7: 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_ */ @@ -2368,82 +2941,123 @@ L7: 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_ */ @@ -2454,18 +3068,23 @@ L2: integer i__1[2]; /* Builtin functions */ - /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, - char **, integer *, integer *, ftnlen); + /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ static char tchar[1]; - s_copy(tchar, noteq, (ftnlen)1, (ftnlen)8); +#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_ */ @@ -2474,30 +3093,54 @@ L2: { 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_ */ @@ -2554,117 +3197,179 @@ L2: /* 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. */ @@ -2673,276 +3378,445 @@ L6: /* 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) */ @@ -2951,110 +3825,198 @@ L20: /* comparing pitches. Save the 4 pieces of data in itiesav(1...4,nsav4tie) */ /* Store actual time in itiesav(5,nsav4tie), using itiesav(1,1) as initial */ /* time. */ +#line 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_ */ @@ -3076,32 +4038,51 @@ L14: 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, real *squez, integer *istart, - integer *istop, real *poenom) +/* Subroutine */ int adjusteskz_(integer *ib, integer *istart, real *poenom) { /* System generated locals */ integer i__1, i__2; @@ -3115,38 +4096,63 @@ L14: /* For block ib, this adds accidental spaces to eskz, for use in getting */ /* length of xtup bracket and slopes of brackets and beams. */ +#line 1706 "" /* Parameter adjustments */ - --istop; +#line 1706 "" --istart; - --squez; +#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_ */ @@ -3192,185 +4198,333 @@ L10: 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_ */ @@ -3402,46 +4556,80 @@ L999: /* 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_ */ @@ -3483,204 +4671,338 @@ L1: 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); - do_lio(&c__9, &c__1, "(Error in beamend, send source to " +#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) { @@ -3689,117 +5011,197 @@ L1: /* 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_ */ @@ -3846,18 +5248,28 @@ L1: 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 */ @@ -3867,216 +5279,346 @@ L1: /* 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], & @@ -4086,195 +5628,334 @@ L1: 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_ */ @@ -4314,261 +5995,441 @@ L1: 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); - do_lio(&c__9, &c__1, "(Error in beamn1, send source to Dr. D" +#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_ */ @@ -4643,41 +6504,64 @@ L1: /* 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. */ @@ -4692,87 +6576,136 @@ L1: /* 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, @@ -4781,185 +6714,329 @@ L6: 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 */ @@ -4983,328 +7060,541 @@ L6: /* 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 */ @@ -5312,61 +7602,100 @@ L6: /* 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 */ @@ -5375,35 +7704,52 @@ L6: /* Non-chord. There IS an ornament. Need ihornb only if upbeam, and if */ /* ornament is 1,2,3,5,6,7,8,9,10,15-21 (up- but not domn ferm.) */ +#line 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 */ @@ -5411,79 +7757,126 @@ L11: /* 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_ */ @@ -5505,30 +7898,47 @@ L8: /* 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_ */ @@ -5538,7 +7948,9 @@ L8: /* The only reason for this seemingly do-nothing function is to get around an */ /* apparent bug in the Visual Fortran Standard Edition 5.0.A compiler! */ +#line 3228 "" *(unsigned char *)ret_val = (char) (*n); +#line 3229 "" return ; } /* chax_ */ @@ -5572,131 +7984,222 @@ L8: 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; - errmsg_(lineq, &i__1, ibar, "Dynamic text must be terminated wit" +#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) { - errmsg_(lineq, iccount, ibar, "Expected \"-\", \"+\", or blank h" +#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(); - idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff< " +#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) { - errmsg_(lineq, iccount, ibar, "Expected integer here for vertica" +#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; - errmsg_(lineq, &i__1, ibar, "Vertical offset for dynamic mark mu" +#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) { - errmsg_(lineq, iccount, ibar, "Expected \"+\", \"-\", or blank h" +#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) { - errmsg_(lineq, iccount, ibar, "Expected number here for hori" +#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; - errmsg_(lineq, &i__1, ibar, "Horizontal offset for dynamic m" +#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_ */ @@ -5715,10 +8218,15 @@ L2: /* 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. */ @@ -5726,14 +8234,19 @@ L2: /* 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); @@ -5757,12 +8270,19 @@ L2: /* 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_ */ @@ -5779,29 +8299,44 @@ L2: 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); - do_lio(&c__9, &c__1, "Midi file is too long! It will be corrupted or" +#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 *iornq, 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 *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; @@ -5817,6 +8352,7 @@ L2: 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 */ @@ -5829,129 +8365,224 @@ L2: /* 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; - --iornq; +#line 3424 "" --nn; +#line 3424 "" +#line 3424 "" /* Function Body */ - if (*ip != nn[*ivx] && ! bit_test(iornq[*ivx + *ip * 24],30)) { +#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_ */ @@ -5968,53 +8599,80 @@ L7: 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; -/* if (itype .eq. 2) then */ -/* if (iccount .ne. 2 ) then */ -/* c */ -/* c type 2 or 3 tex string not starting in column 1 */ -/* c */ -/* literr = 3 */ -/* return */ -/* end if */ -/* else if (itype .gt. 3) then */ +#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_ */ @@ -6046,8 +8704,11 @@ L18: /* 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) { @@ -6055,66 +8716,100 @@ L18: /* Prior char was accid & next is #; this may be start of accidental shift. */ /* Must test for "." above in case we get "<" or ">" */ +#line 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_ */ @@ -6137,40 +8832,62 @@ L18: /* 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_ */ @@ -6245,11 +8962,17 @@ L18: /* icrdot(icrd)(27-29) = level rank of chord-note among accid-notes */ /* twooftwo will be true 2nd time thru; signal to store shifts w/ notes */ +#line 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 */ @@ -6257,7 +8980,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) */ @@ -6266,97 +8989,152 @@ L18: /* 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. */ @@ -6369,158 +9147,264 @@ L4: /* 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); - printl_("WARNING: auto-generated accidental shift too bi" +#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 */ @@ -6531,16 +9415,23 @@ L6: /* 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 */ @@ -6553,6 +9444,7 @@ L1: /* * (micrd(iwa),isetshft(iwa),iwa=1,naccid) */ /* end if */ /* c */ +#line 3949 "" return 0; } /* crdacc_ */ @@ -6622,16 +9514,27 @@ L1: /* 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 */ @@ -6639,77 +9542,124 @@ L1: /* 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. */ @@ -6723,179 +9673,302 @@ L18: /* 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 */ @@ -6903,39 +9976,61 @@ L6: /* 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_ */ @@ -6969,108 +10064,191 @@ L10: 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_ */ @@ -7091,8 +10269,8 @@ L10: 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 *), e_wsle(void), do_lio(integer *, integer *, char - *, ftnlen); + integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen), + e_wsle(void); /* Local variables */ extern /* Subroutine */ int addblank_(char *, integer *, ftnlen); @@ -7132,8 +10310,9 @@ L10: integer *); /* Fortran I/O blocks */ - static cilist io___346 = { 0, 6, 0, 0, 0 }; + 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 */ @@ -7147,34 +10326,57 @@ L10: /* Set counter (for this note) for chord notes present. Set notmain=T. */ /* Will test for notmain=.true. in addmidi to tell whether to save pitch. */ +#line 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: */ @@ -7184,43 +10386,65 @@ L10: /* 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, & @@ -7230,135 +10454,230 @@ L10: /* * 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 */ @@ -7366,37 +10685,58 @@ L10: /* pitch number and store it in mcpitch(nmidcrd). Then on call to addmidi() */ /* for MAIN note, will put in note codes for all chord notes + main note. */ +#line 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) { - s_wsle(&io___346); - e_wsle(); +#line 4527 "" s_wsle(&io___347); - do_lio(&c__9, &c__1, "21 chord notes is too many for midi pr" +#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_b807, &c_false, &c_false); + 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_ */ @@ -7456,132 +10796,206 @@ L10: static integer jtxtdyn, ltxtdyn; /* Fortran I/O blocks */ - static icilist io___368 = { 0, numpq+1, 0, "(i2)", 2, 1 }; - static icilist io___370 = { 0, numpq+1, 0, "(i2)", 2, 1 }; - static icilist io___371 = { 0, numpq+1, 0, "(i3)", 3, 1 }; - static icilist io___378 = { 0, numpq+1, 0, "(i2)", 2, 1 }; + 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, "(i3)", 3, 1 }; - static cilist io___383 = { 0, 11, 0, "(a)", 0 }; + 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 */ +/* hpstrt, hpcend, hpdend, pmxdyn */ /* ivx */ /* X X X */ /* level */ @@ -7591,174 +11005,278 @@ L2: /* 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. */ @@ -7766,23 +11284,27 @@ 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 */ +#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[ @@ -7792,22 +11314,28 @@ L2: /* 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[ @@ -7815,21 +11343,30 @@ L2: /* 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 */ @@ -7837,302 +11374,529 @@ L2: /* 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); - s_wsfi(&io___368); +#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); - s_wsfi(&io___370); +#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); - s_wsfi(&io___371); +#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); - s_wsfi(&io___378); +#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); - s_wsfi(&io___379); +#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); - s_wsfi(&io___380); +#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 "" } - s_wsfe(&io___383); +#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_ */ @@ -8189,26 +11953,25 @@ L5: static logical isgaft; extern /* Subroutine */ int accsym_(integer *, char *, integer *, ftnlen), addstr_(char *, integer *, char *, integer *, ftnlen, ftnlen); - static integer islope; static logical iswaft; static char acsymq[3]; extern /* Subroutine */ int notefq_(char *, integer *, integer *, integer *, ftnlen); - static integer lnoten, itrans, niptgr; + 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___389 = { 0, 6, 0, 0, 0 }; - static cilist io___393 = { 0, 6, 0, 0, 0 }; + static cilist io___390 = { 0, 6, 0, 0, 0 }; static cilist io___394 = { 0, 6, 0, 0, 0 }; - static cilist io___395 = { 0, 15, 0, "(/,a)", 0 }; - static icilist io___398 = { 0, notexq, 0, "(i2)", 2, 1 }; - static cilist io___399 = { 0, 6, 0, 0, 0 }; - static icilist io___423 = { 0, notexq+13, 0, "(a1,f4.1)", 5, 1 }; - static icilist io___425 = { 0, notexq+13, 0, "(f4.1)", 4, 1 }; - static icilist io___427 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; + 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 }; @@ -8216,197 +11979,334 @@ L5: /* It is only used to find ig. */ /* ig is returned to makeabar in case there's a slur that needs to be ended */ +#line 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 "" } - s_wsle(&io___389); +#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) */ +/* 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) { - s_wsle(&io___393); - e_wsle(); +#line 5100 "" s_wsle(&io___394); - do_lio(&c__9, &c__1, "You defined the twentyfifth slur, one too " +#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(); - s_wsfe(&io___395); +#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) { - s_wsfi(&io___398); +#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 { - s_wsle(&io___399); - do_lio(&c__9, &c__1, "Call Dr. Don if you really want grace " +#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, */ @@ -8416,636 +12316,1100 @@ L121: /* * 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) { - s_wsfi(&io___423); +#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 "" } - s_wsfi(&io___425); +#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); - s_wsfi(&io___427); +#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 */ @@ -9055,78 +13419,147 @@ L121: /* 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_ */ @@ -9184,10 +13617,10 @@ L121: static char slurudq[1]; /* Fortran I/O blocks */ - static cilist io___441 = { 0, 6, 0, 0, 0 }; static cilist io___442 = { 0, 6, 0, 0, 0 }; - static cilist io___443 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___451 = { 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 }; @@ -9208,6 +13641,7 @@ L121: /* 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. */ @@ -9246,176 +13680,286 @@ L121: /* 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 */ - -/* if (nolevs.eq.0 .or. nolevs.gt.60) then */ -/* c */ -/* c Note was a rest, cannot start slur on rest. */ -/* c */ -/* print* */ -/* call printl('Cannot start slur on a rest') */ -/* call stop1() */ -/* nolevs = ncm+5 */ -/* end if */ - /* 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) { - s_wsle(&io___441); - e_wsle(); +#line 5773 "" s_wsle(&io___442); - do_lio(&c__9, &c__1, "You1 defined the twentyfifth slur," +#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(); - s_wsfe(&io___443); - do_fio(&c__1, "You defined the twentyfifth slur, one too" +#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 */ @@ -9424,121 +13968,206 @@ L121: /* 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 */ @@ -9546,12 +14175,19 @@ L121: /* 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 */ @@ -9559,170 +14195,273 @@ L121: /* 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 "" } - s_wsle(&io___451); +#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 */ @@ -9735,215 +14474,384 @@ L4: /* 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) { @@ -9953,44 +14861,77 @@ L4: /* 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_ */ @@ -10052,11 +14993,11 @@ L4: static char slurudq[1]; /* Fortran I/O blocks */ - static cilist io___472 = { 0, 6, 0, 0, 0 }; - static cilist io___474 = { 0, 6, 0, 0, 0 }; + static cilist io___473 = { 0, 6, 0, 0, 0 }; static cilist io___475 = { 0, 6, 0, 0, 0 }; - static cilist io___476 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___484 = { 0, 6, 0, 0, 0 }; + 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 }; @@ -10100,75 +15041,129 @@ L4: /* 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 */ @@ -10176,145 +15171,229 @@ L6: /* 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. */ - s_wsle(&io___472); +#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) { - s_wsle(&io___474); - e_wsle(); +#line 6434 "" s_wsle(&io___475); - do_lio(&c__9, &c__1, "You1 defined the twenty-fifth slur" +#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(); - s_wsfe(&io___476); - do_fio(&c__1, "You2 defined the twenty-fifth slur, one t" +#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); @@ -10322,92 +15401,149 @@ L6: /* 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 */ @@ -10415,156 +15551,253 @@ L6: /* 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 "" } - s_wsle(&io___484); +#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 */ @@ -10574,309 +15807,528 @@ L4: /* if (slurudq .eq. 'd') imid = -imid */ /* 3/8/03 added the following */ +#line 6628 "" if (*(unsigned char *)slurudq == 'd') { +#line 6628 "" imid = -abs(imid); +#line 6628 "" } +#line 6630 "" if (bit_test(isdat3[isdat],1)) { /* Writing concatenation */ +#line 6631 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6631 "" i__4[0] = 1, a__2[0] = ch__1; +#line 6631 "" i__4[1] = 5, a__2[1] = "curve"; +#line 6631 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6632 "" lnote = 6; +#line 6633 "" } else { /* Writing concatenation */ +#line 6634 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6634 "" i__4[0] = 1, a__2[0] = ch__1; +#line 6634 "" i__4[1] = 7, a__2[1] = "midslur"; +#line 6634 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6635 "" lnote = 8; +#line 6636 "" } +#line 6637 "" if (imid < 0 || imid > 9) { /* Need brackets */ /* Writing concatenation */ +#line 6641 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6641 "" i__4[1] = 1, a__2[1] = "{"; +#line 6641 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6642 "" ++lnote; +#line 6643 "" if (imid < -9) { +#line 6644 "" i__2 = lnote; +#line 6644 "" ici__1.icierr = 0; +#line 6644 "" ici__1.icirnum = 1; +#line 6644 "" ici__1.icirlen = lnote + 3 - i__2; +#line 6644 "" ici__1.iciunit = notexq + i__2; +#line 6644 "" ici__1.icifmt = "(i3)"; +#line 6644 "" s_wsfi(&ici__1); +#line 6644 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); +#line 6644 "" e_wsfi(); +#line 6645 "" lnote += 3; +#line 6646 "" } else if (imid < 0 || imid > 9) { +#line 6647 "" i__2 = lnote; +#line 6647 "" ici__1.icierr = 0; +#line 6647 "" ici__1.icirnum = 1; +#line 6647 "" ici__1.icirlen = lnote + 2 - i__2; +#line 6647 "" ici__1.iciunit = notexq + i__2; +#line 6647 "" ici__1.icifmt = "(i2)"; +#line 6647 "" s_wsfi(&ici__1); +#line 6647 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); +#line 6647 "" e_wsfi(); +#line 6648 "" lnote += 2; +#line 6649 "" } else { +#line 6650 "" i__2 = lnote; +#line 6650 "" ici__1.icierr = 0; +#line 6650 "" ici__1.icirnum = 1; +#line 6650 "" ici__1.icirlen = lnote + 1 - i__2; +#line 6650 "" ici__1.iciunit = notexq + i__2; +#line 6650 "" ici__1.icifmt = "(i1)"; +#line 6650 "" s_wsfi(&ici__1); +#line 6650 "" do_fio(&c__1, (char *)&imid, (ftnlen)sizeof( integer)); +#line 6650 "" e_wsfi(); +#line 6651 "" ++lnote; +#line 6652 "" } /* Writing concatenation */ +#line 6653 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6653 "" i__4[1] = 1, a__2[1] = "}"; +#line 6653 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6654 "" ++lnote; +#line 6655 "" } else { /* 1=<imid=<9, no brackets */ /* Writing concatenation */ +#line 6659 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6659 "" *(unsigned char *)&ch__1[0] = imid + 48; +#line 6659 "" i__4[1] = 1, a__2[1] = ch__1; +#line 6659 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6660 "" ++lnote; +#line 6661 "" } +#line 6662 "" if (bit_test(isdat3[isdat],1)) { /* \curve; 3 args */ /* Writing concatenation */ +#line 6666 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6666 "" *(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat] , &c__3, &c__8) + 48; +#line 6666 "" i__4[1] = 1, a__2[1] = ch__1; +#line 6666 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); /* Writing concatenation */ +#line 6668 "" i__4[0] = lnote + 1, a__2[0] = notexq; +#line 6668 "" *(unsigned char *)&ch__1[0] = igetbits_(&isdat3[isdat] , &c__3, &c__11) + 48; +#line 6668 "" i__4[1] = 1, a__2[1] = ch__1; +#line 6668 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6670 "" lnote += 2; +#line 6671 "" } +#line 6672 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen) 80); +#line 6673 "" } /* Shift slur ending for stem on any note? */ +#line 6677 "" if (! stemup && *(unsigned char *)slurudq == 'd' && *tno < 63.f) { +#line 6677 "" ihoff += -8; +#line 6677 "" } +#line 6679 "" if (bit_test(isdat2[isdat],3)) { /* Shift ending for tie spacing */ +#line 6683 "" if (*(unsigned char *)slurudq == 'u') { +#line 6684 "" ihoff += -8; +#line 6685 "" --ivoff; +#line 6686 "" } else if (*(unsigned char *)slurudq == 'd') { +#line 6687 "" ++ivoff; +#line 6688 "" if (stemup || *tno > 63.f) { +#line 6688 "" ihoff += -8; +#line 6688 "" } +#line 6689 "" } +#line 6690 "" } +#line 6691 "" if (iscrd) { /* Shift termination for shifted notehead? */ +#line 6695 "" if (bit_test(isdat2[isdat],1)) { /* Left-shifted chord notehead. ASSUME downstem. */ +#line 6699 "" if (nolevs == comtrill_1.minlev && *(unsigned char *) slurudq == 'd') { +#line 6700 "" ihoff += -2; +#line 6701 "" } else { +#line 6702 "" ihoff += -10; +#line 6703 "" } +#line 6704 "" } else if (bit_test(isdat2[isdat],2)) { /* Right shifted chord notehead. ASSUME upstem. */ +#line 6708 "" if (nolevs == comtrill_1.maxlev && *(unsigned char *) slurudq == 'u') { +#line 6709 "" ihoff += 2; +#line 6710 "" } else { +#line 6711 "" ihoff += 10; +#line 6712 "" } +#line 6713 "" } +#line 6714 "" } +#line 6715 "" if (ihoff == 0) { /* Writing concatenation */ +#line 6716 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6716 "" i__4[0] = 1, a__2[0] = ch__1; +#line 6716 "" i__4[1] = 5, a__2[1] = "tslur"; +#line 6716 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6717 "" lnote = 6; +#line 6718 "" } else { /* Shift needed */ /* Writing concatenation */ +#line 6722 "" chax_(ch__1, (ftnlen)1, &c__92); +#line 6722 "" i__4[0] = 1, a__2[0] = ch__1; +#line 6722 "" i__4[1] = 2, a__2[1] = "ts"; +#line 6722 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6723 "" lnote = 3; +#line 6724 "" } /* Print 23-ndxslur */ /* 5/25/08 Allow 14 slurs (???????????) */ +#line 6729 "" if (23 - comslur_1.ndxslur < 10) { /* Writing concatenation */ +#line 6730 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6730 "" i__2 = 71 - comslur_1.ndxslur; +#line 6730 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6730 "" i__4[1] = 1, a__2[1] = ch__1; +#line 6730 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6731 "" ++lnote; +#line 6732 "" } else if (23 - comslur_1.ndxslur < 20) { /* Writing concatenation */ +#line 6733 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6733 "" i__5[1] = 2, a__3[1] = "{1"; +#line 6733 "" i__2 = 61 - comslur_1.ndxslur; +#line 6733 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6733 "" i__5[2] = 1, a__3[2] = ch__1; +#line 6733 "" i__5[3] = 1, a__3[3] = "}"; +#line 6733 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 6734 "" lnote += 4; +#line 6735 "" } else { /* Writing concatenation */ +#line 6736 "" i__5[0] = lnote, a__3[0] = notexq; +#line 6736 "" i__5[1] = 2, a__3[1] = "{2"; +#line 6736 "" i__2 = 51 - comslur_1.ndxslur; +#line 6736 "" chax_(ch__1, (ftnlen)1, &i__2); +#line 6736 "" i__5[2] = 1, a__3[2] = ch__1; +#line 6736 "" i__5[3] = 1, a__3[3] = "}"; +#line 6736 "" s_cat(notexq, a__3, i__5, &c__4, (ftnlen)79); +#line 6737 "" lnote += 4; +#line 6738 "" } +#line 6739 "" if (bit_test(*iornq,11) || bit_test(*iornq,12)) { /* Raise or lower slur by one unit provided . or _ is on same side as slur */ +#line 6743 "" ivoffinc = 0; +#line 6744 "" if (stemup && *(unsigned char *)slurudq == 'd' || ! stemup && *(unsigned char *)slurudq == 'u') { +#line 6746 "" if (stemup) { +#line 6747 "" ivoffinc = -1; +#line 6748 "" } else { +#line 6749 "" ivoffinc = 1; +#line 6750 "" } +#line 6751 "" if ((stemup && *nolev >= *ncm - 2 || ! stemup && * nolev <= *ncm + 2) && (i__2 = *ncm - *nolev, abs(i__2)) % 2 == 0) { +#line 6751 "" ivoffinc <<= 1; +#line 6751 "" } +#line 6754 "" } +#line 6755 "" ivoff += ivoffinc; +#line 6756 "" } +#line 6757 "" if (idcode == 1 && tmove) { /* t-slur height adjustment */ +#line 6761 "" iupdn = 1; +#line 6762 "" if (*(unsigned char *)slurudq == 'd') { +#line 6762 "" iupdn = -1; +#line 6762 "" } +#line 6763 "" } +#line 6764 "" i__2 = nolevs + iupdn + ivoff; +#line 6764 "" notefq_(noteq, &lnoten, &i__2, ncm, (ftnlen)8); +#line 6765 "" if (*(unsigned char *)slurudq == 'u' && (! bit_test(isdat2[ isdat],0) || nolevs == comtrill_1.maxlev)) { +#line 6767 "" *islhgt = nolevs + iupdn + ivoff; /* If topvoice, upslur, and idcode checks, no more need to keep hgt for barno. */ +#line 6771 "" if (commvl_1.ivx == commvl_1.ivmx[*nv + commvl_1.nvmx[*nv - 1] * 24 - 25] && comsln_1.is1n1 > 0) { +#line 6772 "" if (idcode == comsln_1.is2n1) { +#line 6772 "" comsln_1.is1n1 = 0; +#line 6772 "" } +#line 6773 "" } +#line 6774 "" } /* Writing concatenation */ +#line 6775 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6775 "" i__4[1] = lnoten, a__2[1] = noteq; +#line 6775 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6776 "" lnote += lnoten; +#line 6777 "" if (ihoff != 0) { +#line 6778 "" shift = ihoff * .1f; /* Writing concatenation */ +#line 6779 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6779 "" i__4[1] = 1, a__2[1] = "{"; +#line 6779 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6780 "" ++lnote; +#line 6781 "" lform = lfmt1_(&shift); +#line 6782 "" i__2 = lnote; +#line 6782 "" ici__1.icierr = 0; +#line 6782 "" ici__1.icirnum = 1; +#line 6782 "" ici__1.icirlen = lnote + lform - i__2; +#line 6782 "" ici__1.iciunit = notexq + i__2; /* Writing concatenation */ +#line 6782 "" i__3[0] = 2, a__1[0] = "(f"; +#line 6782 "" i__6 = lform + 48; +#line 6782 "" chax_(ch__1, (ftnlen)1, &i__6); +#line 6782 "" i__3[1] = 1, a__1[1] = ch__1; +#line 6782 "" i__3[2] = 3, a__1[2] = ".1)"; +#line 6782 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__3, &c__3, (ftnlen) 6), ch__2); +#line 6782 "" s_wsfi(&ici__1); +#line 6782 "" do_fio(&c__1, (char *)&shift, (ftnlen)sizeof(real)); +#line 6782 "" e_wsfi(); +#line 6784 "" lnote += lform; /* Writing concatenation */ +#line 6785 "" i__4[0] = lnote, a__2[0] = notexq; +#line 6785 "" i__4[1] = 1, a__2[1] = "}"; +#line 6785 "" s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); +#line 6786 "" ++lnote; +#line 6787 "" } +#line 6788 "" addstr_(notexq, &lnote, soutq, lsout, (ftnlen)79, (ftnlen)80); /* Clear the bit from list of slurs in use */ +#line 6792 "" comslur_1.listslur = bit_clear(comslur_1.listslur, comslur_1.ndxslur); /* Zero out the entire strings for start and stop */ +#line 6796 "" isdata = 0; +#line 6797 "" isdat2[isdat] = 0; +#line 6798 "" isdat1[j] = 0; +#line 6799 "" isdat2[j] = 0; +#line 6800 "" isdat3[isdat] = 0; /* Set midi info for slur ending */ +#line 6804 "" if (commidi_1.ismidi && idcode == 32) { +#line 6805 "" icm = commidi_1.midchan[*iv + *kv * 24 - 25]; +#line 6806 "" if (comslm_1.slmon[icm]) { /* if (nolevs.eq.levson(icm) .and. iand(7,nacc).eq.0) then */ /* 130316 */ /* if (nolevs-iTransAmt(instno(iv)).eq.levson(icm) .and. */ +#line 6810 "" if (nolevs + commvel_1.miditran[cominsttrans_1.instno[ *iv - 1] - 1] == comslm_1.levson[icm] && (7 & *nacc) == 0) { @@ -10886,42 +16338,73 @@ L4: /* 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_ */ @@ -10952,57 +16435,102 @@ L4: /* 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_ */ @@ -11031,92 +16559,165 @@ L4: static logical tronly; /* Fortran I/O blocks */ - static cilist io___494 = { 0, 6, 0, 0, 0 }; + 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 "" } - s_wsle(&io___494); +#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_ */ @@ -11146,27 +16747,41 @@ L2: /* 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) */ @@ -11180,59 +16795,105 @@ L2: /* 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_ */ @@ -11267,27 +16928,40 @@ L2: static integer ibarnop; /* Fortran I/O blocks */ - static cilist io___504 = { 0, 6, 0, 0, 0 }; - static cilist io___507 = { 0, 19, 0, "(i6)", 0 }; - static cilist io___511 = { 0, 6, 0, "(1x,a)", 0 }; - static cilist io___512 = { 0, 15, 0, "(a)", 0 }; - static cilist io___515 = { 0, 6, 0, 0, 0 }; - static cilist io___516 = { 0, 15, 0, "(a)", 0 }; + 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 "" } - s_wsle(&io___504); +#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) { @@ -11295,160 +16969,299 @@ L2: /* 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); - s_wsfe(&io___507); +#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(); - s_wsfe(&io___511); +#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(); - s_wsfe(&io___512); +#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(); - s_wsle(&io___515); +#line 7039 "" + s_wsle(&io___516); +#line 7039 "" do_lio(&c__9, &c__1, outq, (ftnlen)78); +#line 7039 "" e_wsle(); - s_wsfe(&io___516); +#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_ */ @@ -11469,50 +17282,82 @@ L2: static integer itnd, nnsk, itprev; /* Fortran I/O blocks */ - static cilist io___521 = { 0, 6, 0, 0, 0 }; + 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 "" } - s_wsle(&io___521); +#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_ */ @@ -11524,7 +17369,9 @@ doublereal f1eon_(real *time) /* Builtin functions */ double sqrt(doublereal); +#line 7092 "" ret_val = sqrt(*time / 2); +#line 7093 "" return ret_val; } /* f1eon_ */ @@ -11537,9 +17384,13 @@ doublereal feon_(real *time) /* 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_ */ @@ -11612,7 +17463,7 @@ doublereal feon_(real *time) static integer masknow; /* Fortran I/O blocks */ - static cilist io___555 = { 0, 6, 0, 0, 0 }; + static cilist io___556 = { 0, 6, 0, 0, 0 }; @@ -11621,256 +17472,425 @@ doublereal feon_(real *time) /* integer numbms(nm),ipr(48),nip1(0:47),nip2(0:47),mapfb(16), */ /* * itr(48),nodue(48) */ /* logical short(48),eqonly */ +#line 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 "" } - s_wsle(&io___555); - do_lio(&c__9, &c__1, "Problem in findbeam, pleas" +#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; - if ((r__1 = r_mod(&r__2, &c_b1659), dabs(r__1)) > +#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_ */ @@ -11901,48 +17921,85 @@ L13: /* 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_ */ @@ -11962,80 +18019,133 @@ doublereal fnote_(integer *nodur, integer *ivx, integer *ip, integer *nacc) extern /* Subroutine */ int printl_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___571 = { 0, 6, 0, 0, 0 }; + 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 "" } - s_wsle(&io___571); +#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_ */ @@ -12056,28 +18166,50 @@ L4: /* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount. Ends program if no more input. */ +#line 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_ */ @@ -12089,6 +18221,11 @@ L4: 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]; @@ -12114,7 +18251,8 @@ L4: ftnlen); static integer idotform, ndxquote, i__, j; extern /* Subroutine */ int readmeter_(char *, integer *, integer *, - integer *, ftnlen), getpmxmod_(logical *, char *, ftnlen); + 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; @@ -12125,16 +18263,16 @@ L4: static integer itup; static real snum; static integer ntup; - extern /* Subroutine */ int g1etx_(char *, integer *, logical *, logical * - , integer *, real *, real *, ftnlen), stop1_(void), read10_(char * - , logical *, ftnlen); + 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 *, integer *, ftnlen); + integer *, integer *, integer *, integer *, ftnlen); static integer icclhw; static char charlq[1]; extern /* Subroutine */ int setmac_(char *, integer *, integer *, integer @@ -12145,8 +18283,9 @@ L4: ftnlen, ftnlen); static integer literr, mtrdnp; static real sysflb; - static integer numint, mtrnmp, numnum; + 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, @@ -12161,2679 +18300,4443 @@ L4: static integer lvoltxt; /* Fortran I/O blocks */ - static cilist io___581 = { 0, 6, 0, 0, 0 }; - static cilist io___582 = { 0, 6, 0, 0, 0 }; static cilist io___583 = { 0, 6, 0, 0, 0 }; static cilist io___584 = { 0, 6, 0, 0, 0 }; - static cilist io___585 = { 0, 15, 0, "(/a)", 0 }; - static cilist io___586 = { 0, 15, 0, "(a11,2x,i3)", 0 }; - static cilist io___587 = { 0, 15, 0, 0, 0 }; - static cilist io___588 = { 0, 6, 0, 0, 0 }; - static cilist io___596 = { 0, 6, 0, 0, 0 }; - static cilist io___597 = { 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___603 = { 0, 6, 0, 0, 0 }; - static cilist io___604 = { 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___618 = { 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___622 = { 0, 6, 0, 0, 0 }; - static cilist io___623 = { 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___632 = { 0, 6, 0, 0, 0 }; - static cilist io___633 = { 0, 6, 0, 0, 0 }; - static cilist io___634 = { 0, 15, 0, "(/,a)", 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, 15, 0, "(a)", 0 }; - static cilist io___643 = { 0, 6, 0, 0, 0 }; - static cilist io___644 = { 0, 15, 0, "(a)", 0 }; - static cilist io___648 = { 0, 6, 0, 0, 0 }; - static cilist io___649 = { 0, 6, 0, 0, 0 }; - static cilist io___650 = { 0, 6, 0, 0, 0 }; - static cilist io___651 = { 0, 6, 0, "(1x,a21,i3,a23)", 0 }; - static cilist io___655 = { 0, 6, 0, 0, 0 }; - static cilist io___656 = { 0, 6, 0, 0, 0 }; - static cilist io___657 = { 0, 5, 0, "(a)", 0 }; - static cilist io___661 = { 0, 6, 0, 0, 0 }; - static cilist io___662 = { 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) { - s_wsle(&io___581); +#line 7550 "" + s_wsle(&io___583); +#line 7550 "" e_wsle(); - s_wsle(&io___582); +#line 7551 "" + s_wsle(&io___584); +#line 7551 "" do_lio(&c__9, &c__1, "WARNING:", (ftnlen)8); +#line 7551 "" e_wsle(); - s_wsle(&io___583); +#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(); - s_wsle(&io___584); +#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(); - s_wsfe(&io___585); +#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(); - s_wsfe(&io___586); +#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); - s_wsle(&io___587); +#line 7563 "" + s_wsle(&io___589); +#line 7563 "" do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18); +#line 7563 "" e_wsle(); - s_wsle(&io___588); +#line 7564 "" + s_wsle(&io___590); +#line 7564 "" do_lio(&c__9, &c__1, "appending <blank>/", (ftnlen)18); +#line 7564 "" e_wsle(); /* Writing concatenation */ +#line 7565 "" i__3[0] = a1ll_2.iccount, a__2[0] = lineq; +#line 7565 "" i__3[1] = 2, a__2[1] = " /"; +#line 7565 "" s_cat(lineq, a__2, i__3, &c__2, (ftnlen)128); +#line 7566 "" c1omget_1.lastchar = FALSE_; +#line 7567 "" goto L1; +#line 7568 "" } +#line 7569 "" return 0; +#line 7570 "" } +#line 7571 "" if (*(unsigned char *)charq == ' ') { +#line 7572 "" goto L1; +#line 7573 "" } else if (*(unsigned char *)charq == '%' && a1ll_2.iccount == 1) { +#line 7574 "" a1ll_2.iccount = 128; +#line 7575 "" goto L1; /* Replacement 1/22/12 since gfortran 4.7 with -O was choking here! */ /* else if ((ichar(charq).ge.97.and.ichar(charq).le.103) .or. */ +#line 7580 "" } else if (i_indx("abcdefg", charq, (ftnlen)7, (ftnlen)1) > 0 || *( unsigned char *)charq == 'r') { /* This is a note/rest. gotclef is only used for checking for clef before "/" */ +#line 7585 "" if (cdot) { +#line 7585 "" goto L28; +#line 7585 "" } - if (c1omnotes_1.gotclef) { - c1omnotes_1.gotclef = FALSE_; - } +/* 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, ">200 notes in line of mu" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one digit a" +#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) { - s_wsle(&io___596); +#line 7621 "" + s_wsle(&io___598); +#line 7621 "" e_wsle(); - s_wsle(&io___597); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1" +#line 7623 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ ".2, +/- was ignored if octave was!", (ftnlen)128, (ftnlen)50); - s_wsle(&io___598); - do_lio(&c__9, &c__1, "explicitly specified. May need to" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, ">2 digits in note sy" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected num" +#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; - errmsg_(lineq, &i__1, &i__4, "Expected \"f\", \"s\", \"n\" o" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected number afte" +#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; - errmsg_(lineq, &i__1, &i__4, "Horizontal accidental shift mu" +#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; - errmsg_(lineq, &i__1, &i__4, "Vertical accid" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expe" +#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; - errmsg_(lineq, &i__1, &i__4, "Horiz. acciden" +#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) { - s_wsle(&io___603); +#line 7750 "" + s_wsle(&io___605); +#line 7750 "" e_wsle(); - s_wsle(&io___604); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1" +#line 7752 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Before version 1"\ ".2, +/- was ignored if octave was!", (ftnlen)128, (ftnlen)50); - s_wsle(&io___605); - do_lio(&c__9, &c__1, "explicitly specified. May need to" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must be a numb" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned off stick" +#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; - errmsg_(lineq, &i__1, &i__4, "Stemlength shortening must be " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on sticky" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "The option \"p\" onl" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"b\"; I" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "You entered \"r\" &" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "First char after \"" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Xtuplet cannot have " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only legal character" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only 2 shift" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Shift number" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "For slope ad" - "justment, this character must be \"+\" or \"-" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This charact" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slope adjust" +#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; - errmsg_(lineq, &i__1, &i__4, "Alternate xtup number " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Fermata " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal " - "character after \"e\" in edit. accid. sy" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu" +#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; - errmsg_(lineq, &i__4, &i__5, "Turned off repeate" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "\":\" mu" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Turned o" +#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; - errmsg_(lineq, &i__4, &i__5, "There should be an" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot s" +#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; - errmsg_(lineq, &i__4, &i__5, "There should b" +#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; - if (i_indx("udlbfnht", dumq, (ftnlen)8, (ftnlen)1) > 0) { +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Cannot u" +#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; - errmsg_(lineq, &i__4, &i__5, "Magnitude of s" - "lur height adjustment cannot exceed " +#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; - errmsg_(lineq, &i__4, &i__5, "Slur horiz shi" +#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; - errmsg_(lineq, &i__4, &i__5, "Slur midheight" +#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 " + "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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "May not " - "use linebreak slur options with font-bas" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "This cha" +#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; - errmsg_(lineq, &i__4, &i__5, "Magnitude of slur " +#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; - errmsg_(lineq, &i__4, &i__5, "Slur horiz shi" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must use" - " postscript slurs (\"Ap\") to use this o" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expect" +#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" + "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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Slur ID " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Figure in xt" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "No floating " +#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 (i_indx("0123456789#-n_.:", durq, (ftnlen)16, (ftnlen) +/* 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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Integer " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Vertical" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal char" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "A digit " - "less than 5 must follow \"m\" in a grace" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "A number" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__5, "In grace" +#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" + "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; - errmsg_(lineq, &a1ll_2.iccount, &i__5, "Illegal " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Macros not y" +#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; - g1etx_(lineq, &a1ll_2.iccount, &c_false, & - comkeys_1.shifton, &i__4, &c1omnotes_1.udsp[ - c1omnotes_1.ibarcnt + a1ll_2.nbars], & - c1omnotes_1.wheadpt, (ftnlen)128); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Comment " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Expectin" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "In xtup, this ch" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Sorry, PMX canno" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal option o" +#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; - errmsg_(lineq, &i__1, &i__4, "Multibar rest must start at be" +#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; - errmsg_(lineq, &i__1, &i__4, "Multibar rest only OK at one t" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected an integer " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must enter s" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",\"L\" options " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\",+\",\"-\",\"" +#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); - s_wsle(&io___618); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Unbeamable thing in forc" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot have more tha" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Pickup bar lengt" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected note name o" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected chord note name" +#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; - errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n\" before \"" +#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; - errmsg_(lineq, &i__1, &i__4, "Must have \"f,s,n,A\" before" +#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; - errmsg_(lineq, &i__1, &i__4, "Expected a number to start her" +#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; - errmsg_(lineq, &i__1, &i__4, "\".\" here must be followed by" +#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; - errmsg_(lineq, &i__1, &i__4, "Number after +/- must foll" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in cho" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit less than 5 " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A number must foll" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "In grace, expected" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Only one of" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Illegal character af" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"o\" must be in sam" +#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 (i_indx("(stmgx+Tupf._)e:>^bc", dumq, (ftnlen)20, (ftnlen)1) == - 0) { +/* 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected blank a" +#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; - errmsg_(lineq, &i__1, &i__4, "Turned off repeated orname" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry, only one" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "segno can only b" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected bla" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in" +#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; - errmsg_(lineq, &i__1, &i__4, "There should be an integer" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot shift AND" +#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; - errmsg_(lineq, &i__1, &i__4, "There should be a numb" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\":\" must be fo" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Turned on repeat" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot use \"t\" as " +#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 "" } - if (i_indx("udltb+-fnhHps ", dumq, (ftnlen)14, (ftnlen)1) == 0) { +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID must" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur ID not " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape p" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot reshape posts" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must use postscr" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"+\" o" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected \"s\" o" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+|-\" for slur" +#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; - errmsg_(lineq, &i__1, &i__4, "Magnitude of slur heig" +#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; - errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must " +#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; - errmsg_(lineq, &i__1, &i__4, "Slur midheight must be" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Slur" - " curve parameter must be in range (0" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not use line" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character m" +#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; - errmsg_(lineq, &i__1, &i__4, "Magnitude of slur height a" +#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; - errmsg_(lineq, &i__1, &i__4, "Slur horiz shift must " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Cannot put figure be" +#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; - errmsg_(lineq, &i__1, &i__4, "Cannot have a blank here i" +#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); - if (i_indx(" 0123456789#-nx_.:+s", charq, (ftnlen)20, (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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer for vert" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Vertical offset " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Started forced beam " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced multiplic" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig" +#line 9222 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"[\", dig"\ "its must now be preceeded by \"+\" or \"-\"!", ( ftnlen)128, (ftnlen)54); - s_wsle(&io___621); - do_lio(&c__9, &c__1, "You will have to edit older source" +#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(); - s_wsle(&io___622); - do_lio(&c__9, &c__1, "but it was needed to allow 2-digit" +#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(); - s_wsle(&io___623); - do_lio(&c__9, &c__1, "Sorry for the inconvenience. --Th" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced beam stop wit" +#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; - errmsg_(lineq, &i__1, &i__4, "Only sequence allowed here" +#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; - errmsg_(lineq, &i__1, &i__4, "This character must be a b" +#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; - errmsg_(lineq, &i__1, &i__4, "This character must be" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"]\" must be fo" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"D\" must not come " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"+\" or \"" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There must b" +#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; - errmsg_(lineq, &i__1, &i__4, "\"h\" or \"l\" must be" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol \"w\" (wi" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Symbol must go a" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal unit; mu" +#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. */ @@ -14842,28 +22745,44 @@ L17: /* 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK" +#line 9393 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Meter change only OK"\ " in voice 1, at start of block!", (ftnlen)128, ( ftnlen)51); - s_wsle(&io___626); +#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 */ @@ -14871,387 +22790,645 @@ L17: /* 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 <= - 55)) { + 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have t,s,m,a,n," - "r,b,f or 1-7 after C!", (ftnlen)128, (ftnlen)41); +#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 "" } - c1omnotes_1.gotclef = TRUE_; +/* 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Repeats can only go " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character af" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Voltas are only allo" +#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) { - s_wsle(&io___632); +#line 9457 "" + s_wsle(&io___635); +#line 9457 "" e_wsle(); - s_wsle(&io___633); +#line 9458 "" + s_wsle(&io___636); +#line 9458 "" do_lio(&c__9, &c__1, "*******WARNING********", (ftnlen)22); +#line 9458 "" e_wsle(); - s_wsfe(&io___634); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o" +#line 9460 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "There is more than o"\ "ne volta in this input block.!", (ftnlen)128, (ftnlen) 50); - s_wsle(&io___635); - do_lio(&c__9, &c__1, "This may work in a score, but WILL NOT" +#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(); - s_wsle(&io___636); - do_lio(&c__9, &c__1, "Safest to have only 1 volta per block," +#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(); - s_wsfe(&io___637); - do_fio(&c__1, "This may work in a score, but WILL NOT work i" +#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(); - s_wsfe(&io___638); - do_fio(&c__1, "Safest to have only 1 volta per block, at the" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only allowed at begi" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Missing close qu" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\",\"r\",\"" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Expected a number to" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must put \"i\", \"" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"Aa\", ne" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "After \"AS\"" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only letters" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must star" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"AN\" must be f" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "In \"AN\", file " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only \"l\" or" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "After \"A\" must fol" - "low one of the letters abcdeiINprRsST!", (ftnlen)128, - (ftnlen)56); - s_wsle(&io___643); - do_lio(&c__9, &c__1, "For AS, since ver. 2.7, must only have" +#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(); - s_wsfe(&io___644); - do_fio(&c__1, "For AS, since ver. 2.7, must only have noinst" +#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 */ @@ -15263,108 +23440,165 @@ L42: /* then adjust fbar to make poenom much more accurate. */ /* Jan 02: Now K-0+[n] is used to transpose e.g. from f to f#. */ +#line 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"K\" (transpose or " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st +/- must be " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "1st number aft" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Only one key" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Transpositio" +#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 */ @@ -15384,669 +23618,1086 @@ L77: /* 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, &a1ll_2.iv, (ftnlen)128); + 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar line marker out " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "WARNING: Block ended" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block ended with for" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-" +#line 9822 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Bar ended with user-"\ "defined shift still on!", (ftnlen)128, (ftnlen)43); +#line 9824 "" stop1_(); - } else if (c1omnotes_1.gotclef) { - i__1 = c1omnotes_1.ibarcnt - c1omnotes_1.ibaroff + - a1ll_2.nbars + 1; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "May not enter clef a" - "t end of input block!", (ftnlen)128, (ftnlen)41); - 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d" +#line 9838 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not d"\ "ivisible by lenbar!", (ftnlen)128, (ftnlen)39); - s_wsle(&io___648); +#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]) { - s_wsle(&io___649); +#line 9843 "" + s_wsle(&io___652); +#line 9843 "" e_wsle(); - s_wsle(&io___650); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Block duration not e" +#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) { - s_wsfe(&io___651); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "\"S\" can only be in" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "A digit must follow" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have a numb" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to defi" +#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; - errmsg_(lineq, &i__1, &i__4, "You already forced a line " +#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) { - s_wsle(&io___655); +#line 9968 "" + s_wsle(&io___658); +#line 9968 "" e_wsle(); - s_wsle(&io___656); - do_lio(&c__9, &c__1, "WARNING! You forced a line break at li" +#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(); - s_rsfe(&io___657); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Forced line break at" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have \" \", \"" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Need integer to " +#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; - errmsg_(lineq, &i__1, &i__4, "Forced page break at page " +#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; - errmsg_(lineq, &i__1, &i__4, "Forced page break numb" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal character in" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Integer requ" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Decimal numb" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Must have" - " \"+\" or \"-\" after \"r\" as movement brea" +#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 */ - i__8[0] = 34, a__3[0] = "Illegal new number of i" +#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 */ - i__2[0] = 34, a__1[0] = "Illegal new number of i" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "New number o" +#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 */ - i__8[0] = 34, a__3[0] = "Illegal 2-digit ins" +#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 */ - i__2[0] = 26, a__1[0] = "Illegal instrument " +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "New inst" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__4, "Must hav" - "e t,s,m,a,n,r,b,f or 1-7 as clef symbol " +#line 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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Illegal characte" +#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; - g1etx_(lineq, &a1ll_2.iccount, &c_true, &comkeys_1.shifton, &i__1, - &c1omnotes_1.udsp[c1omnotes_1.ibarcnt + a1ll_2.nbars], & +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "MIDI stuff only allo" +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "Sorry but MIDI does " +#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 { - s_wsle(&io___661); +#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; - errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al" +#line 10221 "" + errmsg_(lineq, &a1ll_2.iccount, &i__1, "This character is not al"\ "lowed here!", (ftnlen)128, (ftnlen)35); - s_wsle(&io___662); +#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_ */ @@ -16082,95 +24733,159 @@ L31: static integer iccount; /* Fortran I/O blocks */ - static cilist io___665 = { 0, 6, 0, 0, 0 }; - static cilist io___666 = { 0, 6, 0, "(1x,a46,i3)", 0 }; - static cilist io___667 = { 0, 6, 0, "(a)", 0 }; + 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___671 = { 0, 6, 0, "(a)", 0 }; - static cilist io___672 = { 0, 6, 0, 0, 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: - s_wsle(&io___665); - do_lio(&c__9, &c__1, "You did not terminate type 0 TeX input with \"" +#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) { - s_wsfe(&io___666); +#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) { - s_wsfe(&io___667); - do_fio(&c__1, "In setup data, cannot have more instruments than stav" +#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!!! */ @@ -16179,125 +24894,213 @@ L2: /* 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) { - s_wsfe(&io___670); +#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) { - s_wsfe(&io___671); +#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) { - s_wsle(&io___672); +#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('brnamstf0123456',lineq(iv:iv)) .eq. 0) then */ - if (i_indx("brnamstf01234567", lineq + (iv - 1), (ftnlen)16, (ftnlen) +/* 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 = *(unsigned char *)lineq == 't'; +/* bottreb = lineq(1:1).eq.'t' */ +#line 10364 "" + *bottreb = i_indx("t08", lineq, (ftnlen)3, (ftnlen)1) > 0; -/* Mext non-comment line has path name */ +/* 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 */ - i__3[0] = 47, a__2[0] = "Last character of pathname is not \"/\",\"" +#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 *notxtup, - logical *shifton, integer *ibar, real *udsp, real *wheadpt, ftnlen - lineq_len) +/* Subroutine */ int g1etx_(char *lineq, integer *iccount, logical *shifton, + integer *ibar, real *udsp, real *wheadpt, ftnlen lineq_len) { /* System generated locals */ integer i__1; @@ -16321,91 +25124,155 @@ L8: /* Parse "X" commands. Ignore all "B"; "P" means to ignore whole symbol. */ /* In scor2prt, must strip out "P", copy only "B" and "P"-type "X"-symbols. */ +#line 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_(); -/* else if (.not.notxtup .and. ipbsc.gt.2) then */ -/* call errmsg(lineq,iccount,ibar,'Not allowed in xtuplet!') */ -/* call 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; - errmsg_(lineq, &i__1, ibar, "Cannot have both \"P\" and \"B\" or \"" +#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; - errmsg_(lineq, &i__1, ibar, "Started a group shift without s" +#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; - errmsg_(lineq, &i__1, ibar, "Ended a group shift without sta" +#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; - errmsg_(lineq, &i__1, ibar, "Must have either a number or a colon " +#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_ */ @@ -16424,11 +25291,16 @@ L1: /* 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_ */ @@ -16447,27 +25319,43 @@ L1: /* Gets the next character out of lineq*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount. Ends program if no more input. */ +#line 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]; - return 0; -/* L999: */ - comget_1.lastchar = TRUE_; +#line 10508 "" return 0; } /* getchar_ */ @@ -16524,24 +25412,39 @@ L1: /* 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); @@ -16549,155 +25452,239 @@ L1: /* 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(); - idno = (i_indx("ppppppp pp p mp mf f fp sfz ff fff ffff " +#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 *nfigs, ftnlen - charq_len, ftnlen lineq_len, ftnlen figq_len) + 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]; @@ -16715,78 +25702,136 @@ L2: /* 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); - -/* As of 11/26/08, trapped extra figures in getnote, so no need here. */ - -/* if (ivx .gt. 2) then */ -/* c */ -/* c Read past the figure */ -/* c */ -/* 6 call getchar(lineq,iccount,charq) */ -/* if (charq .ne. ' ') go to 6 */ -/* return */ -/* end if */ +/* * 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 (charq .ne. ' ') then */ - if (i_indx(" +", charq, (ftnlen)2, (ftnlen)1) == 0) { +/* 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_ */ @@ -16824,175 +25869,295 @@ L5: /* 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, integer *iv, ftnlen lineq_len) + noinst, ftnlen lineq_len) { /* System generated locals */ integer i__1; @@ -17042,96 +26207,166 @@ L9: /* fn. of nm, just a counter, where corr. inst num is iInstTrans(nm). This */ /* simplifies use of iTransAmt for all calls to ifnolev. */ +#line 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; - errmsg_(lineq, iccount, &i__1, "There must be an instrument number h" +#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; - errmsg_(lineq, iccount, &i__1, "1st character after instrument numbe" +#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; - errmsg_(lineq, iccount, &i__1, "There must be a transposition amount" +#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; - errmsg_(lineq, iccount, &i__1, "1st character after transposition am" +#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_ */ @@ -17173,8 +26408,8 @@ L1: char *, real *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___719 = { 0, 6, 0, "(a)", 0 }; - static cilist io___720 = { 0, 15, 0, "(a)", 0 }; + 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, */ @@ -17194,278 +26429,467 @@ L1: /* 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; - errmsg_(lineq, iccount, &i__1, "Expected an integer here for the" +#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; - errmsg_(lineq, iccount, &i__1, "Expected a number here for the p" +#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); - iname = i_indx("XXpiXrhXhaXmaXorXguXabXvlXvaXvcXcbXtrXtbXtuX" +#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; - errmsg_(lineq, iccount, &i__3, "Unrecognized 2-letter mi" +#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; - errmsg_(lineq, iccount, &i__3, "Expected a midi instrume" +#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; - errmsg_(lineq, &i__3, &i__4, "Midi instrument number mus" +#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; - errmsg_(lineq, iccount, &i__3, "Expected a midi velocity num" +#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; - errmsg_(lineq, &i__3, &i__4, "Midi velocity must be in range" +#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; - errmsg_(lineq, iccount, &i__3, "Expected a balance number he" +#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; - errmsg_(lineq, &i__3, &i__4, "Midi balance must be in range " +#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; - errmsg_(lineq, iccount, &i__3, "Expected \"+\" or \"-\" for " +#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; - errmsg_(lineq, iccount, &i__1, "Expected an integer here for the" +#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; - errmsg_(lineq, iccount, &i__1, "You tried to record a MidiMa" +#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; - errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number" +#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; - errmsg_(lineq, iccount, &i__1, "MidiMacro ID cannot exce" +#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. */ @@ -17474,189 +26898,308 @@ L1: /* 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; - errmsg_(lineq, &i__1, &i__3, "You tried to end a MidiMacro b" +#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; - errmsg_(lineq, iccount, &i__1, "Expected MidiMacro ID number" +#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; - errmsg_(lineq, iccount, &i__1, "You tried to play a MidiMacr" +#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; - errmsg_(lineq, iccount, &i__1, "Cannot play a MIDI macro" +#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; - errmsg_(lineq, iccount, &i__1, "Illegal character in MidiMacro s" +#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); - s_wsfe(&io___719); - do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, " +#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(); - s_wsfe(&io___720); - do_fio(&c__1, "May be too many args to i,v,b, or T. As of Ver. 2.7, " +#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[2], a__2[3], a__3[5], a__4[6], a__5[8], a__6[13]; - integer i__1, i__2, i__3, i__4[2], i__5[3], i__6[5], i__7[6], i__8[8], + 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[11], ch__8[3], ch__9[9], ch__10[61], ch__11[8], ch__12[82], - ch__13[83], ch__14[62], ch__15[122], ch__16[15], ch__17[59], - ch__18[70], ch__19[36]; + 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 */ @@ -17668,9 +27211,9 @@ L1: ), 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_cat(char *, char **, integer *, integer *, ftnlen), - s_copy(char *, char *, ftnlen, ftnlen); + /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_wsfi(icilist *), e_wsfi(void); /* Local variables */ @@ -17682,14 +27225,14 @@ L1: extern integer igetbits_(integer *, integer *, integer *); static integer idotform; extern /* Subroutine */ int newvoice_(integer *, char *, logical *, - ftnlen); + 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, ipm, ivf, ndx; + static integer ic, jv, kv, iip, ipm, ivf, ndx, isl, iiv; static real dum; - static integer iiv, iis, isl, iip, npg1, num1, iadj, nadj, lclf; + static integer iis, npg1, num1, iadj, nadj, lclf; extern /* Character */ VOID chax_(char *, ftnlen, integer *); static logical cdot; static integer nole, ioct; @@ -17712,9 +27255,9 @@ L1: , integer *, char *, ftnlen, ftnlen); static integer ifnum, nvold, iinow, iinst; extern /* Subroutine */ int getitransinfo_(logical *, integer *, char *, - integer *, integer *, integer *, integer *, integer *, ftnlen); + integer *, integer *, integer *, integer *, ftnlen); static logical quoted; - static char hdlndq[59]; + static char lineqt[128], hdlndq[59]; extern integer lenstr_(char *, integer *, ftnlen); static integer numnum; extern /* Subroutine */ int getorn_(char *, integer *, integer *, integer @@ -17724,13 +27267,15 @@ L1: extern /* Subroutine */ int littex_(integer *, integer *, integer *, logical *, char *, integer *, ftnlen), getfig_(integer *, char *, char *, integer *, logical *, integer *, integer *, integer *, - char *, integer *, integer *, ftnlen, ftnlen, ftnlen); + char *, integer *, integer *, integer *, ftnlen, ftnlen, ftnlen); static integer nactmp; extern /* Subroutine */ int getdyn_(integer *, integer *, integer *, - integer *, char *, integer *, ftnlen), getbuf_(char *, ftnlen); + integer *, char *, integer *, ftnlen); + static integer nodurt; extern integer ncmidf_(char *, ftnlen); - static integer nnliiv; - extern /* Subroutine */ int printl_(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 *, @@ -17743,10 +27288,9 @@ L1: static integer numshft; static real xofforn; extern integer ifnolev_(char *, integer *, integer *, ftnlen), ifnodur_( - integer *, char *, ftnlen); - static real fmovbrk; - extern integer numclef_(char *, ftnlen); + 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); @@ -17754,101 +27298,142 @@ L1: static real tintstf; /* Fortran I/O blocks */ - static cilist io___724 = { 0, 11, 0, "(a)", 0 }; - static cilist io___732 = { 0, 6, 0, 0, 0 }; - static cilist io___746 = { 0, 6, 0, 0, 0 }; - static cilist io___747 = { 0, 6, 0, 0, 0 }; - static cilist io___752 = { 0, 6, 0, 0, 0 }; - static cilist io___754 = { 0, 6, 0, 0, 0 }; - static cilist io___755 = { 0, 6, 0, 0, 0 }; - static cilist io___758 = { 0, 6, 0, 0, 0 }; - static cilist io___764 = { 0, 11, 0, "(a)", 0 }; - static cilist io___765 = { 0, 11, 0, "(a)", 0 }; - static cilist io___768 = { 0, 11, 0, "(a)", 0 }; - static cilist io___769 = { 0, 11, 0, "(a)", 0 }; - static cilist io___770 = { 0, 11, 0, "(a11,i2,a)", 0 }; - static cilist io___771 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___773 = { 0, 11, 0, "(a8,i1,a3)", 0 }; - static cilist io___774 = { 0, 11, 0, "(a9,i2,a4)", 0 }; - static cilist io___775 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___776 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___777 = { 0, 6, 0, 0, 0 }; - static cilist io___778 = { 0, 6, 0, 0, 0 }; + 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___793 = { 0, 11, 0, "(a)", 0 }; - static cilist io___794 = { 0, 11, 0, "(a)", 0 }; - static cilist io___795 = { 0, 11, 0, "(a)", 0 }; - static cilist io___796 = { 0, 11, 0, "(a)", 0 }; - static cilist io___798 = { 0, 11, 0, "(a)", 0 }; - static cilist io___801 = { 0, 11, 0, "(a)", 0 }; - static cilist io___802 = { 0, 11, 0, "(a)", 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___807 = { 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) { - s_wsfe(&io___724); +#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 */ @@ -17857,43 +27442,61 @@ L1: /* 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) { @@ -17901,553 +27504,869 @@ L28: /* 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 { - s_wsle(&io___732); +#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) { - s_wsle(&io___746); +#line 12014 "" + s_wsle(&io___750); +#line 12014 "" e_wsle(); - s_wsle(&io___747); - do_lio(&c__9, &c__1, "Figures not allowed in >1 " +#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], & @@ -18455,12 +28374,18 @@ L7: 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 + @@ -18470,146 +28395,211 @@ L7: 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); @@ -18617,260 +28607,496 @@ L34: /* 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 */ @@ -18878,370 +29104,547 @@ L8: /* Could have problem here if rests & doubled notes are combined in xtup, */ /* since might exit the loop at the wrong place. Worry about it later. */ +#line 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 */ - 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],30); +/* 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 != ' ') { - s_wsle(&io___752); +#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 */ @@ -19273,212 +29676,331 @@ L20: /* 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); @@ -19496,281 +30018,277 @@ L25: /* These data MUST precede note name of first note */ /* nolevg, naccg: lists of levels and accid's, indexed as described above. */ -/* ngrace = ngrace+1 */ -/* ivg(ngrace) = ivx */ -/* ipg(ngrace) = nnl(ivx)+1 */ -/* if (ngrace .eq. 1) then */ -/* ngstrt(ngrace) = 1 */ -/* else */ -/* ngstrt(ngrace) = ngstrt(ngrace-1)+nng(ngrace-1) */ -/* end if */ -/* islur(ivx,nnl(ivx)+1) = ibset(islur(ivx,nnl(ivx)+1),4) */ -/* nng(ngrace) = 1 */ -/* multg(ngrace) = 1 */ -/* upg(ngrace) = .true. */ -/* slurg(ngrace) = .false. */ -/* slashg(ngrace) = .false. */ -/* 18 call getchar(lineq,iccount,charq) */ -/* if (index('WA',charq) .gt. 0) then */ -/* c */ -/* c Grace is on note that was already done, so shift flags forward one note. */ -/* c This puts flag on actual note with grace; later for W will go ahead one more. */ -/* c */ -/* ipg(ngrace) = nnl(ivx) */ -/* islur(ivx,nnl(ivx)+1) = ibclr(islur(ivx,nnl(ivx)+1),4) */ -/* islur(ivx,nnl(ivx)) = ibset(islur(ivx,nnl(ivx)),4) */ -/* if (slurg(ngrace)) */ -/* * iornq(ivx,nnl(ivx)) = ibset(iornq(ivx,nnl(ivx)),24) */ -/* if (charq .eq. 'A') then */ -/* c */ -/* c close After, clear way-after bit, to ensure priority of most recent A/W */ -/* c */ -/* ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),31),29) */ -/* else */ -/* c */ -/* c Way after; later assign to following note, and position like normal grace. */ -/* c */ -/* ipl(ivx,nnl(ivx)) = ibset(ibclr(ipl(ivx,nnl(ivx)),29),31) */ -/* end if */ -/* else if (charq .eq. 'm') then */ -/* call getchar(lineq,iccount,charq) */ -/* multg(ngrace) = ichar(charq)-48 */ -/* else if (index('123456789',charq) .gt. 0) then */ -/* call readnum(lineq,iccount,durq,fnum) */ -/* iccount = iccount-1 */ -/* nng(ngrace) = nint(fnum) */ -/* else if (charq .eq. 'l') then */ -/* upg(ngrace) = .false. */ -/* else if (charq .eq. 's') then */ -/* slurg(ngrace) = .true. */ -/* if (nnl(ivx) .gt. 0) then */ -/* c */ -/* c If A- or W-grace, set signal to start slur on main note. */ -/* c */ -/* if(btest(ipl(ivx,nnl(ivx)),31) .or. */ -/* * btest(ipl(ivx,nnl(ivx)),29)) */ -/* * iornq(ivx,nnl(ivx))=ibset(iornq(ivx,nnl(ivx)),24) */ -/* end if */ -/* else if (charq .eq. 'x') then */ -/* slashg(ngrace) = .true. */ -/* else if (charq .eq. 'u') then */ -/* else if (charq .eq. 'X') then */ -/* c */ -/* c Space before main note of grace. Number will come next. */ -/* c */ -/* iccount = iccount+1 */ -/* call readnum(lineq,iccount,durq,graspace(ngrace)) */ -/* iccount = iccount-1 */ -/* end if */ -/* if (index('abcdefg',charq) .eq. 0) go to 18 */ -/* c */ -/* c At this point, charq is first note name in grace */ -/* c */ -/* do 19 ing = ngstrt(ngrace), ngstrt(ngrace)+nng(ngrace)-1 */ -/* naccg(ing) = 0 */ -/* ioct = 0 */ -/* if (ing .gt. ngstrt(ngrace)) then */ -/* 55 call getchar(lineq,iccount,charq) */ -/* if (charq .eq. ' ') go to 55 */ -/* endif */ -/* iclastlev = 0 */ -/* 9 call getchar(lineq,iccount,durq) */ -/* if (durq .ne. ' ') then */ -/* if (durq.eq.'+') then */ -/* lastlev = lastlev+7 */ -/* iclastlev = iclastlev+7 */ -/* else if (durq.eq.'-') then */ -/* lastlev = lastlev-7 */ -/* iclastlev = iclastlev-7 */ -/* else if (index('fsn',durq) .gt. 0) then */ -/* if (naccg(ing) .eq. 0) then */ -/* naccg(ing) = index('fsn',durq) */ -/* else */ -/* c */ -/* c Double accidental */ -/* c */ -/* naccg(ing) = ibset(naccg(ing),2) */ -/* end if */ -/* else */ -/* ioct = ichar(durq)-48 */ -/* end if */ -/* go to 9 */ -/* end if */ -/* if (ioct .gt. 0) then */ -/* lastlev = ifnolev(charq,ioct) */ -/* else */ -/* if (nnl(ivx).eq.0 .and. ing.eq.ngstrt(ngrace)) then */ -/* if (ivx .le. nv) then */ -/* kv = 1 */ -/* else */ -/* kv = 2 */ -/* end if */ -/* lastlev = ndlev(iv,kv)+iclastlev */ -/* end if */ -/* lastlev = lastlev-3+mod(ifnolev(charq,10)-lastlev+3,7) */ -/* end if */ -/* nolevg(ing) = lastlev */ -/* 19 continue */ -/* c */ -/* c Grace could come before first note of block, so reset end level. */ -/* c */ -/* if (nnl(ivx).eq.0) then */ -/* if (ivx .le. nv) then */ -/* kv = 1 */ -/* else */ -/* kv = 2 */ -/* end if */ -/* ndlev(iv,kv) = lastlev */ -/* end if */ +#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) { - s_wsle(&io___754); +#line 12917 "" + s_wsle(&io___766); +#line 12917 "" e_wsle(); - s_wsle(&io___755); - do_lio(&c__9, &c__1, "Figures not allowed in >1 voice above " +#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.nfigs[ivf - 1], (ftnlen)1, (ftnlen)128, ( - ftnlen)10); + - 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); @@ -19778,283 +30296,457 @@ L17: /* Set flag to watch for END of this forced beam, so can set flag rest(30) on */ /* NEXT note as signal to start a new notes group there. */ +#line 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) { - s_wsle(&io___758); +#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 */ @@ -20066,238 +30758,503 @@ L31: /* 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) { - s_wsfe(&io___764); +#line 13169 "" + s_wsfe(&io___775); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 11, a__1[1] = "nostartrule"; - s_cat(ch__2, a__1, i__4, &c__2, (ftnlen)12); +#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) { - s_wsfe(&io___765); +#line 13171 "" + s_wsfe(&io___776); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 9, a__1[1] = "startrule"; - s_cat(ch__3, a__1, i__4, &c__2, (ftnlen)10); +#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 */ - i__4[0] = 1, a__1[0] = "{"; +#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); - i__4[1] = 1, a__1[1] = ch__1; - s_cat(hdlndq, a__1, i__4, &c__2, (ftnlen)59); +#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 */ - i__4[0] = lclf, a__1[0] = hdlndq; +#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); - i__4[1] = 1, a__1[1] = ch__1; - s_cat(hdlndq, a__1, i__4, &c__2, (ftnlen)59); +#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 */ - i__5[0] = lclf, a__2[0] = hdlndq; +#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); - i__5[1] = 1, a__2[1] = ch__1; - i__5[2] = 1, a__2[2] = "}"; - s_cat(hdlndq, a__2, i__5, &c__3, (ftnlen)59); +#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) { - s_wsfe(&io___768); +#line 13203 "" + s_wsfe(&io___779); /* Writing concatenation */ - i__6[0] = 1, a__3[0] = all_1.sq; - i__6[1] = 9, a__3[1] = "setstaffs"; +#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); - i__6[2] = 1, a__3[2] = ch__1; +#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); - i__6[3] = 1, a__3[3] = ch__5; - i__6[4] = 1, a__3[4] = "%"; - s_cat(ch__4, a__3, i__6, &c__5, (ftnlen)13); +#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(); - s_wsfe(&io___769); +#line 13205 "" + s_wsfe(&io___780); /* Writing concatenation */ - i__6[0] = 1, a__3[0] = all_1.sq; - i__6[1] = 7, a__3[1] = "setclef"; +#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); - i__6[2] = 1, a__3[2] = ch__1; - i__6[3] = lclf, a__3[3] = hdlndq; - i__6[4] = 1, a__3[4] = "%"; - s_cat(ch__6, a__3, i__6, &c__5, (ftnlen)69); +#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 { - s_wsfe(&io___770); -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 10, a__1[1] = "setstaffs{"; - s_cat(ch__7, a__1, i__4, &c__2, (ftnlen)11); - do_fio(&c__1, ch__7, (ftnlen)11); +#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 */ - i__5[0] = 1, a__2[0] = "}"; +#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); - i__5[1] = 1, a__2[1] = ch__1; - i__5[2] = 1, a__2[2] = "%"; - s_cat(ch__8, a__2, i__5, &c__3, (ftnlen)3); - do_fio(&c__1, ch__8, (ftnlen)3); +#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(); - s_wsfe(&io___771); -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 8, a__1[1] = "setclef{"; - s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9); - do_fio(&c__1, ch__9, (ftnlen)9); +#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 */ - i__5[0] = 1, a__2[0] = "}"; - i__5[1] = lclf, a__2[1] = hdlndq; - i__5[2] = 1, a__2[2] = "%"; - s_cat(ch__10, a__2, i__5, &c__3, (ftnlen)61); - do_fio(&c__1, ch__10, lclf + 2); +#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) { - s_wsfe(&io___773); -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 7, a__1[1] = "setname"; - s_cat(ch__11, a__1, i__4, &c__2, (ftnlen)8); - do_fio(&c__1, ch__11, (ftnlen)8); +#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 { - s_wsfe(&io___774); -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 8, a__1[1] = "setname{"; - s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9); - do_fio(&c__1, ch__9, (ftnlen)9); +#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) { - s_wsfe(&io___775); -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 7, a__1[1] = "setname"; - s_cat(ch__11, a__1, i__4, &c__2, (ftnlen)8); - do_fio(&c__1, ch__11, (ftnlen)8); +#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 */ - i__5[0] = 1, a__2[0] = "{"; - i__5[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1] - - 1], a__2[1] = comtop_1.inameq + ( +#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; - i__5[2] = 2, a__2[2] = "}%"; - s_cat(ch__12, a__2, i__5, &c__3, (ftnlen)82); - do_fio(&c__1, ch__12, comtop_1.lnam[ +#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 { - s_wsfe(&io___776); -/* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 8, a__1[1] = "setname{"; - s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9); - do_fio(&c__1, ch__9, (ftnlen)9); +#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 */ - i__5[0] = 2, a__2[0] = "}{"; - i__5[1] = comtop_1.lnam[comnvi_1.iiorig[iinst - 1] - - 1], a__2[1] = comtop_1.inameq + ( +#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; - i__5[2] = 2, a__2[2] = "}%"; - s_cat(ch__13, a__2, i__5, &c__3, (ftnlen)83); - do_fio(&c__1, ch__13, comtop_1.lnam[ +#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)) { @@ -20305,44 +31262,67 @@ L31: /* 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) { - s_wsle(&io___777); +#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. */ @@ -20351,324 +31331,572 @@ L4: /* Check whether at beginning of a block */ +#line 13308 "" if (all_1.iv != 1 || all_1.nnl[0] != 0) { - s_wsle(&io___778); +#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') { - all_1.iornq[(all_1.nnl[0] + 1) * 24] = bit_set(all_1.iornq[( - all_1.nnl[0] + 1) * 24],29); +/* 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 */ - i__4[0] = lvoltxt, a__1[0] = comgrace_1.voltxtq + ( +#line 13421 "" + i__5[0] = lvoltxt, a__2[0] = comgrace_1.voltxtq + ( comgrace_1.nvolt - 1) * 20; - i__4[1] = 1, a__1[1] = durq; - s_cat(comgrace_1.voltxtq + (comgrace_1.nvolt - 1) * 20, a__1, - i__4, &c__2, (ftnlen)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 "" } - s_wsle(&io___791); +#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 */ - i__5[0] = lhead, a__2[0] = hdlndq; +#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); - i__5[1] = 1, a__2[1] = ch__1; - i__5[2] = 1, a__2[2] = "{"; - s_cat(hdlndq, a__2, i__5, &c__3, (ftnlen)59); +#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) { - s_wsfe(&io___793); +#line 13512 "" + s_wsfe(&io___803); /* Writing concatenation */ - i__4[0] = lhead, a__1[0] = hdlndq; - i__4[1] = 3, a__1[1] = "}}%"; - s_cat(ch__14, a__1, i__4, &c__2, (ftnlen)62); - do_fio(&c__1, ch__14, lhead + 3); +#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) { - s_wsfe(&io___794); -/* Writing concatenation */ - i__5[0] = lhead, a__2[0] = hdlndq; - i__5[1] = ltopnam, a__2[1] = comtrans_1.cheadq; - i__5[2] = 3, a__2[2] = "}}%"; - s_cat(ch__15, a__2, i__5, &c__3, (ftnlen)122); - do_fio(&c__1, ch__15, lhead + ltopnam + 3); +#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 */ @@ -20678,491 +31906,831 @@ L36: /* * 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) - 120); + 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_; - s_wsfe(&io___795); +#line 13573 "" + s_wsfe(&io___805); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 14, a__1[1] = "relativeaccid%"; - s_cat(ch__16, a__1, i__4, &c__2, (ftnlen)15); - do_fio(&c__1, ch__16, (ftnlen)15); +#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) { - s_wsfe(&io___796); +#line 13578 "" + s_wsfe(&io___806); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 9, a__1[1] = "bigaccid%"; - s_cat(ch__3, a__1, i__4, &c__2, (ftnlen)10); +#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. */ - s_wsfe(&io___798); +#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%"; - s_cat(ch__17, a__5, i__8, &c__8, (ftnlen)59); - do_fio(&c__1, ch__17, (ftnlen)59); +#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 */ - i__4[0] = lentemp, a__1[0] = tempq; - i__4[1] = 1, a__1[1] = all_1.sepsymq + (iiv - 1); - s_cat(tempq, a__1, i__4, &c__2, (ftnlen)24); +#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 "" } - s_wsfe(&io___801); +#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}%"; - s_cat(ch__18, a__6, i__9, &c__13, (ftnlen)70); - do_fio(&c__1, ch__18, lentemp + 46); +#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 */ - s_wsfe(&io___802); +#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"; - s_cat(ch__19, a__4, i__7, &c__6, (ftnlen)36); - do_fio(&c__1, ch__19, (ftnlen)36); +#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') { - s_wsfe(&io___803); +#line 13661 "" + s_wsfe(&io___813); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 10, a__1[1] = "Sluradjust"; - s_cat(ch__7, a__1, i__4, &c__2, (ftnlen)11); - do_fio(&c__1, ch__7, (ftnlen)11); +#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') { - s_wsfe(&io___804); +#line 13663 "" + s_wsfe(&io___814); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 9, a__1[1] = "Tieadjust"; - s_cat(ch__3, a__1, i__4, &c__2, (ftnlen)10); +#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') { - s_wsfe(&io___805); +#line 13665 "" + s_wsfe(&io___815); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 8, a__1[1] = "halfties"; - s_cat(ch__9, a__1, i__4, &c__2, (ftnlen)9); - do_fio(&c__1, ch__9, (ftnlen)9); +#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); - printl_("Default slur curvature advanced past HH" +#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') { - s_wsfe(&io___806); +#line 13677 "" + s_wsfe(&io___816); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 12, a__1[1] = "Nosluradjust"; - s_cat(ch__4, a__1, i__4, &c__2, (ftnlen)13); +#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') { - s_wsfe(&io___807); +#line 13679 "" + s_wsfe(&io___817); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 11, a__1[1] = "Notieadjust"; - s_cat(ch__2, a__1, i__4, &c__2, (ftnlen)12); +#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') { - s_wsfe(&io___808); +#line 13681 "" + s_wsfe(&io___818); /* Writing concatenation */ - i__4[0] = 1, a__1[0] = all_1.sq; - i__4[1] = 10, a__1[1] = "nohalfties"; - s_cat(ch__7, a__1, i__4, &c__2, (ftnlen)11); - do_fio(&c__1, ch__7, (ftnlen)11); +#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); - printl_("Default slur curvature decremented belo" +#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 pmax */ +/* 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, - &all_1.iv, (ftnlen)128); + (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, */ @@ -21170,7 +32738,9 @@ L77: /* 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) * @@ -21178,91 +32748,140 @@ L77: all_1.nnl[commvl_1.ivx - 1] + 1) * 24 - 25], &all_1.itsofar[ commvl_1.ivx - 1], &c__0, &c__0, &c__0, " ", &ndoub, (ftnlen) 128, (ftnlen)1); +#line 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_ */ @@ -21297,7 +32916,7 @@ L5: static real xofforn; /* Fortran I/O blocks */ - static cilist io___820 = { 0, 6, 0, 0, 0 }; + static cilist io___830 = { 0, 6, 0, 0, 0 }; @@ -21311,7 +32930,9 @@ L5: /* Bits 0-13: (stmgx+Tupf._), 14: Down fermata, was F, 15: Trill w/o "tr", was U */ /* 16-18 Editorial sharp, flat, natural "oes,f,n"; 19-20: >^, 21 ? for ed. accid. */ +#line 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) */ @@ -21321,217 +32942,356 @@ L5: /* 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 = 4194303 & *iornq; +/* 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 = i_indx("stmgx+Tupf._)e:XXX>^", charq, (ftnlen)20, (ftnlen)1); +/* 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 */ -/* Turn off repeated ornament ('o:'), Replicate bits 0-3,5-15,19-21 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 |= *iornq0 & 3735535; +/* 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) { - s_wsle(&io___820); +#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); - r__1 = xofforn * fnum; - comtrill_1.ornhshft[comtrill_1.nudorn - 1] = (real) i_nint(&r__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_ */ @@ -21567,9 +33327,9 @@ L5: static char lnholdq[128]; /* Fortran I/O blocks */ - static cilist io___826 = { 0, 6, 0, 0, 0 }; - static cilist io___827 = { 0, 15, 0, "()", 0 }; - static cilist io___831 = { 0, 18, 1, "(a)", 0 }; + 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 }; @@ -21592,229 +33352,410 @@ L5: /* 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); - s_wsle(&io___826); +#line 14220 "" + s_wsle(&io___836); +#line 14220 "" e_wsle(); - s_wsfe(&io___827); +#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) { - i__3 = s_rsfe(&io___831); +#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_ */ @@ -21833,10 +33774,12 @@ L3: /* 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); + 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, nline; + static integer i__, iv, ivi, ipos, nline; static char lineq[128]; static integer iinst, jinst; extern doublereal readin_(char *, integer *, integer *, ftnlen); @@ -21845,85 +33788,145 @@ L3: static integer iccount, nvsofar; /* Fortran I/O blocks */ - static cilist io___837 = { 0, 17, 0, "(a)", 0 }; + 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) { - s_wsfe(&io___837); +#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 */ @@ -21932,77 +33935,154 @@ L3: /* 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 "" } -/* Mext non-comment line has nv clef names */ +/* 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_ */ @@ -22026,34 +34106,55 @@ doublereal getsquez_(integer *n, integer *ntot, real *space, real *tnote, /* Since notes are ordered by increasing start times, as soon as we find one */ /* that starts too late, we are done checking. */ +#line 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_ */ @@ -22084,84 +34185,140 @@ L2: /* 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_ */ @@ -22178,44 +34335,75 @@ integer i1fnodur_(integer *idur, char *dotq, ftnlen dotq_len) extern /* Subroutine */ int stop1_(void); /* Fortran I/O blocks */ - static cilist io___856 = { 0, 6, 0, 0, 0 }; - static cilist io___857 = { 0, 6, 0, 0, 0 }; + 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 { - s_wsle(&io___856); +#line 14583 "" + s_wsle(&io___868); +#line 14583 "" e_wsle(); - s_wsle(&io___857); +#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_ */ @@ -22233,7 +34421,9 @@ integer iashft_(integer *nacc) /* System generated locals */ integer ret_val; +#line 14598 "" ret_val = ias[(0 + (0 + (*nacc - 1 << 2))) / 4]; +#line 14599 "" return ret_val; } /* iashft_ */ @@ -22248,39 +34438,67 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) /* Subroutine */ int s_stop(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___859 = { 0, 6, 0, 0, 0 }; + 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 { - s_wsle(&io___859); +#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_ */ @@ -22289,7 +34507,9 @@ 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_ */ @@ -22333,7 +34553,9 @@ integer igetbits_(integer *isdata, integer *iwidbit, integer *ishift) /* Extracts integer given by iwidbit bits of isdata, shifted by ishift, and */ /* then added to ioff */ +#line 14670 "" ret_val = pow_ii(&c__2, iwidbit) - 1 & lbit_shift(*isdata, -(*ishift)); +#line 14671 "" return ret_val; } /* igetbits_ */ @@ -22351,31 +34573,48 @@ integer igetvarlen_(shortint *mmidi, integer *icm, integer *imidi, integer * extern /* Subroutine */ int stop1_(void); /* Fortran I/O blocks */ - static cilist io___860 = { 0, 6, 0, 0, 0 }; + 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 "" } - s_wsle(&io___860); +#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_ */ @@ -22392,25 +34631,41 @@ logical isdotted_(integer *nodur, integer *ivx, integer *ip) /* Function returns true if note is dotted or double-dotted. */ /* Return false for any xtuplet. */ +#line 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; - ret_val = r_mod(&r__1, &c_b807) > comtol_1.tol; +#line 14710 "" + ret_val = r_mod(&r__1, &c_b814) > comtol_1.tol; +#line 14712 "" return ret_val; } /* isdotted_ */ @@ -22429,27 +34684,46 @@ integer isetvarlen_(integer *idur, integer *nbytes) static integer itemp; /* Fortran I/O blocks */ - static cilist io___862 = { 0, 6, 0, 0, 0 }; + 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 "" } - s_wsle(&io___862); +#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_ */ @@ -22474,41 +34748,75 @@ integer isetvarlen_(integer *idur, integer *nbytes) /* 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_ */ @@ -22517,13 +34825,21 @@ 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_ */ @@ -22540,28 +34856,45 @@ integer levrn_(integer *nolev, integer *irest, integer *iud, integer *ncm, /* Used for placing numbers in xtups. Returns note level if not a rest, */ /* else level of top or bottom of rest symbol opposite beam. iud=-1 for upstm. */ +#line 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_ */ @@ -22581,17 +34914,29 @@ integer lfmt1_(real *x) /* 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_ */ @@ -22628,7 +34973,7 @@ integer lfmt1_(real *x) static char notexq[128]; /* Fortran I/O blocks */ - static cilist io___884 = { 0, 11, 0, "(a)", 0 }; + static cilist io___896 = { 0, 11, 0, "(a)", 0 }; @@ -22642,173 +34987,301 @@ 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 */ +#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: */ @@ -22819,48 +35292,82 @@ L5: /* 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 */ @@ -22872,120 +35379,214 @@ L5: /* 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; - s_wsfe(&io___884); +#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_ */ @@ -23014,149 +35615,250 @@ L1: ftnlen); /* Fortran I/O blocks */ - static cilist io___888 = { 0, 6, 0, 0, 0 }; - static cilist io___889 = { 0, 6, 0, 0, 0 }; - static cilist io___890 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___891 = { 0, 11, 0, "(a)", 0 }; - static cilist io___892 = { 0, 16, 0, "(a)", 0 }; + 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) { - s_wsle(&io___888); +#line 15077 "" + s_wsle(&io___900); +#line 15077 "" e_wsle(); - s_wsle(&io___889); - do_lio(&c__9, &c__1, "Merged type-1 TeX strings longer than " +#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(); - s_wsfe(&io___890); - do_fio(&c__1, "Merged type-1 TeX strings longer than 128 cha" +#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) { - s_wsfe(&io___891); +#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. */ - s_wsfe(&io___892); +#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_ */ @@ -23165,12 +35867,19 @@ 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_ */ @@ -23187,7 +35896,9 @@ integer log2_(integer *n) /* 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_ */ @@ -23215,153 +35926,245 @@ integer log2_(integer *n) 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_ */ @@ -23384,44 +36187,73 @@ L12: /* This is called when (a) macro recording is just starting and */ /* (b) at the start of a new line, if recording is on */ +#line 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_ */ @@ -23462,124 +36294,190 @@ L12: static real t1xtup[20]; static integer nfbbar; static logical infbmx[24]; - static integer ifbnow[24], numnew; + static integer ifbnow[24]; static logical inxtup[24]; - static integer mapnow, nxtnow[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___937 = { 0, 6, 0, 0, 0 }; - static cilist io___938 = { 0, 6, 0, 0, 0 }; - static cilist io___939 = { 0, 15, 0, "(/a)", 0 }; + 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 + @@ -23588,96 +36486,156 @@ L12: /* 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 + @@ -23686,38 +36644,59 @@ L5: /* 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)) { @@ -23725,35 +36704,62 @@ L72: /* 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 */ @@ -23769,21 +36775,32 @@ L7: /* 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[ @@ -23805,115 +36822,192 @@ L9: /* 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 */ @@ -23933,96 +37027,163 @@ L15: /* 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 "" } - s_wsle(&io___937); +#line 15792 "" + s_wsle(&io___949); +#line 15792 "" e_wsle(); - s_wsle(&io___938); +#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(); - s_wsfe(&io___939); +#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 */ @@ -24030,6 +37191,7 @@ L85: /* 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, */ @@ -24038,57 +37200,88 @@ L85: /* * 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_ */ @@ -24097,15 +37290,16 @@ L81: 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[4], a__6[8], a__7[7]; - integer i__1, i__2, i__3[6], i__4[2], i__5[5], i__6[3], i__7, i__8[4], - i__9, i__10[8], i__11, i__12, i__13[7]; + 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[12], ch__4[1], ch__5[17], ch__6[16], - ch__7[11], ch__8[10], ch__9[44], ch__10[81], ch__11[113], ch__12[ - 3], ch__13[9], ch__14[129], ch__15[6], ch__16[5], ch__17[4], - ch__18[14], ch__19[22]; + 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 */ @@ -24133,8 +37327,7 @@ L81: ftnlen, ftnlen), midievent_(char *, integer *, integer *, ftnlen); static real stemshort; static integer ib, ig, il, in, ip, kv; - extern /* Subroutine */ int adjusteskz_(integer *, real *, integer *, - integer *, real *); + extern /* Subroutine */ int adjusteskz_(integer *, integer *, real *); static integer iib, icm, ing, len; static real esk, xnd; static integer ivf, iiv; @@ -24143,7 +37336,7 @@ L81: extern integer log2_(integer *); extern /* Subroutine */ int chkkbdrests_(integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, integer *, - integer *, integer *, integer *, real *, real *, 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 *); @@ -24191,8 +37384,7 @@ L81: static char notexq[79]; static logical stemup, beamon1[24]; static integer ibmcnt1[24], lnoten; - extern /* Subroutine */ int wsclef_(integer *, integer *, char *, integer - *, ftnlen); + extern /* Subroutine */ int wsclef_(integer *, integer *, integer *); static real eonsqz; extern /* Subroutine */ int precrd_(integer *, integer *, integer *, integer *, integer *, integer *, char *, logical *, integer *, @@ -24226,13 +37418,12 @@ L81: integer *, integer *, integer *, real *, char *, integer *, integer *, integer *, logical *, logical *, ftnlen, ftnlen), dotmov_(real *, real *, char *, integer *, integer *, ftnlen), - beamend_(char *, integer *, ftnlen), beamid_(char *, 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; - extern integer iashft_(integer *); static real ptsneed; extern /* Subroutine */ int clefsym_(integer *, char *, integer *, integer *, ftnlen); @@ -24244,49 +37435,54 @@ L81: extern /* Subroutine */ int putshft_(integer *, logical *, char *, integer *, ftnlen), setbits_(integer *, integer *, integer *, integer *); - static integer itright, nolevc, ivlast; + 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___959 = { 0, noteq, 0, "(1H{,i3,1H})", 5, 1 }; - static icilist io___961 = { 0, noteq, 0, "(1H{,i2,1H})", 4, 1 }; - static icilist io___962 = { 0, noteq, 0, "(i1)", 1, 1 }; - static cilist io___965 = { 0, 11, 0, "(a)", 0 }; - static cilist io___966 = { 0, 11, 0, "(a)", 0 }; - static cilist io___969 = { 0, 11, 0, "(a)", 0 }; - static icilist io___972 = { 0, soutq+8, 0, "(f4.1)", 4, 1 }; - static icilist io___973 = { 0, soutq+8, 0, "(f4.2)", 4, 1 }; - static icilist io___974 = { 0, soutq+10, 0, "(i2)", 2, 1 }; - static icilist io___975 = { 0, soutq+11, 0, "(i1)", 1, 1 }; - static cilist io___980 = { 0, 6, 0, 0, 0 }; - static cilist io___981 = { 0, 6, 0, 0, 0 }; - static cilist io___1001 = { 0, 6, 0, 0, 0 }; - static cilist io___1017 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1018 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1019 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1020 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1021 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1022 = { 0, 6, 0, 0, 0 }; - static cilist io___1023 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1024 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1025 = { 0, 11, 0, "(a)", 0 }; - static icilist io___1029 = { 0, notexq+11, 0, "(i2)", 2, 1 }; - static icilist io___1035 = { 0, notexq+6, 0, "(f3.1)", 3, 1 }; - static icilist io___1036 = { 0, notexq+6, 0, "(f4.1)", 4, 1 }; - static icilist io___1038 = { 0, notexq+5, 0, "(f3.1)", 3, 1 }; - static icilist io___1039 = { 0, notexq+5, 0, "(f4.1)", 4, 1 }; - static cilist io___1041 = { 0, 6, 0, 0, 0 }; - static cilist io___1042 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1043 = { 0, 11, 0, "(a)", 0 }; - static icilist io___1050 = { 0, notexq, 0, "(f4.2)", 79, 1 }; - static cilist io___1053 = { 0, 6, 0, 0, 0 }; - static cilist io___1066 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1069 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1072 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1074 = { 0, 11, 0, "(a)", 0 }; + 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 }; @@ -24295,196 +37491,416 @@ L81: /* 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) { - s_wsfi(&io___959); +#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) { - s_wsfi(&io___961); +#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 { - s_wsfi(&io___962); +#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) { - s_wsfe(&io___965); +#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) { - s_wsfe(&io___966); +#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; - wsclef_(&all_1.ivxo[in - 1], ninow, clefq + 1, &i__7, ( - ftnlen)1); +#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) { - s_wsfe(&io___969); +#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"; - s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12); - do_fio(&c__1, ch__3, (ftnlen)12); +#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) { - s_wsfi(&io___972); +#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) { - s_wsfi(&io___973); +#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); - s_wsfi(&io___974); +#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); - s_wsfi(&io___975); +#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*. */ @@ -24492,52 +37908,87 @@ L81: /* (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 "" } - s_wsle(&io___980); +#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(); - s_wsle(&io___981); +#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 */ @@ -24551,47 +38002,65 @@ L129: /* * .and. ibm1(ivx,ibmcnt(ivx)) .eq. ip) .or. */ /* * btest(nacc(ivx,ip),21)) then */ /* if (.not.btest(irest(ivx,ip),24)) then */ +#line 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); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx + ip * 24 - +#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__4, &c_false, & + 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); @@ -24600,6 +38069,7 @@ L129: /* !!! 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. */ @@ -24607,101 +38077,155 @@ L129: /* 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); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx + (ip - 1) * 24 +#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__4[0] == 'u'; + ,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. */ @@ -24709,42 +38233,71 @@ L117: /* 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 "" } - s_wsle(&io___1001); +#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. */ @@ -24752,87 +38305,146 @@ L123: /* spgr = total space needed (w/o main acc). */ /* Also, spgr is same for b4 or after, but xb4fac-space will be in diff. place. */ +#line 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, */ @@ -24843,27 +38455,38 @@ L123: /* 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 */ @@ -24873,719 +38496,1192 @@ L123: /* 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) { - adjusteskz_(&ib, &squez[1], &istart[1], &istop[1], & - comask_1.poenom); +#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) { - s_wsfe(&io___1017); -/* Writing concatenation */ - i__8[0] = 1, a__5[0] = all_1.sq; - i__8[1] = 7, a__5[1] = "advance"; - i__8[2] = 1, a__5[2] = all_1.sq; - i__8[3] = 8, a__5[3] = "barno-1%"; - s_cat(ch__5, a__5, i__8, &c__4, (ftnlen)17); - do_fio(&c__1, ch__5, (ftnlen)17); +#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) { - s_wsfe(&io___1018); +#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"; - s_cat(ch__6, a__2, i__4, &c__2, (ftnlen)16); - do_fio(&c__1, ch__6, (ftnlen)16); +#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) { - s_wsfe(&io___1019); +#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"; - s_cat(ch__7, a__2, i__4, &c__2, (ftnlen)11); - do_fio(&c__1, ch__7, (ftnlen)11); +#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) { - s_wsfe(&io___1020); +#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"; - s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12); - do_fio(&c__1, ch__3, (ftnlen)12); +#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) { - s_wsfe(&io___1021); +#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"; - s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)10); - do_fio(&c__1, ch__8, (ftnlen)10); +#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 { - s_wsle(&io___1022); - do_lio(&c__9, &c__1, "Unexpected mid-bar repeat command " +#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) { - s_wsfe(&io___1023); +#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; - chax_(ch__4, (ftnlen)1, &i__1); - i__6[1] = 1, a__4[1] = ch__4; +#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) { - s_wsfe(&io___1024); +#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%"; - s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12); - do_fio(&c__1, ch__3, (ftnlen)12); +#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) { - s_wsfe(&io___1025); +#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}%"; - s_cat(ch__9, a__1, i__3, &c__6, (ftnlen)44); - do_fio(&c__1, ch__9, (ftnlen)44); +#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"; - s_cat(ch__8, a__2, i__4, &c__2, (ftnlen)10); - addstr_(ch__8, &c__10, soutq, &lsout, (ftnlen)10, ( +#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); - s_wsfi(&io___1029); +#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] = "}"; - s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81); - i__9 = lchead + 1; - addstr_(ch__10, &i__9, soutq, &lsout, lchead + 1, (ftnlen) - 80); +#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 */ - i__10[0] = 1, a__6[0] = all_1.sq; - i__10[1] = 14, a__6[1] = "zcharnote{-6}{"; - i__10[2] = 1, a__6[2] = all_1.sq; - i__10[3] = 5, a__6[3] = "tempo"; - i__10[4] = 1, a__6[4] = all_1.sq; - i__10[5] = 10, a__6[5] = "kern-10pt "; - i__10[6] = lclow, a__6[6] = comhead_1.lowerq; - i__10[7] = 1, a__6[7] = "}"; - s_cat(ch__11, a__6, i__10, &c__8, (ftnlen)113); - i__9 = lclow + 33; - addstr_(ch__11, &i__9, soutq, &lsout, lclow + 33, (ftnlen) - 80); +#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. */ - i__9 = istop[ib]; - for (all_1.jn = istart[ib]; all_1.jn <= i__9; ++all_1.jn) { +#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"; - s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)3); - addstr_(ch__12, &c__3, soutq, &lsout, (ftnlen)3, ( +#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 "; - s_cat(ch__13, a__2, i__4, &c__2, (ftnlen)9); - addstr_(ch__13, &c__9, soutq, &lsout, (ftnlen)9, ( +#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) { - s_wsfi(&io___1035); +#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 { - s_wsfi(&io___1036); +#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) { - s_wsfi(&io___1038); +#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 { - s_wsfi(&io___1039); +#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)) { - i__11 = comgrace_1.nlit; - for (il = 1; il <= i__11; ++il) { +#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 "" } - s_wsle(&io___1041); - do_lio(&c__9, &c__1, "Problem finding index for lite" +#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) { - s_wsfe(&io___1042); +#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] = "%"; - s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81); - do_fio(&c__1, ch__10, lsout + 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) { - s_wsfe(&io___1043); +#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] = "%"; - s_cat(ch__14, a__2, i__4, &c__2, (ftnlen)129); - do_fio(&c__1, ch__14, comgrace_1.lenlit[il - +#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), */ - i__11 = ncmid_(&all_1.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__11, soutq, & + 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.iornq, 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, + 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); + 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{"; - s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6); - addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen) +#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{"; - s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6); - addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen) +#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[ @@ -25594,48 +39690,63 @@ L125: all_1.ulq + (commvl_1.ivx + all_1.ibmcnt[ commvl_1.ivx - 1] * 24 - 25), &c_true, & icashft, (ftnlen)1); +#line 16791 "" } else { - i__11 = ncmid_(&all_1.iv, &ip); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx - + ip * 24 - 25], &i__11, &all_1.islur[ +#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__4, &c_true, &icashft, (ftnlen)1); + 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 */ - i__11 = ncmid_(&all_1.iv, &ip); +#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__11, soutq, &lsout, all_1.ulq + ( + 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 - @@ -25646,17 +39757,20 @@ L125: - 25] - 1], &all_1.nacc[commvl_1.ivx + ip * 24 - 25], (ftnlen)80, (ftnlen) 1); +#line 16817 "" } else { /* Postscript slurs */ - i__11 = ncmid_(&all_1.iv, &ip); +#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__11, soutq, &lsout, + - 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 * @@ -25667,21 +39781,33 @@ L125: 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 @@ -25690,16 +39816,20 @@ L125: /* Place grace now if (a) Way-after from prev note and ip>1 or (b) Pre-grace */ /* on current note. Do A-grace on current note, and W-grace at barend, later. */ +#line 16843 "" if (isgrace) { - i__11 = ncmid_(&all_1.iv, &ip); +#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__11, &all_1.nacc[ + &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__12, + 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 @@ -25709,155 +39839,235 @@ L125: 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. */ - i__11 = ncmid_(&all_1.iv, &ip); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[ +#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__11, &all_1.islur[ + &i__12, &all_1.islur[ commvl_1.ivx + ip * 24 - 25], &commvl_1.nvmx[all_1.iv - 1], &commvl_1.ivx, &all_1.nv); - stemup = *(unsigned char *)&ch__4[0] +#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]; - i__11 = ncmid_(&all_1.iv, &ip); +#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__11, soutq, &lsout, & + 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) */ - i__11 = 16777215 - comslur_1.listslur; - comslur_1.ndxslur = log2_(&i__11); +#line 16882 "" + i__12 = 16777215 - comslur_1.listslur; +#line 16882 "" + comslur_1.ndxslur = log2_(&i__12); /* Get note name */ - i__11 = ncmid_(&all_1.iv, &ip); +#line 16886 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 16886 "" notefq_(noteq, &lnoten, &all_1.nolev[commvl_1.ivx - + ip * 24 - 25], &i__11, (ftnlen)8); + + 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]) { - i__11 = ncmid_(&all_1.iv, &ip); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[ - commvl_1.ivx + ip * 24 - 25], &i__11, +#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); - if (*(unsigned char *)&ch__4[0] == 'u') { +#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; - i__11 = 71 - comslur_1.ndxslur; - chax_(ch__4, (ftnlen)1, &i__11); - i__5[3] = 1, a__3[3] = ch__4; +#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); - i__11 = lnoten + 8; - addstr_(notexq, &i__11, soutq, &lsout, ( +#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 */ - i__13[0] = 1, a__7[0] = all_1.sq; - i__13[1] = 5, a__7[1] = "islur"; - i__13[2] = 1, a__7[2] = slurudq; - i__13[3] = 2, a__7[3] = "{1"; - i__11 = 61 - comslur_1.ndxslur; - chax_(ch__4, (ftnlen)1, &i__11); - i__13[4] = 1, a__7[4] = ch__4; - i__13[5] = 1, a__7[5] = "}"; - i__13[6] = lnoten, a__7[6] = noteq; - s_cat(notexq, a__7, i__13, &c__7, (ftnlen)79); - i__11 = lnoten + 11; - addstr_(notexq, &i__11, soutq, &lsout, ( +#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 */ - i__13[0] = 1, a__7[0] = all_1.sq; - i__13[1] = 5, a__7[1] = "islur"; - i__13[2] = 1, a__7[2] = slurudq; - i__13[3] = 2, a__7[3] = "{2"; - i__11 = 51 - comslur_1.ndxslur; - chax_(ch__4, (ftnlen)1, &i__11); - i__13[4] = 1, a__7[4] = ch__4; - i__13[5] = 1, a__7[5] = "}"; - i__13[6] = lnoten, a__7[6] = noteq; - s_cat(notexq, a__7, i__13, &c__7, (ftnlen)79); - i__11 = lnoten + 11; - addstr_(notexq, &i__11, soutq, &lsout, ( +#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)) { - i__11 = ncmid_(&all_1.iv, &ip); +#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__11, &all_1.ipl[ + + 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[ @@ -25865,10 +40075,12 @@ L125: commvl_1.ivx - 1], ihornb, nornb, all_1.ulq, & all_1.ibmcnt[commvl_1.ivx - 1], &L__1, soutq, &lsout, (ftnlen)1, (ftnlen)80); +#line 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 */ @@ -25877,21 +40089,31 @@ L125: /* 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 "" } - i__11 = ncmid_(&all_1.iv, &ip); +#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); - docrd_(&commvl_1.ivx, &ip, &nodu, &i__11, &all_1.iv, & +#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], @@ -25900,20 +40122,27 @@ L125: 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) { - i__11 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] + +#line 16961 "" + i__12 = all_1.nolev[commvl_1.ivx + ip * 24 - 25] + commvel_1.miditran[cominsttrans_1.instno[ all_1.iv - 1] - 1]; - i__12 = all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7; +#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); - addmidi_(&icm, &i__11, &i__12, &commidisig_1.midisig, +#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)), */ @@ -25921,115 +40150,162 @@ L125: /* 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] & - 4194287) > 0; + 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. */ - i__11 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - +#line 16991 "" + i__12 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - 25]); - if (pow_ii(&c__2, &i__11) != all_1.nodur[commvl_1.ivx +#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 "" } - i__11 = ncmid_(&all_1.iv, &ip); +#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__11, &all_1.islur[ + - 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 */ - i__11 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 +#line 17041 "" + i__12 = igetbits_(&all_1.nacc[commvl_1.ivx + ip * 24 - 25], &c__6, &c__4); - i__12 = ncmid_(&all_1.iv, &ip); +#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); - doacc_(&ihshft, &i__11, notexq, &lnote, &all_1.nacc[ +#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__12, &L__1, ( + 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: */ @@ -26040,172 +40316,240 @@ L30: /* . 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) { - i__11 = log2_(&all_1.nodur[commvl_1.ivx + ip * 24 - +#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__11) != + 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 */ - i__11 = igetbits_(&all_1.islur[commvl_1.ivx + +#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__11, (ftnlen)80); + 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]; - i__11 = igetbits_(&all_1.islur[commvl_1.ivx + ip * 24 +#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__11, (ftnlen) + 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{"; - s_cat(ch__3, a__2, i__4, &c__2, (ftnlen)12); - addstr_(ch__3, &c__12, soutq, &lsout, (ftnlen)12, ( +#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); - s_wsfi(&io___1050); +#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] = "}"; - s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)5); - addstr_(ch__16, &c__5, soutq, &lsout, (ftnlen)5, ( +#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}"; - s_cat(ch__5, a__2, i__4, &c__2, (ftnlen)17); - addstr_(ch__5, &c__17, soutq, &lsout, (ftnlen)17, +#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.iornq, 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, + 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); + 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.iornq, 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, + 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); + 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 && @@ -26216,12 +40560,18 @@ L30: /* 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. */ @@ -26232,6 +40582,7 @@ L30: /* 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) @@ -26326,58 +40677,84 @@ L30: /* The new subroutine call, to replace above code */ +#line 17276 "" chkkbdrests_(&ip, &all_1.iv, &commvl_1.ivx, - all_1.nn, all_1.iornq, 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, + 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); + comkbdrests_1.levbotr, all_1.mult, + all_1.ipl); +/* * mult) */ +#line 17280 "" } -/* L2: */ +/* 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{"; - s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6); - addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen)6, ( +#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{"; - s_cat(ch__15, a__2, i__4, &c__2, (ftnlen)6); - addstr_(ch__15, &c__6, soutq, &lsout, (ftnlen)6, ( +#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 */ @@ -26385,200 +40762,307 @@ L30: /* rq'd, convert GW to GA. Therefore GW at end of bar never needs extra sp. */ /* But will still need to add extra space as hardspace. */ +#line 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))) { - i__11 = comgrace_1.ngrace; - for (ig = 1; ig <= i__11; ++ig) { +#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 "" } - s_wsle(&io___1053); - do_lio(&c__9, &c__1, "Problem finding grace index " +#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; - i__11 = comnsp_2.nb; - for (iib = ib; iib <= i__11; ++iib) { +#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; - i__11 = comgrace_1.nng[ig - 1]; - for (ing = 1; ing <= i__11; ++ing) { +#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)) { - i__11 = ncmid_(&all_1.iv, &ip); +#line 17362 "" + i__12 = ncmid_(&all_1.iv, &ip); +#line 17362 "" dograce_(&commvl_1.ivx, &ip, ptgr, soutq, &lsout, & - i__11, &all_1.nacc[commvl_1.ivx + ip * 24 - + 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. */ - i__9 = ncmid_(&all_1.iv, &ip); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[commvl_1.ivx - + ip * 24 - 25], &i__9, &all_1.islur[ +#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__4[0] == + - 25],0) && *(unsigned char *)&ch__6[0] == 'u' || isdotted_(all_1.nodur, & commvl_1.ivx, &ip)) { /* Upstem non-rest, or dotted */ /* Computing MAX */ - i__9 = 1, i__11 = numbms[commvl_1.ivx]; +#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__9, - i__11) * 24 - 25] && ! isdotted_( + 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) */ { - i__9 = ncmid_(&all_1.iv, &ip); - udqq_(ch__4, (ftnlen)1, &all_1.nolev[ - commvl_1.ivx + ip * 24 - 25], &i__9, & - all_1.islur[commvl_1.ivx + ip * 24 - +#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__4[0] == 'u') { + 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 */ @@ -26590,65 +41074,103 @@ L17: /* c Old old lbacc(icm) = iand(nacc(ivx,ip),7) */ /* New old if (lbacc(icm).eq.0) lbacc(icm) = iand(nacc(ivx,ip),7) */ +#line 17451 "" if ((all_1.nacc[commvl_1.ivx + ip * 24 - 25] & 7) > 0) { /* Explicit accidental on last main note in bar */ - i__9 = comslm_1.naccbl[icm]; - for (kacc = 1; kacc <= i__9; ++kacc) { +#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]; - i__9 = all_1.nacc[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__9); + 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) { - i__9 = comtrill_1.icrd2; - for (icrd = comtrill_1.icrd1; icrd <= i__9; +#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); - i__11 = comslm_1.naccbl[icm]; - for (kacc = 1; kacc <= i__11; ++kacc) { +#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 */ - i__9 = commidi_1.naccim[icm]; - for (kacc = 1; kacc <= i__9; ++kacc) { +#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 */ @@ -26656,126 +41178,205 @@ L59: /* explicit action from just above. Assuming any accid on last note in bar, */ /* either explicit or implicit, has same effect on 1st note of next bar. */ +#line 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)) { - i__11 = comtrill_1.icrd2; - for (icrd = comtrill_1.icrd1; icrd <= i__11; +#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. */ - i__11 = comslm_1.naccbl[icm]; - for (macc = 1; macc <= i__11; ++macc) { +#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"; - s_cat(ch__12, a__2, i__4, &c__2, (ftnlen)3); - addstr_(ch__12, &c__3, soutq, &lsout, (ftnlen)3, (ftnlen)80); +#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) { - s_wsfe(&io___1066); +#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] = "%"; - s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81); - do_fio(&c__1, ch__10, lsout + 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, & @@ -26786,225 +41387,361 @@ L65: 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%"; - s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)4); - addstr_(ch__17, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80); +#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) { - s_wsfe(&io___1069); +#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 */ -/* if (ibar .eq. ibarmbr) then */ +#line 17575 "" if (all_1.ibar == comgrace_1.ibarmbr && comlast_1.islast) { -/* call addstr(sq//'def'//sq//'atnextbar{'//sq//'znotes'//sq// */ -/* * 'mbrest{',30,soutq,lsout) */ -/* ndig = int(alog10(mbrest+.01))+1 */ -/* write(soutq(31:33),'(i'//chax(48+ndig)//')')mbrest */ -/* lsout = lsout+ndig */ -/* call addstr('}{',2,soutq,lsout) */ -/* mtrspc = .5+xb4mbr */ -/* xb4mbr = 0. */ -/* if (mtrspc .eq. 0) then */ -/* ndig = 1 */ -/* else */ -/* ndig = int(alog10(mtrspc+.01))+1 */ -/* end if */ -/* write(soutq(lsout+1:lsout+2),'(i'//chax(48+ndig)//')')mtrspc */ -/* lsout = lsout+ndig */ -/* call addstr('}0'//sq//'en}%',7,soutq,lsout) */ -/* if (islast) write(11,'(a)')soutq(1:lsout) */ -/* lsout = 0 */ -/* ndig = int(alog10(mbrest-1+.01))+1 */ -/* if (mbrest.eq.1) ndig=1 */ -/* if (islast) write(11,'(a14,i'//chax(48+ndig)//',a1)') */ -/* * sq//'advance'//sq//'barno',mbrest-1,'%' */ -/* ++ */ /* 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; - mtrspc = comgrace_1.xb4mbr + .5f; +#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}%"; - s_cat(ch__16, a__2, i__4, &c__2, (ftnlen)5); - addstr_(ch__16, &c__5, soutq, &lsout, (ftnlen)5, (ftnlen)80); - s_wsfe(&io___1072); +#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; - chax_(ch__4, (ftnlen)1, &i__7); - i__6[1] = 1, a__4[1] = ch__4; +#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)"; - ci__1.cifmt = (s_cat(ch__7, a__4, i__6, &c__3, (ftnlen)11), ch__7) +#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 */ - i__8[0] = 1, a__5[0] = all_1.sq; - i__8[1] = 7, a__5[1] = "advance"; - i__8[2] = 1, a__5[2] = all_1.sq; - i__8[3] = 5, a__5[3] = "barno"; - s_cat(ch__18, a__5, i__8, &c__4, (ftnlen)14); - do_fio(&c__1, ch__18, (ftnlen)14); +#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 */ - -/* Writing concatenation */ +/* 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"; - s_cat(ch__19, a__1, i__3, &c__6, (ftnlen)22); - addstr_(ch__19, &c__22, soutq, &lsout, (ftnlen)22, (ftnlen)80); +#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]) { - if (lnote == 0) { /* Writing concatenation */ - i__4[0] = 1, a__2[0] = all_1.sq; - i__4[1] = 10, a__2[1] = "centerbar{"; - s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); - lnote = 11; - } +#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 "" } -/* Writing concatenation */ - i__4[0] = lnote, a__2[0] = notexq; - i__4[1] = lcwr[commvl_1.ivx - 1], a__2[1] = cwrq + ( - commvl_1.ivx - 1) * 79; - s_cat(notexq, a__2, i__4, &c__2, (ftnlen)79); - lnote += lcwr[commvl_1.ivx - 1]; +#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 */ -/* notexq = notexq(1:lnote) */ -/* * //sq//'fermataup7'//cwrq(ivx)(1:lcwr(ivx)) */ -/* lnote = lnote+11+lcwr(ivx) */ - /* Writing concatenation */ - i__3[0] = lnote, a__1[0] = notexq; - i__3[1] = 1, a__1[1] = all_1.sq; - i__3[2] = 13, a__1[2] = "loffset{.39}{"; - i__3[3] = 1, a__1[3] = all_1.sq; - i__3[4] = 11, a__1[4] = "fermataup7}"; - i__3[5] = lcwr[commvl_1.ivx - 1], a__1[5] = cwrq + ( +#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; - s_cat(notexq, a__1, i__3, &c__6, (ftnlen)79); - lnote = lnote + 26 + lcwr[commvl_1.ivx - 1]; +#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 "" } - if (lnote > 0) { -/* Writing concatenation */ - i__4[0] = lnote, a__2[0] = notexq; - i__4[1] = 1, a__2[1] = "}"; - s_cat(ch__1, a__2, i__4, &c__2, (ftnlen)80); - i__2 = lnote + 1; - addstr_(ch__1, &i__2, soutq, &lsout, lnote + 1, (ftnlen)80); - } +#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 */ - i__4[0] = 1, a__2[0] = all_1.sq; - i__4[1] = 3, a__2[1] = "en}"; - s_cat(ch__17, a__2, i__4, &c__2, (ftnlen)4); - addstr_(ch__17, &c__4, soutq, &lsout, (ftnlen)4, (ftnlen)80); - if (comlast_1.islast && lsout > 0) { - s_wsfe(&io___1074); -/* Writing concatenation */ - i__4[0] = lsout, a__2[0] = soutq; - i__4[1] = 1, a__2[1] = "%"; - s_cat(ch__10, a__2, i__4, &c__2, (ftnlen)81); - do_fio(&c__1, ch__10, lsout + 1); - e_wsfe(); +#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 */ @@ -27012,34 +41749,52 @@ L65: /* If at end of block, save durations of last notes in bar, for possible use */ /* if clef changes at start of next bar */ +#line 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]; -/* prevtn(ivx) = tnote(iand(ipl(ivx,nn(ivx)),255)) */ +#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_ */ @@ -27103,106 +41858,187 @@ L65: /* 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 */ @@ -27217,130 +42053,198 @@ L7: /* 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 */ @@ -27351,6 +42255,7 @@ L15: /* write(*,'(16f5.1)')(space(ib),ib=1,nb) */ /* write(*,'(16f5.1)')(squez(ib),ib=1,nb) */ +#line 17926 "" return 0; } /* makeabar_ */ @@ -27373,89 +42278,136 @@ L15: static integer nbytes, misperq; /* Fortran I/O blocks */ - static cilist io___1098 = { 0, 6, 0, 0, 0 }; + 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 { - s_wsle(&io___1098); +#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_ */ @@ -27474,32 +42426,55 @@ L15: static integer lenout; /* Fortran I/O blocks */ - static cilist io___1099 = { 0, 0, 1, "(a)", 0 }; - static cilist io___1102 = { 0, 0, 0, "(a)", 0 }; + static cilist io___1114 = { 0, 0, 1, "(a)", 0 }; + static cilist io___1117 = { 0, 0, 0, "(a)", 0 }; +#line 17998 "" *done = FALSE_; - io___1099.ciunit = *iuin; - i__1 = s_rsfe(&io___1099); +#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); - io___1102.ciunit = *iuout; - s_wsfe(&io___1102); +#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_ */ @@ -27519,34 +42494,55 @@ L1: /* This is called when (a) macro recording is just starting and */ /* (b) at the start of a new line, if recording is on */ +#line 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_ */ @@ -27565,25 +42561,42 @@ integer ncmid_(integer *iv, integer *ip) static real xtime; /* Fortran I/O blocks */ - static cilist io___1105 = { 0, 6, 0, 0, 0 }; + 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 "" } - s_wsle(&io___1105); +#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_ */ @@ -27615,8 +42628,21 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* else */ /* ncmidf = 23 */ /* end if */ - ret_val = (i_indx(" b6r5n4a3m2s1t0f7", clefq, (ftnlen)17, (ftnlen)1) / 2 - << 1) + 21; +#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_ */ @@ -27626,33 +42652,60 @@ integer ncmidf_(char *clefq, 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_ */ @@ -27679,66 +42732,118 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* 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_ */ @@ -27781,288 +42886,496 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) static integer lnoten; /* Fortran I/O blocks */ - static icilist io___1124 = { 0, noteq, 0, "(i2)", 2, 1 }; - static icilist io___1128 = { 0, numq, 0, "(i2)", 2, 1 }; - static icilist io___1129 = { 0, noteq+1, 0, "(i2)", 2, 1 }; - static icilist io___1130 = { 0, noteq+1, 0, "(i3)", 3, 1 }; + 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 */ @@ -28078,41 +43391,72 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* 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 { - s_wsfi(&io___1124); +#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 */ @@ -28122,234 +43466,406 @@ integer ncmidf_(char *clefq, ftnlen clefq_len) /* 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) { - s_wsfi(&io___1128); +#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) { - s_wsfi(&io___1129); +#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 { - s_wsfi(&io___1130); +#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_ */ @@ -28376,56 +43892,98 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* 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_ */ @@ -28452,32 +44010,56 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* 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 */ @@ -28485,21 +44067,36 @@ integer ntindex_(char *line, char *s2q, integer *lenline, ftnlen line_len, /* 5/25/08 Allow >12 */ /* call istring(mod(iv,12),tempq,len) */ +#line 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_ */ @@ -28512,16 +44109,32 @@ integer numclef_(char *clefq, ftnlen clefq_len) integer i_indx(char *, char *, ftnlen, ftnlen); -/* Returns the number to be used as argument of \setclef (for MusiXTeX only) */ -/* if (ichar(clefq) .lt. 55) then */ - if (*(unsigned char *)clefq <= 55) { +/* 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 (ret_val == 7) { - ret_val = 9; - } +/* 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_ */ @@ -28543,65 +44156,121 @@ integer numclef_(char *clefq, ftnlen clefq_len) 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_ */ @@ -28692,32 +44361,32 @@ integer numclef_(char *clefq, ftnlen clefq_len) static integer instnow, nsystpp; /* Fortran I/O blocks */ - static cilist io___1143 = { 0, 6, 0, 0, 0 }; - static cilist io___1144 = { 0, 6, 0, 0, 0 }; - static cilist io___1145 = { 0, 15, 0, "(a)", 0 }; - static cilist io___1146 = { 0, 19, 0, "(i6)", 0 }; static cilist io___1158 = { 0, 6, 0, 0, 0 }; - static cilist io___1162 = { 0, 6, 0, 0, 0 }; - static cilist io___1168 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1169 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1174 = { 0, 6, 0, 0, 0 }; - static cilist io___1176 = { 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___1178 = { 0, 6, 0, 0, 0 }; - static cilist io___1179 = { 0, 15, 0, "(a,2i5)", 0 }; - static cilist io___1180 = { 0, 15, 0, "(a)", 0 }; - static cilist io___1182 = { 0, 12, 0, "(a)", 0 }; - static cilist io___1183 = { 0, 12, 0, 0, 0 }; - static cilist io___1184 = { 0, 12, 0, "(6f10.5/f10.5,3i5)", 0 }; - static cilist io___1185 = { 0, 12, 0, 0, 0 }; - static cilist io___1204 = { 0, 12, 0, 0, 0 }; - static cilist io___1219 = { 0, 12, 0, "(i5)", 0 }; - static cilist io___1237 = { 0, 12, 0, "(1pe12.5/i5,5e12.3)", 0 }; - static cilist io___1238 = { 0, 13, 0, "(i5)", 0 }; - static cilist io___1239 = { 0, 6, 0, "(/,a)", 0 }; - static cilist io___1240 = { 0, 6, 0, 0, 0 }; - static cilist io___1241 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___1242 = { 0, 15, 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 */ @@ -28749,196 +44418,357 @@ integer numclef_(char *clefq, ftnlen clefq_len) /* 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)) { - s_wsle(&io___1143); +#line 18752 "" + s_wsle(&io___1158); +#line 18752 "" e_wsle(); - s_wsle(&io___1144); +#line 18753 "" + s_wsle(&io___1159); +#line 18753 "" do_lio(&c__9, &c__1, "Starting first PMX pass", (ftnlen)23); +#line 18753 "" e_wsle(); - s_wsfe(&io___1145); +#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); - s_wsfe(&io___1146); +#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) { - s_wsle(&io___1158); +#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) { - s_wsle(&io___1162); - do_lio(&c__9, &c__1, "Sorry, cannot optimize if there is a pmx.mod f" +#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_; - c1omnotes_1.gotclef = 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; -/* L3: */ +#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. */ @@ -28946,293 +44776,525 @@ L2: /* 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)) { - s_wsfe(&io___1168); +#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(); - s_wsfe(&io___1169); +#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) { - s_wsle(&io___1174); - do_lio(&c__9, &c__1, "When npages=0, must set nsyst=bars/syst, n" +#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) { - s_wsle(&io___1176); +#line 18998 "" + s_wsle(&io___1191); +#line 18998 "" e_wsle(); - s_wsle(&io___1177); +#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(); - s_wsle(&io___1178); +#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(); - s_wsfe(&io___1179); +#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(); - s_wsfe(&io___1180); +#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); - s_wsfe(&io___1182); +#line 19016 "" + s_wsfe(&io___1197); +#line 19016 "" do_fio(&c__1, basenameq, (*lbase)); +#line 19016 "" e_wsfe(); - s_wsle(&io___1183); +#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. */ - s_wsfe(&io___1184); +#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(); - s_wsle(&io___1185); +#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__); @@ -29261,335 +45323,574 @@ L20: /* Only the first page will get local adjustment now if needed, others in pmxb */ +#line 19107 "" if (ifpb == 1 && ipage == 1 && compage_1.fintstf > 0.f) { +#line 19108 "" facins = compage_1.fintstf; +#line 19109 "" compage_1.fintstf = -1.f; +#line 19110 "" } else { /* gintstf = 1.0 by default, but may be changed with AI<x> */ +#line 19114 "" facins = compage_1.gintstf; +#line 19115 "" } - s_wsle(&io___1204); +#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; - s_wsfe(&io___1219); +#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 "" } - s_wsfe(&io___1237); +#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); - s_wsfe(&io___1238); +#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)) { - s_wsfe(&io___1239); +#line 19332 "" + s_wsfe(&io___1254); +#line 19332 "" do_fio(&c__1, " Done with first pass", (ftnlen)21); +#line 19332 "" e_wsfe(); - s_wsle(&io___1240); +#line 19333 "" + s_wsle(&io___1255); +#line 19333 "" e_wsle(); - s_wsfe(&io___1241); +#line 19334 "" + s_wsfe(&io___1256); +#line 19334 "" do_fio(&c__1, " Done with first pass", (ftnlen)21); +#line 19334 "" e_wsfe(); - s_wsfe(&io___1242); +#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_ */ @@ -29598,19 +45899,18 @@ L1: { /* 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[5], a__9[2], a__10[8], a__11[14]; + 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[5], i__12[2], i__13, i__14[8], i__15[14] + 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[12], ch__14[15], ch__15[13], ch__16[9], ch__17[11], - ch__18[32], ch__19[10], ch__20[4], ch__21[16], ch__22[33], ch__23[ - 18], ch__24[82], ch__25[66], ch__26[60], ch__27[45], ch__28[6], - ch__29[17], 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]; + 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; @@ -29634,7 +45934,7 @@ L1: f_clos(cllist *), f_rew(alist *); /* Local variables */ - static integer nbarss; + static integer islnow, iplnow, lvoltxt, nbarss; static real elsktot; static integer ndigbn, indsym; extern /* Subroutine */ int wgmeter_(integer *, integer *); @@ -29659,7 +45959,7 @@ L1: extern /* Subroutine */ int setmeter_(integer *, integer *, integer *, integer *), puttitle_(integer *, real *, real *, char *, real *, real *, real *, integer *, logical *, char *, ftnlen, ftnlen); - static integer iornqnow, i__; + static integer i__; static char basenameq[44], pathnameq[40]; extern /* Subroutine */ int midievent_(char *, integer *, integer *, ftnlen); @@ -29713,17 +46013,16 @@ L1: integer *, integer *, integer *, real *, integer *, integer *, integer *, real *, logical *, char *, char *, char *, char *, integer *, integer *, ftnlen, ftnlen, ftnlen, ftnlen); - static integer noinst; static logical istype0; - static integer npages, ibcoff, ibmrep, nhstot, jprntb, nhssys; + static integer noinst, npages, ibcoff, ibmrep, nhstot, jprntb, nhssys, + lenbeat; extern /* Subroutine */ int addmidi_(integer *, integer *, integer *, - integer *, real *, logical *, logical *); - static integer lenbeat; - extern /* Subroutine */ int outbar_(integer *, integer *); - static real ptsndb, ptsndv; - extern /* Subroutine */ int wsclef_(integer *, integer *, char *, integer - *, ftnlen), topfile_(char *, integer *, integer *, char *, - integer *, integer *, real *, integer *, integer *, logical *, + 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; @@ -29731,127 +46030,131 @@ L1: extern integer ifnodur_(integer *, char *, ftnlen); static integer isystpg; extern /* Subroutine */ int getnote_(logical *); - static real ptsdflt; + static real ptsndv, ptsdflt; extern /* Subroutine */ int clefsym_(integer *, char *, integer *, - integer *, ftnlen); - static integer islnow, lvoltxt; + integer *, ftnlen), wsclef_(integer *, integer *, integer *); static real xnsttop[40]; - static integer iplnow; + static integer nvalue; /* Fortran I/O blocks */ - static cilist io___1243 = { 0, 6, 0, 0, 0 }; - static cilist io___1244 = { 0, 6, 0, 0, 0 }; - static cilist io___1245 = { 0, 6, 0, 0, 0 }; - static cilist io___1246 = { 0, 15, 0, "(a)", 0 }; - static cilist io___1249 = { 0, 12, 0, "(a)", 0 }; - static cilist io___1251 = { 0, 12, 0, 0, 0 }; - static cilist io___1253 = { 0, 12, 0, 0, 0 }; - static cilist io___1269 = { 0, 6, 0, 0, 0 }; - static cilist io___1270 = { 0, 12, 0, 0, 0 }; - static cilist io___1276 = { 0, 13, 0, 0, 0 }; - static cilist io___1278 = { 0, 14, 0, "(a)", 0 }; - static cilist io___1281 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1282 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1283 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1286 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1296 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1298 = { 0, 6, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1299 = { 0, 15, 0, "(/,a20,i4,a1,i4)", 0 }; - static cilist io___1303 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1304 = { 0, 11, 0, "(a14,f4.1,a)", 0 }; - static cilist io___1313 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1322 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1323 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1324 = { 0, 12, 0, 0, 0 }; - static cilist io___1327 = { 0, 6, 0, 0, 0 }; - static cilist io___1328 = { 0, 6, 0, 0, 0 }; - static cilist io___1331 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1332 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1333 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1334 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1335 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1336 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1339 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1340 = { 0, 11, 0, "(a)", 0 }; + 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___1343 = { 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, 12, 0, 0, 0 }; - static cilist io___1356 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a4)", 0 }; - static cilist io___1359 = { 0, 11, 0, fmtq, 0 }; - static cilist io___1361 = { 0, 6, 0, 0, 0 }; - static cilist io___1362 = { 0, 6, 0, 0, 0 }; - static cilist io___1363 = { 0, 11, 0, "(a)", 0 }; - static icilist io___1366 = { 0, nmq+12, 0, "(2i1)", 2, 1 }; - static icilist io___1367 = { 0, nmq+12, 0, "(a1,i2,a1,i1)", 5, 1 }; - static cilist io___1368 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1369 = { 0, 11, 0, "(a18,i1,a2)", 0 }; - static cilist io___1370 = { 0, 11, 0, "(a18,i2,a2)", 0 }; - static cilist io___1372 = { 0, 11, 0, "(a11,i1,a2)", 0 }; - static cilist io___1373 = { 0, 11, 0, "(a11,i2,a2)", 0 }; - static cilist io___1374 = { 0, 11, 0, "(a11,i3,a2)", 0 }; - static cilist io___1376 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1377 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1378 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1379 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1380 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1381 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1383 = { 0, 11, 0, fmtq, 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 cilist io___1385 = { 0, 11, 0, fmtq, 0 }; - static cilist io___1386 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1387 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1388 = { 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, "(a)", 0 }; - static cilist io___1391 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1392 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1393 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1394 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1395 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1396 = { 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___1403 = { 0, 11, 0, "(a16,i1,a14)", 0 }; - static cilist io___1404 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1405 = { 0, 12, 1, 0, 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,2i1,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___1443 = { 0, 11, 0, "(a11,f5.1,a4)", 0 }; - static cilist io___1444 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1445 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1446 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1447 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1448 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1449 = { 0, 6, 0, 0, 0 }; - static cilist io___1450 = { 0, 6, 0, 0, 0 }; - static cilist io___1451 = { 0, 15, 0, 0, 0 }; - static cilist io___1452 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1453 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1454 = { 0, 11, 0, fmtq, 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___1457 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1458 = { 0, 14, 0, "(a9,i2,a10,i2,1x,a5)", 0 }; - static cilist io___1459 = { 0, 6, 0, 0, 0 }; - static cilist io___1460 = { 0, 6, 0, 0, 0 }; - static cilist io___1461 = { 0, 6, 0, 0, 0 }; - static cilist io___1462 = { 0, 15, 0, "(/,a)", 0 }; - static cilist io___1463 = { 0, 15, 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 */ @@ -29998,7 +46301,12 @@ L1: /* c ipl cc */ /* cccccccccccc */ /* c 0-7 Location in list [0,200] */ -/* 0-7 Unused */ +/* 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? */ @@ -30033,8 +46341,10 @@ L1: /* 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 */ -/* 29 blank barline (must be iv=1) (would have used islur but no room) */ -/* 30 "Look-left" option for keyboard rest */ +/* 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 */ @@ -30165,61 +46475,116 @@ L1: /* 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)) { - s_wsle(&io___1243); +#line 19794 "" + s_wsle(&io___1258); +#line 19794 "" e_wsle(); - s_wsle(&io___1244); +#line 19795 "" + s_wsle(&io___1259); +#line 19795 "" do_lio(&c__9, &c__1, "Starting second PMX pass", (ftnlen)24); +#line 19795 "" e_wsle(); - s_wsle(&io___1245); +#line 19796 "" + s_wsle(&io___1260); +#line 19796 "" e_wsle(); - s_wsfe(&io___1246); +#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_; - s_rsfe(&io___1249); +#line 19813 "" + s_rsfe(&io___1265); +#line 19813 "" do_fio(&c__1, basenameq, (ftnlen)44); +#line 19813 "" e_rsfe(); - s_rsle(&io___1251); +#line 19814 "" + s_rsle(&io___1267); +#line 19814 "" do_lio(&c__3, &c__1, (char *)&lbase, (ftnlen)sizeof(integer)); +#line 19814 "" e_rsle(); - s_rsle(&io___1253); +#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 */ @@ -30232,113 +46597,199 @@ L1: /* 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) { - if ((r__1 = r_mod(&xntrial, &c_b807), dabs(r__1)) < +#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 "" } - s_wsle(&io___1269); +#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; - s_rsle(&io___1270); +#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_; - s_rsle(&io___1276); +#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); - s_wsfe(&io___1278); +#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) @@ -30346,224 +46797,394 @@ L6: /* 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) { - s_wsfe(&io___1281); +#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) { - s_wsfe(&io___1282); +#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 { - s_wsfe(&io___1283); +#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) { - s_wsfe(&io___1286); +#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. */ @@ -30573,120 +47194,210 @@ L2: /* Only at the beginning of an input block will there be a possible mtr change, */ /* signalled by a nonzero mtrnuml. (which will be re-zeroed right after change) */ +#line 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) { - s_wsfe(&io___1296); +#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)) { - s_wsfe(&io___1298); +#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(); - s_wsfe(&io___1299); +#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)) { - comgrace_1.xb4mbr = comstart_1.facmtr * all_1.musicsize; +#line 20117 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 20117 "" } - -/* The above may be he only case where the space-before option is used in \mbrest */ - +#line 20119 "" } /* Move the read to after end-of-bar hardspace checks, so we get right poenom */ @@ -30703,77 +47414,137 @@ L2: /* 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) { - -/* Clef change and multi-bar rest coming up. Kluge to get space at end of rest. */ - - s_wsfe(&io___1303); +/* 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(); - s_wsfe(&io___1304); +#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) */ @@ -30783,507 +47554,1045 @@ L2: /* 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) { - s_wsfe(&io___1313); +#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) { - s_wsfe(&io___1322); +#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 "" } - wsclef_(&all_1.iv, &comnotes_1.ninow, comclefq_1.clefq, & - nclef, (ftnlen)1); +/* 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) { - s_wsfe(&io___1323); +#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"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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) { - s_rsle(&io___1324); +#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 = all_1.iornq[24]; +/* 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 = all_1.iornq[(all_1.nib[(all_1.ibar - 1) * 24 - 24] + 1) - * 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 { - s_wsle(&io___1327); +#line 20342 "" + s_wsle(&io___1349); +#line 20342 "" e_wsle(); - s_wsle(&io___1328); - do_lio(&c__9, &c__1, "Illegal symbol with \"R\" at end of in" +#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) { - s_wsfe(&io___1331); +#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) { - s_wsfe(&io___1332); +#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) { - s_wsfe(&io___1333); +#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"; - s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)15); - do_fio(&c__1, ch__14, (ftnlen)15); +#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) { - s_wsfe(&io___1334); +#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"; - s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)13); - do_fio(&c__1, ch__15, (ftnlen)13); +#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) { - s_wsfe(&io___1335); +#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"; - s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)13); - do_fio(&c__1, ch__15, (ftnlen)13); +#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 (bit_test(iornqnow,29)) { +/* 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) { - s_wsfe(&io___1336); +#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"; - s_cat(ch__15, a__4, i__6, &c__2, (ftnlen)13); - do_fio(&c__1, ch__15, (ftnlen)13); +#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) { - s_wsfe(&io___1339); +#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"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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) { - s_wsfe(&io___1340); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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) { - s_wsfe(&io___1342); +#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] = "%"; - s_cat(ch__17, a__3, i__5, &c__4, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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) { - s_wsfe(&io___1343); +#line 20419 "" + s_wsfe(&io___1365); /* Writing concatenation */ - i__11[0] = 1, a__8[0] = all_1.sq; - i__11[1] = 8, a__8[1] = "Setvolta"; - i__11[2] = 1, a__8[2] = "{"; - i__11[3] = lvoltxt, a__8[3] = comgrace_1.voltxtq + ( +#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; - i__11[4] = 2, a__8[4] = "}%"; - s_cat(ch__18, a__8, i__11, &c__5, (ftnlen)32); - do_fio(&c__1, ch__18, lvoltxt + 12); +#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) { - s_wsfe(&io___1353); +#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%"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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 */ - s_rsle(&io___1354); +#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) { - s_wsfe(&io___1356); +#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="; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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="; - s_cat(ch__19, a__5, i__8, &c__3, (ftnlen)10); - do_fio(&c__1, ch__19, (ftnlen)10); +#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 */ - i__12[0] = 1, a__9[0] = all_1.sq; - i__12[1] = 3, a__9[1] = "or%"; - s_cat(ch__20, a__9, i__12, &c__2, (ftnlen)4); - do_fio(&c__1, ch__20, (ftnlen)4); +#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( @@ -31295,50 +48604,82 @@ L23: /* 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) { - s_wsfe(&io___1359); +#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{"; - s_cat(ch__21, a__3, i__5, &c__4, (ftnlen)16); - do_fio(&c__1, ch__21, (ftnlen)16); +#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 */ @@ -31348,8 +48689,11 @@ L51: /* end if */ /* end if */ +#line 20555 "" } +#line 20556 "" } +#line 20557 "" if (comget_1.movbrk > 0) { /* movbrk = 0 */ @@ -31360,46 +48704,78 @@ L51: /* 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) { - s_wsle(&io___1361); +#line 20579 "" + s_wsle(&io___1382); +#line 20579 "" e_wsle(); - s_wsle(&io___1362); +#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) { - s_wsfe(&io___1363); +#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%"; - s_cat(ch__22, a__10, i__14, &c__8, (ftnlen)33); - do_fio(&c__1, ch__22, (ftnlen)33); +#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 */ @@ -31411,166 +48787,294 @@ L51: /* 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; - s_wsfi(&io___1366); +#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; - s_wsfi(&io___1367); +#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(); - s_wsfe(&io___1368); +#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) { - s_wsfe(&io___1369); +#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{"; - s_cat(ch__23, a__4, i__6, &c__2, (ftnlen)18); - do_fio(&c__1, ch__23, (ftnlen)18); +#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) { - s_wsfe(&io___1370); +#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{"; - s_cat(ch__23, a__4, i__6, &c__2, (ftnlen)18); - do_fio(&c__1, ch__23, (ftnlen)18); +#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) { - s_wsfe(&io___1372); +#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 "; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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) { - s_wsfe(&io___1373); +#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 "; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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) { - s_wsfe(&io___1374); +#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 "; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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 */ @@ -31586,137 +49090,247 @@ L51: /* 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) { - s_wsfe(&io___1376); +#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] = "}%"; - s_cat(ch__24, a__5, i__8, &c__3, (ftnlen)82); - do_fio(&c__1, ch__24, lnote + 3); +#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) { - s_wsfe(&io___1377); +#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%"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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) { - s_wsfe(&io___1378); +#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%"; - s_cat(ch__25, a__6, i__9, &c__10, (ftnlen)66); - do_fio(&c__1, ch__25, (ftnlen)66); +#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) { - s_wsfe(&io___1379); +#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%"; - s_cat(ch__26, a__1, i__3, &c__12, (ftnlen)60); - do_fio(&c__1, ch__26, (ftnlen)60); +#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) { - s_wsfe(&io___1380); +#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%"; - s_cat(ch__27, a__1, i__3, &c__12, (ftnlen)45); - do_fio(&c__1, ch__27, (ftnlen)45); +#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) { - s_wsfe(&io___1381); +#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%"; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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 */ @@ -31730,310 +49344,539 @@ L51: /* second pass, vshrink at top of page one is dealt with in topfile, which is called */ /* *before* any reading in any "Av" at the top of the first input block. */ +#line 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) { - s_wsfe(&io___1383); +#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"; - s_cat(ch__28, a__4, i__6, &c__2, (ftnlen)6); - do_fio(&c__1, ch__28, (ftnlen)6); +#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%"; - s_cat(ch__23, a__3, i__5, &c__4, (ftnlen)18); - do_fio(&c__1, ch__23, (ftnlen)18); +#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) { - s_wsfe(&io___1384); +#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%"; - s_cat(ch__15, a__3, i__5, &c__4, (ftnlen)13); - do_fio(&c__1, ch__15, (ftnlen)13); +#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) { - s_wsfe(&io___1385); +#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{"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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"; - s_cat(ch__17, a__5, i__8, &c__3, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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) { - s_wsfe(&io___1386); +#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%"; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen) +#line 20783 "" + s_cat(ch__15, a__4, i__6, &c__2, (ftnlen) 11); - do_fio(&c__1, ch__17, (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) { - comgrace_1.xb4mbr = comstart_1.facmtr * - all_1.musicsize; +#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) { - s_wsfe(&io___1387); +#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) { - s_wsfe(&io___1388); +#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] = "}%"; - s_cat(ch__24, a__5, i__8, &c__3, (ftnlen)82); - do_fio(&c__1, ch__24, lnote + 3); +#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) { - s_wsfe(&io___1389); +#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%"; - s_cat(ch__29, a__3, i__5, &c__4, (ftnlen)17); - do_fio(&c__1, ch__29, (ftnlen)17); +#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) { - s_wsfe(&io___1390); +#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%"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen) +#line 20828 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) 12); - do_fio(&c__1, ch__13, (ftnlen)12); +#line 20828 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20828 "" e_wsfe(); +#line 20828 "" } - s_wsfe(&io___1391); +#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%' */ - s_wsfe(&io___1392); +#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) { - s_wsfe(&io___1393); +#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%"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen) +#line 20837 "" + s_cat(ch__14, a__4, i__6, &c__2, (ftnlen) 12); - do_fio(&c__1, ch__13, (ftnlen)12); +#line 20837 "" + do_fio(&c__1, ch__14, (ftnlen)12); +#line 20837 "" e_wsfe(); +#line 20837 "" } - s_wsfe(&io___1394); +#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"; - s_cat(ch__14, a__4, i__6, &c__2, (ftnlen)15); - do_fio(&c__1, ch__14, (ftnlen)15); +#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) { - s_wsfe(&io___1395); +#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%"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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) { - s_wsfe(&io___1396); +#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) { - s_wsfe(&io___1397); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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. */ @@ -32043,1017 +49886,1800 @@ L51: /* \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) { - s_wsfe(&io___1398); +#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(); - s_wsfe(&io___1399); +#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); - s_wsfe(&io___1400); +#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) { - comgrace_1.xb4mbr = comstart_1.facmtr * - all_1.musicsize; +#line 20878 "" + comgrace_1.xb4mbr = all_1.musicsize * + -.2f; +#line 20878 "" } +#line 20879 "" } else { +#line 20880 "" if (comlast_1.islast) { - s_wsfe(&io___1401); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen) +#line 20880 "" + s_cat(ch__18, a__4, i__6, &c__2, (ftnlen) 9); - do_fio(&c__1, ch__16, (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) { - s_wsfe(&io___1402); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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) { - s_wsfe(&io___1403); +#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{"; - s_cat(ch__21, a__3, i__5, &c__4, (ftnlen)16); - do_fio(&c__1, ch__21, (ftnlen)16); +#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) { - s_wsfe(&io___1404); +#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"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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 "" } - i__7 = s_rsle(&io___1405); +#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; - s_wsfe(&io___1408); +#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) { - s_wsfe(&io___1409); +#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%"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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 "" } - s_wsfe(&io___1410); +#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%"; - s_cat(ch__21, a__4, i__6, &c__2, (ftnlen)16); - do_fio(&c__1, ch__21, (ftnlen)16); +#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 "" } - comgrace_1.xb4mbr = (comstart_1.facmtr + naccs * .24f) - * all_1.musicsize; +/* 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) { - s_wsfe(&io___1412); +#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] = "}%"; - s_cat(ch__24, a__5, i__8, &c__3, (ftnlen)82); - do_fio(&c__1, ch__24, lnote + 3); +#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) { - s_wsfe(&io___1413); +#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%"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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) { - s_wsfe(&io___1414); +#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 "" } - comgrace_1.xb4mbr = naccs * .24f * all_1.musicsize; +/* 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) { - s_wsfe(&io___1415); +#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) { - s_wsfe(&io___1416); +/* 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%"; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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) { - comgrace_1.xb4mbr = comstart_1.facmtr * - all_1.musicsize; +#line 21022 "" + comgrace_1.xb4mbr = all_1.musicsize * -.2f; +#line 21022 "" } +#line 21023 "" } else { +#line 21024 "" if (comlast_1.islast) { - s_wsfe(&io___1417); +#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) { - s_wsfe(&io___1418); +#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) { - s_wsfe(&io___1434); +#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%"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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) { - s_wsfe(&io___1435); +#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) { - s_wsfe(&io___1443); +#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{"; - s_cat(ch__17, a__4, i__6, &c__2, (ftnlen)11); - do_fio(&c__1, ch__17, (ftnlen)11); +#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) { - s_wsfe(&io___1444); +#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"; - s_cat(ch__13, a__4, i__6, &c__2, (ftnlen)12); - do_fio(&c__1, ch__13, (ftnlen)12); +#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) { - s_wsfe(&io___1445); +#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) { - s_wsfe(&io___1446); +#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) { - s_wsfe(&io___1447); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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) { - s_wsfe(&io___1448); +#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 */ - s_wsle(&io___1449); +#line 21290 "" + s_wsle(&io___1470); +#line 21290 "" e_wsle(); - s_wsle(&io___1450); - do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf" +#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(); - s_wsle(&io___1451); - do_lio(&c__9, &c__1, "R? , ? not \"d\",\"r\",or\"b\",\"z\"; rptf" +#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) { - s_wsfe(&io___1452); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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) { - s_wsfe(&io___1453); +#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"; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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) { - s_wsfe(&io___1454); +#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"; - s_cat(ch__28, a__4, i__6, &c__2, (ftnlen)6); - do_fio(&c__1, ch__28, (ftnlen)6); +#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) { - s_wsfe(&io___1455); +#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"; - s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)4); - do_fio(&c__1, ch__20, (ftnlen)4); +#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) { - s_wsfe(&io___1456); +#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) { - s_wsfe(&io___1457); +#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"; - s_cat(ch__20, a__4, i__6, &c__2, (ftnlen)4); - do_fio(&c__1, ch__20, (ftnlen)4); +#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) { - s_wsfe(&io___1458); +#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="; - s_cat(ch__16, a__4, i__6, &c__2, (ftnlen)9); - do_fio(&c__1, ch__16, (ftnlen)9); +#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="; - s_cat(ch__19, a__5, i__8, &c__3, (ftnlen)10); - do_fio(&c__1, ch__19, (ftnlen)10); +#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 */ - i__12[0] = 1, a__9[0] = all_1.sq; - i__12[1] = 4, a__9[1] = "fi}%"; - s_cat(ch__35, a__9, i__12, &c__2, (ftnlen)5); +#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)) { - s_wsle(&io___1459); +#line 21322 "" + s_wsle(&io___1480); +#line 21322 "" e_wsle(); - s_wsle(&io___1460); +#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(); - s_wsle(&io___1461); +#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(); - s_wsfe(&io___1462); +#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(); - s_wsfe(&io___1463); +#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_ */ @@ -33075,25 +51701,41 @@ L40: /* 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 "" } -/* L2: */ /* 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_ */ @@ -33122,10 +51764,10 @@ L40: integer *); /* Fortran I/O blocks */ - static cilist io___1471 = { 0, 6, 0, 0, 0 }; - static cilist io___1472 = { 0, 6, 0, 0, 0 }; - static cilist io___1483 = { 0, 6, 0, 0, 0 }; - static cilist io___1484 = { 0, 6, 0, 0, 0 }; + 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 }; @@ -33140,192 +51782,308 @@ L40: /* levtabl(i)=0 if no note at this level, -1 if main note, icrd if chord note. */ /* icrdot(icrd)(27-29) sequence order of chord note if accid, top down */ +#line 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 "" } - s_wsle(&io___1471); +#line 21377 "" + s_wsle(&io___1492); +#line 21377 "" e_wsle(); - s_wsle(&io___1472); - do_lio(&c__9, &c__1, "Cannot find first chord note in precrd. Send sourc" +#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 "" } - s_wsle(&io___1483); +#line 21456 "" + s_wsle(&io___1504); +#line 21456 "" e_wsle(); - s_wsle(&io___1484); - do_lio(&c__9, &c__1, "Failed to find last chord note. Send source to Dr." +#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) */ @@ -33333,36 +52091,57 @@ L9: /* stem too, so we left-shift the OTHER note, and set flag that signals */ /* to interchange pitches just when these two notes are placed. */ +#line 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_ */ @@ -33374,19 +52153,26 @@ L10: e_wsfe(void); /* Fortran I/O blocks */ - static cilist io___1487 = { 0, 6, 0, 0, 0 }; - static cilist io___1488 = { 0, 15, 0, "(a)", 0 }; + 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 */ - s_wsle(&io___1487); +#line 21560 "" + s_wsle(&io___1508); +#line 21560 "" do_lio(&c__9, &c__1, string, string_len); +#line 21560 "" e_wsle(); - s_wsfe(&io___1488); +#line 21561 "" + s_wsfe(&io___1509); +#line 21561 "" do_fio(&c__1, string, string_len); +#line 21561 "" e_wsfe(); +#line 21562 "" return 0; } /* printl_ */ @@ -33407,169 +52193,350 @@ L10: /* Builtin functions */ /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); integer s_wsfi(icilist *), do_fio(integer *, char *, ftnlen), e_wsfi(void) - , i_nint(real *); + , 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___1494 = { 0, notexq+9, 0, "(f3.1,a2)", 5, 1 }; + 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, iarp points to values from 1st. */ +/* 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); - s_wsfi(&io___1494); +#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 staff. */ +/* 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 staff. Lower staff has to be the first, upper is current and */ -/* is where the symbol will be written. */ +/* 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 */ - r__1 = comarp_1.xinsnow * 2; - levbot = -i_nint(&r__1) + 3 + comarp_1.levar1[iarp - 1] - +#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, */ @@ -33578,40 +52545,70 @@ L4: /* 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_ */ @@ -33634,25 +52631,42 @@ L4: static char tag[129], fmtq[9]; /* Fortran I/O blocks */ - static icilist io___1502 = { 0, fmtq, 0, "(a5,i1,a3)", 9, 1 }; + 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 "" } - s_wsfi(&io___1502); +#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... -> */ @@ -33660,23 +52674,40 @@ L4: /* ...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_ */ @@ -33704,133 +52735,247 @@ L4: extern /* Subroutine */ int printl_(char *, ftnlen); /* ivxip = ivx+16*ip */ +#line 21751 "" i__1 = comcb_1.nbc; +#line 21751 "" for (ibc = 1; ibc <= i__1; ++ibc) { /* if (ivxip .eq. iand(1023,ibcdata(ibc))) go to 2 */ /* if (ivx.eq.iand(15,ibcdata(ibc))+16*igetbits(ibcdata(ibc),1,28) */ /* * .and. ip.eq.iand(1008,ibcdata(ibc))) go to 2 */ +#line 21755 "" ivxbc = (15 & comcb_1.ibcdata[ibc - 1]) + (igetbits_(&comcb_1.ibcdata[ ibc - 1], &c__1, &c__28) << 4); +#line 21756 "" ipbc = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__4); +#line 21757 "" if (*ivx == ivxbc && *ip == ipbc) { +#line 21757 "" goto L2; +#line 21757 "" } +#line 21758 "" /* L1: */ +#line 21758 "" } +#line 21759 "" printl_("Error in putbc, Call Dr. Don", (ftnlen)28); +#line 21760 "" s_stop("", (ftnlen)0); +#line 21761 "" L2: +#line 21762 "" if (bit_test(comcb_1.ibcdata[ibc - 1],27)) { +#line 21763 "" *lnote = 8; +#line 21764 "" s_copy(notexq, "\\pbreath", (ftnlen)79, (ftnlen)8); +#line 21765 "" } else { +#line 21766 "" *lnote = 9; +#line 21767 "" s_copy(notexq, "\\pcaesura", (ftnlen)79, (ftnlen)9); +#line 21768 "" } +#line 21769 "" ivshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__6, &c__13); /* ?? ivshft = igetbits(ibcdata(ibc),6,13)-32 */ +#line 21771 "" if (ivshft > 0) { +#line 21771 "" ivshft += -32; +#line 21771 "" } +#line 21772 "" if (ivshft < 0 || ivshft > 9) { /* Writing concatenation */ +#line 21773 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 21773 "" i__2[1] = 1, a__1[1] = "{"; +#line 21773 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21774 "" ++(*lnote); +#line 21775 "" if (ivshft < -9) { +#line 21776 "" i__1 = *lnote; +#line 21776 "" ici__1.icierr = 0; +#line 21776 "" ici__1.icirnum = 1; +#line 21776 "" ici__1.icirlen = *lnote + 3 - i__1; +#line 21776 "" ici__1.iciunit = notexq + i__1; +#line 21776 "" ici__1.icifmt = "(i3)"; +#line 21776 "" s_wsfi(&ici__1); +#line 21776 "" do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); +#line 21776 "" e_wsfi(); +#line 21777 "" *lnote += 3; +#line 21778 "" } else { +#line 21779 "" i__1 = *lnote; +#line 21779 "" ici__1.icierr = 0; +#line 21779 "" ici__1.icirnum = 1; +#line 21779 "" ici__1.icirlen = *lnote + 2 - i__1; +#line 21779 "" ici__1.iciunit = notexq + i__1; +#line 21779 "" ici__1.icifmt = "(i2)"; +#line 21779 "" s_wsfi(&ici__1); +#line 21779 "" do_fio(&c__1, (char *)&ivshft, (ftnlen)sizeof(integer)); +#line 21779 "" e_wsfi(); +#line 21780 "" *lnote += 2; +#line 21781 "" } /* Writing concatenation */ +#line 21782 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 21782 "" i__2[1] = 1, a__1[1] = "}"; +#line 21782 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21783 "" ++(*lnote); +#line 21784 "" } else { /* Writing concatenation */ +#line 21785 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 21785 "" *(unsigned char *)&ch__1[0] = ivshft + 48; +#line 21785 "" i__2[1] = 1, a__1[1] = ch__1; +#line 21785 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21786 "" ++(*lnote); +#line 21787 "" } +#line 21788 "" ihshft = igetbits_(&comcb_1.ibcdata[ibc - 1], &c__8, &c__19); +#line 21789 "" if (ihshft == 0) { /* Writing concatenation */ +#line 21790 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 21790 "" i__2[1] = 1, a__1[1] = "0"; +#line 21790 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21791 "" ++(*lnote); +#line 21792 "" } else { +#line 21793 "" hshft = (ihshft - 128) * .1f; /* -12.8<hshft<12.8 */ /* Writing concatenation */ +#line 21797 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 21797 "" i__2[1] = 1, a__1[1] = "{"; +#line 21797 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21798 "" ++(*lnote); +#line 21799 "" if (hshft < -9.95f) { +#line 21800 "" i__1 = *lnote; +#line 21800 "" ici__1.icierr = 0; +#line 21800 "" ici__1.icirnum = 1; +#line 21800 "" ici__1.icirlen = *lnote + 5 - i__1; +#line 21800 "" ici__1.iciunit = notexq + i__1; +#line 21800 "" ici__1.icifmt = "(f5.1)"; +#line 21800 "" s_wsfi(&ici__1); +#line 21800 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 21800 "" e_wsfi(); +#line 21801 "" *lnote += 5; +#line 21802 "" } else if (hshft < -.05f || hshft > 9.95f) { +#line 21803 "" i__1 = *lnote; +#line 21803 "" ici__1.icierr = 0; +#line 21803 "" ici__1.icirnum = 1; +#line 21803 "" ici__1.icirlen = *lnote + 4 - i__1; +#line 21803 "" ici__1.iciunit = notexq + i__1; +#line 21803 "" ici__1.icifmt = "(f4.1)"; +#line 21803 "" s_wsfi(&ici__1); +#line 21803 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 21803 "" e_wsfi(); +#line 21804 "" *lnote += 4; +#line 21805 "" } else { +#line 21806 "" i__1 = *lnote; +#line 21806 "" ici__1.icierr = 0; +#line 21806 "" ici__1.icirnum = 1; +#line 21806 "" ici__1.icirlen = *lnote + 3 - i__1; +#line 21806 "" ici__1.iciunit = notexq + i__1; +#line 21806 "" ici__1.icifmt = "(f3.1)"; +#line 21806 "" s_wsfi(&ici__1); +#line 21806 "" do_fio(&c__1, (char *)&hshft, (ftnlen)sizeof(real)); +#line 21806 "" e_wsfi(); +#line 21807 "" *lnote += 3; +#line 21808 "" } /* Writing concatenation */ +#line 21809 "" i__2[0] = *lnote, a__1[0] = notexq; +#line 21809 "" i__2[1] = 1, a__1[1] = "}"; +#line 21809 "" s_cat(notexq, a__1, i__2, &c__2, (ftnlen)79); +#line 21810 "" ++(*lnote); +#line 21811 "" } +#line 21812 "" return 0; } /* putcb_ */ @@ -33838,8 +52983,8 @@ L2: logical *figcheck, char *soutq, integer *lsout, ftnlen soutq_len) { /* System generated locals */ - address a__1[2], a__2[3], a__3[6], a__4[4]; - integer i__1[2], i__2[3], i__3, i__4[6], i__5[4]; + 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]; @@ -33870,83 +53015,188 @@ L2: ; /* Fortran I/O blocks */ - static icilist io___1514 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; - static icilist io___1516 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; - static icilist io___1517 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; - static icilist io___1518 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; - static icilist io___1531 = { 0, notexq+5, 0, "(f6.2)", 6, 1 }; - static icilist io___1532 = { 0, notexq+5, 0, "(f5.2)", 5, 1 }; - static icilist io___1533 = { 0, notexq+5, 0, "(f4.2)", 4, 1 }; - static icilist io___1534 = { 0, notexq+5, 0, "(f3.2)", 3, 1 }; + 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 */ - i__1[0] = 1, a__1[0] = sq; - i__1[1] = 4, a__1[1] = "off{"; - s_cat(notexq, a__1, i__1, &c__2, (ftnlen)80); +#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) { - s_wsfi(&io___1514); +#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) { - s_wsfi(&io___1516); +#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) { - s_wsfi(&io___1517); +#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 { - s_wsfi(&io___1518); +#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; - } -/* Writing concatenation */ - i__2[0] = lnote, a__2[0] = notexq; - i__2[1] = 1, a__2[1] = sq; - i__2[2] = 9, a__2[2] = "noteskip}"; - s_cat(notexq, a__2, i__2, &c__3, (ftnlen)80); +#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. */ @@ -33967,217 +53217,387 @@ L1: /* 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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = conttq; - i__4[2] = lnof, a__3[2] = nofq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = ic - 1 - (icnum - 1), a__3[4] = figq + (icnum - 1); - i__4[5] = 1, a__3[5] = "}"; - s_cat(ch__2, a__3, i__4, &c__6, (ftnlen)22); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnofa, a__3[2] = nofaq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = sq; - i__4[5] = 9, a__3[5] = "sharpfig}"; - s_cat(ch__3, a__3, i__4, &c__6, (ftnlen)21); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnofa, a__3[2] = nofaq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = sq; - i__4[5] = 8, a__3[5] = "flatfig}"; - s_cat(ch__4, a__3, i__4, &c__6, (ftnlen)20); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnofa, a__3[2] = nofaq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = sq; - i__4[5] = 7, a__3[5] = "natfig}"; - s_cat(ch__5, a__3, i__4, &c__6, (ftnlen)19); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnofa, a__3[2] = nofaq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = sq; - i__4[5] = 6, a__3[5] = "fsmsh}"; - s_cat(ch__6, a__3, i__4, &c__6, (ftnlen)18); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnofa, a__3[2] = nofaq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = sq; - i__4[5] = 6, a__3[5] = "fsmfl}"; - s_cat(ch__6, a__3, i__4, &c__6, (ftnlen)18); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnofa, a__3[2] = nofaq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = sq; - i__4[5] = 6, a__3[5] = "fsmna}"; - s_cat(ch__6, a__3, i__4, &c__6, (ftnlen)18); +#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 */ - i__4[0] = 1, a__3[0] = sq; - i__4[1] = 4, a__3[1] = figutq; - i__4[2] = lnof, a__3[2] = nofq; - i__4[3] = 1, a__3[3] = "{"; - i__4[4] = 1, a__3[4] = ch2q; - i__4[5] = 1, a__3[5] = "}"; - s_cat(ch__7, a__3, i__4, &c__6, (ftnlen)13); +#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 */ - i__1[0] = 1, a__1[0] = sq; - i__1[1] = 7, a__1[1] = "ligfont"; - s_cat(ch__9, a__1, i__1, &c__2, (ftnlen)8); +#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 */ - i__1[0] = 1, a__1[0] = ch1q; - i__1[1] = 1, a__1[1] = "}"; - s_cat(ch__10, a__1, i__1, &c__2, (ftnlen)2); +#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 */ - i__1[0] = 1, a__1[0] = sq; - i__1[1] = 4, a__1[1] = "off{"; - s_cat(notexq, a__1, i__1, &c__2, (ftnlen)80); +#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) { - s_wsfi(&io___1531); +#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) { - s_wsfi(&io___1532); +#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) { - s_wsfi(&io___1533); +#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 { - s_wsfi(&io___1534); +#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; - } -/* Writing concatenation */ - i__2[0] = lnote, a__2[0] = notexq; - i__2[1] = 1, a__2[1] = sq; - i__2[2] = 9, a__2[2] = "noteskip}"; - s_cat(notexq, a__2, i__2, &c__3, (ftnlen)80); +#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_ */ @@ -34230,366 +53650,666 @@ L2: /* 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: -/* Bit # of last ornament (last of bits 0-21) */ +/* c Bit # of last ornament (last of bits 0-21) */ /* c Bit # of last ornament (last of bits 0-24) */ - i__1 = *iornq & 4194303; - ibit = log2_(&i__1); +/* 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 < 21) { +/* 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 */ @@ -34599,86 +54319,149 @@ L5: /* 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_ */ @@ -34707,52 +54490,91 @@ L5: 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_ */ @@ -34785,9 +54607,9 @@ L5: static integer lenline; /* Fortran I/O blocks */ - static cilist io___1562 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1565 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1568 = { 0, 11, 0, "(a)", 0 }; + 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 }; @@ -34795,192 +54617,352 @@ L5: /* Actual titles only allowed on p.1. (set by headlog). */ /* 3/18/01: The above comment is probably bogus...can use Tt on later pages. */ +#line 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) { - s_wsfe(&io___1562); +#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) { - s_wsfe(&io___1565); +#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) { - s_wsfe(&io___1568); +#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_ */ @@ -35013,119 +54995,218 @@ L5: /* 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_ */ @@ -35139,62 +55220,97 @@ L5: 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_ */ @@ -35223,7 +55339,7 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen getchar_(char *, integer *, char *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___1577 = { 0, 6, 0, 0, 0 }; + static cilist io___1603 = { 0, 6, 0, 0, 0 }; @@ -35231,71 +55347,123 @@ doublereal readin_(char *lineq, integer *iccount, integer *nline, ftnlen /* 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) { - s_wsle(&io___1577); +#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_ */ @@ -35321,96 +55489,160 @@ L5: 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_ */ @@ -35437,7 +55669,7 @@ L5: char *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___1583 = { 0, 6, 0, 0, 0 }; + static cilist io___1609 = { 0, 6, 0, 0, 0 }; @@ -35446,43 +55678,78 @@ L5: /* 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) { - s_wsle(&io___1583); +#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_ */ @@ -35499,28 +55766,42 @@ L1: static integer ibase; /* Fortran I/O blocks */ - static cilist io___1586 = { 0, 6, 0, 0, 0 }; - static cilist io___1587 = { 0, 6, 0, 0, 0 }; - static cilist io___1588 = { 0, 15, 0, "(/,a)", 0 }; + 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) { - s_wsle(&io___1586); +#line 22760 "" + s_wsle(&io___1612); +#line 22760 "" e_wsle(); - s_wsle(&io___1587); +#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(); - s_wsfe(&io___1588); +#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_ */ @@ -35542,54 +55823,97 @@ L1: /* 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_ */ @@ -35617,102 +55941,168 @@ L1: ftnlen), g1etchar_(char *, integer *, char *, ftnlen, ftnlen); /* Fortran I/O blocks */ - static cilist io___1601 = { 0, 6, 0, 0, 0 }; - static cilist io___1602 = { 0, 6, 0, 0, 0 }; - static cilist io___1603 = { 0, 6, 0, 0, 0 }; + 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) { - s_wsle(&io___1601); +#line 22831 "" + s_wsle(&io___1627); +#line 22831 "" e_wsle(); - s_wsle(&io___1602); +#line 22832 "" + s_wsle(&io___1628); +#line 22832 "" e_wsle(); - s_wsle(&io___1603); +#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; - errmsg_(lineq, iccount, &i__1, "\"MS...\" only put in parts by scor2" +#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; - errmsg_(lineq, iccount, &i__1, "Illegal character after \"M\" (macro" +#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; - errmsg_(lineq, iccount, &i__1, "Must input number after \"MR\"" +#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; - errmsg_(lineq, iccount, &i__1, "Macro number must be followed by" +#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; - errmsg_(lineq, &i__1, &i__2, "Cannot play a macro that has n" +#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_ */ @@ -35727,36 +56117,58 @@ L1: /* 3: triple w/ denom=8, subdivide in groups of 3 8ths */ /* Note that lenbar is set at top or when 'm' symbol is read in getnote */ +#line 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_ */ @@ -35801,54 +56213,86 @@ L1: /* 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 */ @@ -35856,137 +56300,223 @@ L1: /* number. ntupv is number of notes in xtup, and is only used to get */ /* eloff, the distance from start of xtup to the number. */ +#line 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; @@ -35994,54 +56524,92 @@ L6: /* 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] * @@ -36051,54 +56619,82 @@ L6: /* 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_ */ @@ -36113,36 +56709,60 @@ L6: /* 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_ */ @@ -36179,282 +56799,473 @@ L6: /* 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 s */ +/* flag for tweaks of 1st or 2nd (0|1) seg of linebreak slur */ +#line 23274 "" getchar_(lineq, iccount, durq, (ftnlen)128, (ftnlen)1); - if (i_indx("uldtb+-hfnHps ", durq, (ftnlen)14, (ftnlen)1) > 0) { +/* 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_ */ @@ -36489,215 +57300,346 @@ L1: /* 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_ */ @@ -36705,7 +57647,9 @@ L1: { extern /* Subroutine */ int exit_(integer *); +#line 23693 "" exit_(&c__1); +#line 23694 "" return 0; } /* stop1_ */ @@ -36715,17 +57659,18 @@ L1: 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[10], a__7[20], - a__8[12], a__9[8]; + 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[10], i__10[20], i__11[12], i__12[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[81], ch__25[82], ch__26[18], ch__27[57], ch__28[44], - ch__29[62], ch__30[54], ch__31[86], ch__32[41], ch__33[47]; + 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 */ @@ -36745,191 +57690,305 @@ L1: 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___1668 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1669 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1670 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1671 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1672 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1673 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1674 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1675 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1676 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1677 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1678 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1679 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1680 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1681 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1682 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1684 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___1685 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___1686 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___1687 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static icilist io___1689 = { 0, fbarq, 0, "(f5.3)", 5, 1 }; - static cilist io___1690 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1691 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1692 = { 0, 11, 0, "(a7,i3,a2)", 0 }; - static cilist io___1693 = { 0, 11, 0, "(a8,i3,a2)", 0 }; - static cilist io___1694 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1695 = { 0, 11, 0, "(a8,i1,a2)", 0 }; - static cilist io___1696 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1697 = { 0, 11, 0, "(a8,i3,a2)", 0 }; - static cilist io___1698 = { 0, 11, 0, "(a8,i2,a2)", 0 }; - static cilist io___1699 = { 0, 11, 0, "(a8,i1,a2)", 0 }; - static cilist io___1700 = { 0, 11, 0, "(a8,i2,a2)", 0 }; + 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, "(a19,i1,a1)", 0 }; - static cilist io___1703 = { 0, 11, 0, "(a19,i2,a1)", 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, "(a11,i2,a)", 0 }; - static cilist io___1711 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1712 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___1714 = { 0, 11, 0, "(a8,i1,a)", 0 }; - static cilist io___1715 = { 0, 11, 0, "(a9,i2,a)", 0 }; - static cilist io___1716 = { 0, 11, 0, "(a18,i2,a2)", 0 }; - static cilist io___1718 = { 0, 11, 0, "(a11,i1,a2)", 0 }; - static cilist io___1719 = { 0, 11, 0, "(a11,i2,a2)", 0 }; - static cilist io___1720 = { 0, 11, 0, "(a11,i3,a2)", 0 }; - static cilist io___1721 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1722 = { 0, 11, 0, fmtq, 0 }; - static cilist io___1723 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1724 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1725 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1726 = { 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, "(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 "" } - s_wsfe(&io___1668); +#line 23727 "" + s_wsfe(&io___1694); +#line 23727 "" do_fio(&c__1, "%%%%%%%%%%%%%%%%%", (ftnlen)17); +#line 23727 "" e_wsfe(); - s_wsfe(&io___1669); +#line 23728 "" + s_wsfe(&io___1695); +#line 23728 "" do_fio(&c__1, "%", (ftnlen)1); +#line 23728 "" e_wsfe(); - s_wsfe(&io___1670); +#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(); - s_wsfe(&io___1671); +#line 23730 "" + s_wsfe(&io___1697); +#line 23730 "" do_fio(&c__1, "%", (ftnlen)1); +#line 23730 "" e_wsfe(); - s_wsfe(&io___1672); +#line 23731 "" + s_wsfe(&io___1698); +#line 23731 "" do_fio(&c__1, "%%%%%%%%%%%%%%%%", (ftnlen)16); +#line 23731 "" e_wsfe(); - s_wsfe(&io___1673); +#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(); - s_wsfe(&io___1674); +#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' */ - s_wsfe(&io___1675); +#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)) { - s_wsfe(&io___1676); +#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) { - s_wsfe(&io___1677); +#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) { - s_wsfe(&io___1678); +#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) { - s_wsfe(&io___1679); +#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(); - s_wsfe(&io___1680); +#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) { - s_wsfe(&io___1681); +#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(); - s_wsfe(&io___1682); +#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 */ @@ -36937,575 +57996,1155 @@ L1: /* 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) { - s_wsfe(&io___1684); +#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 { - s_wsfe(&io___1685); +#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) { - s_wsfe(&io___1686); +#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 { - s_wsfe(&io___1687); +#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 "" } - s_wsfi(&io___1689); +#line 23783 "" + s_wsfi(&io___1715); +#line 23783 "" do_fio(&c__1, (char *)&(*fbar), (ftnlen)sizeof(real)); +#line 23783 "" e_wsfi(); - s_wsfe(&io___1690); +#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(); - s_wsfe(&io___1691); +#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(); - s_wsfe(&io___1692); +#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) { - s_wsfe(&io___1693); +#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) { - s_wsfe(&io___1694); +#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) { - s_wsfe(&io___1695); +#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 { - s_wsfe(&io___1696); +#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) { - s_wsfe(&io___1697); +#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) { - s_wsfe(&io___1698); +#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) { - s_wsfe(&io___1699); +#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 { - s_wsfe(&io___1700); +#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') { - s_wsfe(&io___1701); +#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) { - s_wsfe(&io___1702); +#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 { - s_wsfe(&io___1703); +#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) { - s_wsfe(&io___1706); +#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 { - s_wsfe(&io___1707); +#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) { - s_wsfe(&io___1711); +#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 { - s_wsfe(&io___1712); +#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) { - s_wsfe(&io___1714); +#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] = "}"; - s_cat(ch__24, a__1, i__1, &c__3, (ftnlen)81); - do_fio(&c__1, ch__24, lname + 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 { - s_wsfe(&io___1715); +#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] = "}"; - s_cat(ch__25, a__1, i__1, &c__3, (ftnlen)82); - do_fio(&c__1, ch__25, lname + 3); +#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 "" } - s_wsfe(&io___1716); +#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{"; - s_cat(ch__26, a__2, i__2, &c__2, (ftnlen)18); - do_fio(&c__1, ch__26, (ftnlen)18); +#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) { - s_wsfe(&io___1718); +#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) { - s_wsfe(&io___1719); +#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 { - s_wsfe(&io___1720); +#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 "" } - s_wsfe(&io___1721); -/* Writing concatenation */ - i__9[0] = 1, a__6[0] = sq; - i__9[1] = 11, a__6[1] = "elemskip1pt"; - i__9[2] = 1, a__6[2] = sq; - i__9[3] = 13, a__6[3] = "afterruleskip"; - i__9[4] = 5, a__6[4] = fbarq; - i__9[5] = 2, a__6[5] = "pt"; - i__9[6] = 1, a__6[6] = sq; - i__9[7] = 17, a__6[7] = "beforeruleskip0pt"; - i__9[8] = 1, a__6[8] = sq; - i__9[9] = 5, a__6[9] = "relax"; - s_cat(ch__27, a__6, i__9, &c__10, (ftnlen)57); - do_fio(&c__1, ch__27, (ftnlen)57); +#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 "" } - s_wsfe(&io___1722); +#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{"; - s_cat(ch__28, a__4, i__4, &c__6, (ftnlen)44); - do_fio(&c__1, ch__28, (ftnlen)44); +#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 { - s_wsfe(&io___1723); -/* Writing concatenation */ - i__9[0] = 1, a__6[0] = sq; - i__9[1] = 15, a__6[1] = "stafftopmarg0pt"; - i__9[2] = 1, a__6[2] = sq; - i__9[3] = 13, a__6[3] = "staffbotmarg5"; - i__9[4] = 1, a__6[4] = sq; - i__9[5] = 10, a__6[5] = "Interligne"; - i__9[6] = 1, a__6[6] = sq; - i__9[7] = 14, a__6[7] = "interstaff{10}"; - i__9[8] = 1, a__6[8] = sq; - i__9[9] = 5, a__6[9] = "relax"; - s_cat(ch__29, a__6, i__9, &c__10, (ftnlen)62); - do_fio(&c__1, ch__29, (ftnlen)62); +#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) { - s_wsfe(&io___1724); +#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 "" } - s_wsfe(&io___1725); +#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] = "}"; - s_cat(ch__30, a__3, i__3, &c__4, (ftnlen)54); - do_fio(&c__1, ch__30, *lbase + 10); +#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) { - s_wsfe(&io___1726); -/* Writing concatenation */ - i__10[0] = 1, a__7[0] = sq; - i__10[1] = 12, a__7[1] = "input tuplet"; - i__10[2] = 1, a__7[2] = sq; - i__10[3] = 3, a__7[3] = "def"; - i__10[4] = 1, a__7[4] = sq; - i__10[5] = 12, a__7[5] = "xnumt#1#2#3{"; - i__10[6] = 1, a__7[6] = sq; - i__10[7] = 16, a__7[7] = "zcharnote{#2}{~}"; - i__10[8] = 1, a__7[8] = sq; - i__10[9] = 3, a__7[9] = "def"; - i__10[10] = 1, a__7[10] = sq; - i__10[11] = 10, a__7[11] = "tuplettxt{"; - i__10[12] = 1, a__7[12] = sq; - i__10[13] = 9, a__7[13] = "smalltype"; - i__10[14] = 1, a__7[14] = sq; - i__10[15] = 6, a__7[15] = "it{#3}"; - i__10[16] = 1, a__7[16] = sq; - i__10[17] = 1, a__7[17] = "/"; - i__10[18] = 1, a__7[18] = sq; - i__10[19] = 4, a__7[19] = "/}}%"; - s_cat(ch__31, a__7, i__10, &c__20, (ftnlen)86); - do_fio(&c__1, ch__31, (ftnlen)86); - e_wsfe(); - s_wsfe(&io___1727); +#line 23911 "" + s_wsfe(&io___1755); /* Writing concatenation */ +#line 23911 "" i__11[0] = 1, a__8[0] = sq; - i__11[1] = 3, a__8[1] = "let"; +#line 23911 "" + i__11[1] = 12, a__8[1] = "input tuplet"; +#line 23911 "" i__11[2] = 1, a__8[2] = sq; - i__11[3] = 5, a__8[3] = "ovbkt"; +#line 23911 "" + i__11[3] = 3, a__8[3] = "def"; +#line 23911 "" i__11[4] = 1, a__8[4] = sq; - i__11[5] = 8, a__8[5] = "uptuplet"; +#line 23911 "" + i__11[5] = 12, a__8[5] = "xnumt#1#2#3{"; +#line 23911 "" i__11[6] = 1, a__8[6] = sq; - i__11[7] = 3, a__8[7] = "let"; +#line 23911 "" + i__11[7] = 16, a__8[7] = "zcharnote{#2}{~}"; +#line 23911 "" i__11[8] = 1, a__8[8] = sq; - i__11[9] = 5, a__8[9] = "unbkt"; +#line 23911 "" + i__11[9] = 3, a__8[9] = "def"; +#line 23911 "" i__11[10] = 1, a__8[10] = sq; - i__11[11] = 11, a__8[11] = "downtuplet%"; - s_cat(ch__32, a__8, i__11, &c__12, (ftnlen)41); - do_fio(&c__1, ch__32, (ftnlen)41); +#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(); - } - s_wsfe(&io___1728); -/* Writing concatenation */ - i__12[0] = 1, a__9[0] = sq; - i__12[1] = 11, a__9[1] = "startmuflex"; - i__12[2] = 1, a__9[2] = sq; - i__12[3] = 10, a__9[3] = "startpiece"; - i__12[4] = 1, a__9[4] = sq; - i__12[5] = 8, a__9[5] = "addspace"; - i__12[6] = 1, a__9[6] = sq; - i__12[7] = 14, a__9[7] = "afterruleskip%"; - s_cat(ch__33, a__9, i__12, &c__8, (ftnlen)47); - do_fio(&c__1, ch__33, (ftnlen)47); +#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_ */ @@ -37517,12 +59156,19 @@ L4: /* 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_ */ @@ -37540,33 +59186,52 @@ L4: /* 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_ */ @@ -37578,12 +59243,19 @@ L4: /* 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_ */ @@ -37605,25 +59277,40 @@ L4: extern /* Character */ VOID chax_(char *, ftnlen, integer *); /* Fortran I/O blocks */ - static cilist io___1732 = { 0, 6, 0, 0, 0 }; + 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; - s_wsle(&io___1732); +#line 23992 "" + s_wsle(&io___1761); /* Writing concatenation */ - i__2[0] = 52, a__1[0] = "Warning, upcaseq was called with improper a" +#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_ */ @@ -37644,143 +59331,258 @@ L4: extern /* Character */ VOID chax_(char *, ftnlen, integer *); /* Fortran I/O blocks */ - static cilist io___1734 = { 0, 11, 0, "(a25,i1,a2,i1,a3)", 0 }; - static cilist io___1735 = { 0, 11, 0, "(a25,i1,a2,i2,a3)", 0 }; - static cilist io___1736 = { 0, 11, 0, "(a25,i2,a2,i1,a3)", 0 }; - static cilist io___1737 = { 0, 11, 0, "(a25,i2,a2,i2,a3)", 0 }; - static cilist io___1738 = { 0, 11, 0, "(a26,i1,a2,i1,a3)", 0 }; - static cilist io___1739 = { 0, 11, 0, "(a21,i1,a2)", 0 }; - static cilist io___1740 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1741 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1742 = { 0, 11, 0, "(a)", 0 }; + 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) { - s_wsfe(&io___1734); +#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 { - s_wsfe(&io___1735); +#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) { - s_wsfe(&io___1736); +#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 { - s_wsfe(&io___1737); +#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) { - s_wsfe(&io___1738); +#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) { - s_wsfe(&io___1739); +#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) { - s_wsfe(&io___1740); +#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) { - s_wsfe(&io___1741); +#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) { - s_wsfe(&io___1742); +#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_ */ @@ -37815,32 +59617,32 @@ L4: extern /* Subroutine */ int printl_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1744 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1745 = { 0, 52, 0, "(a6,10Z4)", 0 }; - static cilist io___1750 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1751 = { 0, 52, 0, "(a6,8z4)", 0 }; - static cilist io___1752 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1753 = { 0, 52, 0, "(a)", 0 }; - static cilist io___1754 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1755 = { 0, 52, 0, "(a)", 0 }; - static cilist io___1758 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1759 = { 0, 52, 0, "(z4)", 0 }; - static cilist io___1760 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1761 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1766 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1767 = { 0, 52, 0, "(a4,z2,a7,11z4)", 0 }; - static cilist io___1768 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1769 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1770 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1771 = { 0, 52, 0, "(a)", 0 }; - static icilist io___1773 = { 0, tempoq, 0, "(i2)", 10, 1 }; - static icilist io___1775 = { 0, instq, 0, "(i3)", 10, 1 }; - static cilist io___1776 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1777 = { 0, 52, 0, "(z4)", 0 }; - static cilist io___1778 = { 0, 51, 0, "(a,$)", 0 }; - static cilist io___1779 = { 0, 52, 0, "(4z4)", 0 }; - static cilist io___1780 = { 0, 6, 0, "(1x,a12,(10i6))", 0 }; - static cilist io___1781 = { 0, 15, 0, "(1x,a12,(10i6))", 0 }; + 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 }; @@ -37852,165 +59654,292 @@ L4: /* Write Header */ - s_wsfe(&io___1744); +#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) { - s_wsfe(&io___1745); +#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); - s_wsfe(&io___1750); +#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) { - s_wsfe(&io___1751); +#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 "" } - s_wsfe(&io___1752); +#line 24118 "" + s_wsfe(&io___1781); +#line 24118 "" do_fio(&c__1, jobname, (*ljob)); +#line 24118 "" e_wsfe(); +#line 24119 "" if (commidi_1.debugmidi) { - s_wsfe(&io___1753); +#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' */ - s_wsfe(&io___1754); +#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) { - s_wsfe(&io___1755); +#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__) { - s_wsfe(&io___1758); +#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) { - s_wsfe(&io___1759); +#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. */ - s_wsfe(&io___1760); +#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) { - s_wsfe(&io___1761); +#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 */ @@ -38032,238 +59961,421 @@ L4: /* 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 */ - s_wsfe(&io___1766); +#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) { - s_wsfe(&io___1767); +#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 */ - s_wsfe(&io___1768); +#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) { - s_wsfe(&io___1769); +#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 "" } - s_wsfe(&io___1770); +#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) { - s_wsfe(&io___1771); +#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 "" } - s_wsfi(&io___1773); +#line 24228 "" + s_wsfi(&io___1802); +#line 24228 "" do_fio(&c__1, (char *)&icm, (ftnlen)sizeof(integer)); +#line 24228 "" e_wsfi(); - s_wsfi(&io___1775); +#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__) { - s_wsfe(&io___1776); +#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) { - s_wsfe(&io___1777); +#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 */ - s_wsfe(&io___1778); +#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) { - s_wsfe(&io___1779); +#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 "" } - s_wsfe(&io___1780); +#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(); - s_wsfe(&io___1781); +#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_ */ @@ -38288,79 +60400,143 @@ L5: static char notexq[79]; /* Fortran I/O blocks */ - static cilist io___1785 = { 0, 11, 0, "(a)", 0 }; + 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 "" } - s_wsfe(&io___1785); +#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_ */ @@ -38375,45 +60551,79 @@ L5: 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, char *clefq, - integer *nclef, ftnlen clefq_len) +/* Subroutine */ int wsclef_(integer *iv, integer *ninow, integer *nclef) { /* System generated locals */ address a__1[3], a__2[2]; @@ -38437,105 +60647,465 @@ L5: extern integer numclef_(char *, ftnlen); /* Fortran I/O blocks */ - static cilist io___1788 = { 0, 6, 0, 0, 0 }; - static cilist io___1789 = { 0, 6, 0, 0, 0 }; - static icilist io___1793 = { 0, temq, 0, "(a9,i2,a1)", 20, 1 }; - static cilist io___1794 = { 0, 11, 0, "(a)", 0 }; - static cilist io___1796 = { 0, 11, 0, "(a)", 0 }; + 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 voice iv */ +/* Writes \setclef for instrument containing *staff* iv */ - /* Parameter adjustments */ - --clefq; - /* Function Body */ +/* 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); - *(unsigned char *)&clefq[*iv] = *(unsigned char *)&ch__1[0]; +#line 24331 "" + *(unsigned char *)&comclefq_1.clefq[*iv - 1] = *(unsigned char *)& + ch__1[0]; +#line 24332 "" } else { - *(unsigned char *)&clefq[*iv] = '9'; +#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 "" } - s_wsle(&io___1788); +#line 24341 "" + s_wsle(&io___1817); +#line 24341 "" e_wsle(); - s_wsle(&io___1789); +#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 { - s_wsfi(&io___1793); +#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) { - s_wsfe(&io___1794); + +/* 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; - i__2[1] = 1, a__1[1] = clefq + *iv; +#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; - i__4 = numclef_(clefq + iiv, (ftnlen)1) + 48; +#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 "" } - s_wsfe(&io___1796); +#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; } diff --git a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.c b/Build/source/utils/pmx/pmx-src/scor2prt.c index d83124d27e0..3f69f41ad45 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.c +++ b/Build/source/utils/pmx/pmx-src/scor2prt.c @@ -1,4 +1,5 @@ -/* -- translated by f2c (version 20031025). +#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 @@ -12,6 +13,7 @@ #include "f2c.h" +#line 1 "" /* Common Block Declarations */ struct all_1_ { @@ -264,256 +266,465 @@ static integer c__125 = 125; static cilist io___103 = { 0, 0, 0, "(a)", 0 }; +#line 99 "" clefpend = FALSE_; +#line 100 "" all_1.insetup = TRUE_; +#line 101 "" all_1.replacing = FALSE_; +#line 102 "" frstln = TRUE_; +#line 103 "" lenhold = 0; +#line 104 "" *(unsigned char *)sq = '\\'; +#line 105 "" s_wsle(&io___6); +#line 105 "" do_lio(&c__9, &c__1, "This is scor2prt for PMX 2.7, 2 April 2013", ( ftnlen)42); +#line 105 "" e_wsle(); +#line 106 "" numargs = iargc_(); +#line 107 "" if (numargs == 0) { +#line 108 "" s_wsle(&io___8); - do_lio(&c__9, &c__1, "You could have entered a jobname on the comman" +#line 108 "" + do_lio(&c__9, &c__1, "You could have entered a jobname on the comman"\ "d line,", (ftnlen)53); +#line 108 "" e_wsle(); +#line 109 "" s_wsle(&io___9); +#line 109 "" do_lio(&c__9, &c__1, " but you may enter one now:", (ftnlen)32); +#line 109 "" e_wsle(); +#line 110 "" s_rsfe(&io___10); +#line 110 "" do_fio(&c__1, jobname, (ftnlen)27); +#line 110 "" e_rsfe(); +#line 111 "" numargs = 1; +#line 112 "" } else { /* call getarg(1,jobname,idum) ! May need to replace this w/ next line */ +#line 114 "" getarg_(&c__1, jobname, (ftnlen)27); +#line 115 "" } +#line 116 "" ljob = lenstr_(jobname, &c__27, (ftnlen)27); +#line 117 "" if (ljob == 0) { +#line 118 "" s_wsle(&io___13); +#line 118 "" do_lio(&c__9, &c__1, "No was jobname entered. Restart and try again.", (ftnlen)46); +#line 118 "" e_wsle(); +#line 119 "" s_stop("", (ftnlen)0); +#line 120 "" } /* Strip ".pmx" if necessary */ /* Computing MAX */ +#line 124 "" i__1 = i_indx(jobname, ".pmx", (ftnlen)27, (ftnlen)4), i__2 = i_indx( jobname, ".PMX", (ftnlen)27, (ftnlen)4); +#line 124 "" ndxpmx = max(i__1,i__2); +#line 125 "" if (ndxpmx > 0) { +#line 126 "" s_copy(jobname, jobname, (ftnlen)27, ndxpmx - 1); +#line 127 "" ljob += -4; +#line 128 "" } /* Check for existence of input file */ /* Writing concatenation */ +#line 132 "" i__3[0] = ljob, a__1[0] = jobname; +#line 132 "" i__3[1] = 4, a__1[1] = ".pmx"; +#line 132 "" s_cat(infileq, a__1, i__3, &c__2, (ftnlen)27); +#line 133 "" ioin__1.inerr = 0; +#line 133 "" ioin__1.infilen = 27; +#line 133 "" ioin__1.infile = infileq; +#line 133 "" ioin__1.inex = &fexist; +#line 133 "" ioin__1.inopen = 0; +#line 133 "" ioin__1.innum = 0; +#line 133 "" ioin__1.innamed = 0; +#line 133 "" ioin__1.inname = 0; +#line 133 "" ioin__1.inacc = 0; +#line 133 "" ioin__1.inseq = 0; +#line 133 "" ioin__1.indir = 0; +#line 133 "" ioin__1.infmt = 0; +#line 133 "" ioin__1.inform = 0; +#line 133 "" ioin__1.inunf = 0; +#line 133 "" ioin__1.inrecl = 0; +#line 133 "" ioin__1.innrec = 0; +#line 133 "" ioin__1.inblank = 0; +#line 133 "" f_inqu(&ioin__1); +#line 134 "" if (! fexist) { +#line 135 "" s_wsle(&io___17); /* Writing concatenation */ +#line 135 "" i__3[0] = 17, a__1[0] = "Cannot find file "; +#line 135 "" i__3[1] = 27, a__1[1] = infileq; +#line 135 "" s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)44); +#line 135 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)44); +#line 135 "" e_wsle(); +#line 136 "" s_stop("", (ftnlen)0); +#line 137 "" } +#line 138 "" o__1.oerr = 0; +#line 138 "" o__1.ounit = 10; +#line 138 "" o__1.ofnmlen = ljob + 4; /* Writing concatenation */ +#line 138 "" i__3[0] = ljob, a__1[0] = jobname; +#line 138 "" i__3[1] = 4, a__1[1] = ".pmx"; +#line 138 "" s_cat(ch__2, a__1, i__3, &c__2, (ftnlen)31); +#line 138 "" o__1.ofnm = ch__2; +#line 138 "" o__1.orl = 0; +#line 138 "" o__1.osta = 0; +#line 138 "" o__1.oacc = 0; +#line 138 "" o__1.ofm = 0; +#line 138 "" o__1.oblnk = 0; +#line 138 "" f_open(&o__1); /* Open all instrument files now for allparts stuff. Later disgard those >nv */ +#line 142 "" for (iv = 1; iv <= 24; ++iv) { +#line 143 "" all_1.iorig[iv - 1] = iv; +#line 144 "" o__1.oerr = 0; +#line 144 "" o__1.ounit = iv + 10; +#line 144 "" o__1.ofnm = 0; +#line 144 "" o__1.orl = 0; +#line 144 "" o__1.osta = "SCRATCH"; +#line 144 "" o__1.oacc = 0; +#line 144 "" o__1.ofm = 0; +#line 144 "" o__1.oblnk = 0; +#line 144 "" f_open(&o__1); +#line 145 "" ludpfn[iv - 1] = 0; +#line 146 "" /* L19: */ +#line 146 "" } +#line 147 "" s_rsfe(&io___20); +#line 147 "" do_fio(&c__1, line, (ftnlen)128); +#line 147 "" e_rsfe(); +#line 148 "" chkcom_(line, (ftnlen)128); +#line 149 "" if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) { +#line 150 "" allparts_(line, &c__128, (ftnlen)128); +#line 151 "" L31: +#line 151 "" s_rsfe(&io___22); +#line 151 "" do_fio(&c__1, line, (ftnlen)128); +#line 151 "" e_rsfe(); +#line 152 "" if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) != 0) { +#line 153 "" allparts_(line, &c__128, (ftnlen)128); +#line 154 "" goto L31; +#line 155 "" } +#line 156 "" allparts_(line, &c__128, (ftnlen)128); +#line 157 "" s_rsfe(&io___23); +#line 157 "" do_fio(&c__1, line, (ftnlen)128); +#line 157 "" e_rsfe(); +#line 158 "" chkcom_(line, (ftnlen)128); +#line 159 "" } +#line 160 "" iccount = 0; +#line 161 "" nv = readin_(line, &iccount, &c__1, (ftnlen)128) + .1f; +#line 162 "" all_1.noinst = readin_(line, &iccount, &c__2, (ftnlen)128) + .1f; +#line 163 "" if (all_1.noinst > 0) { +#line 164 "" all_1.nvi[0] = nv - all_1.noinst + 1; +#line 165 "" } else { +#line 166 "" all_1.noinst = 1 - all_1.noinst; +#line 167 "" i__1 = all_1.noinst; +#line 167 "" for (iinst = 1; iinst <= i__1; ++iinst) { +#line 168 "" all_1.nvi[iinst - 1] = readin_(line, &iccount, &c_n1, (ftnlen)128) + .1f; +#line 169 "" /* L21: */ +#line 169 "" } +#line 170 "" } +#line 171 "" all_1.noinow = all_1.noinst; +#line 172 "" insnow = 1; /* ivlast is last iv in current inst. instnum(iv) is iinst for current voice. */ +#line 176 "" ivlast = all_1.nvi[0]; +#line 177 "" i__1 = nv; +#line 177 "" for (iv = 1; iv <= i__1; ++iv) { +#line 178 "" all_1.instnum[iv - 1] = insnow; +#line 179 "" if (iv == ivlast) { +#line 180 "" if (iv < nv) { +#line 180 "" all_1.botv[iv] = TRUE_; +#line 180 "" } /* The previous stmt will set botv true only for bot voice of iinst>1. It is */ /* used when writing termrpts, but the one in voice one is handled differently, */ /* so botv(1) is left .false. */ +#line 186 "" if (insnow < all_1.noinst) { +#line 187 "" ++insnow; +#line 188 "" ivlast += all_1.nvi[insnow - 1]; +#line 189 "" } +#line 190 "" } +#line 191 "" /* L22: */ +#line 191 "" } +#line 192 "" mtrnuml = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; +#line 193 "" mtrdenl = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; +#line 194 "" mtrnmp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; +#line 195 "" mtrdnp = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; +#line 196 "" xmtrnum0 = readin_(line, &iccount, &c__0, (ftnlen)128); +#line 197 "" isig = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; +#line 198 "" npages = readin_(line, &iccount, &c__3, (ftnlen)128) + .1f; +#line 199 "" all_1.nsyst = readin_(line, &iccount, &c__0, (ftnlen)128) + .1f; +#line 200 "" musicsize = readin_(line, &iccount, &c__4, (ftnlen)128) + .1f; +#line 201 "" fracindent = readin_(line, &iccount, &c__5, (ftnlen)128); +#line 202 "" if (npages == 0) { +#line 203 "" s_wsle(&io___38); - do_lio(&c__9, &c__1, "You entered npages=0, which means nsyst is not" +#line 203 "" + do_lio(&c__9, &c__1, "You entered npages=0, which means nsyst is not"\ " the total number", (ftnlen)63); +#line 203 "" e_wsle(); +#line 205 "" s_wsle(&io___39); - do_lio(&c__9, &c__1, "of systems. Scor2prt has to know the total nu" +#line 205 "" + do_lio(&c__9, &c__1, "of systems. Scor2prt has to know the total nu"\ "mber of systems.", (ftnlen)62); +#line 205 "" e_wsle(); +#line 207 "" s_wsle(&io___40); - do_lio(&c__9, &c__1, "Please set npages and nsyst to their real valu" +#line 207 "" + do_lio(&c__9, &c__1, "Please set npages and nsyst to their real valu"\ "es.", (ftnlen)49); +#line 207 "" e_wsle(); +#line 209 "" s_stop("", (ftnlen)0); +#line 210 "" } /* Must leave insetup=.true. else could bypass ALL instrument names. */ +#line 214 "" s_rsfe(&io___41); +#line 214 "" do_fio(&c__1, line, (ftnlen)128); +#line 214 "" e_rsfe(); +#line 215 "" chkcom_(line, (ftnlen)128); +#line 216 "" al__1.aerr = 0; +#line 216 "" al__1.aunit = 10; +#line 216 "" f_back(&al__1); /* Normally this puts pointer at start of line with 1st inst name */ /* Check if prior line was "%%" */ +#line 221 "" al__1.aerr = 0; +#line 221 "" al__1.aunit = 10; +#line 221 "" f_back(&al__1); +#line 222 "" s_rsfe(&io___42); +#line 222 "" do_fio(&c__1, line, (ftnlen)128); +#line 222 "" e_rsfe(); +#line 223 "" if (s_cmp(line, "%%", (ftnlen)2, (ftnlen)2) == 0) { +#line 223 "" al__1.aerr = 0; +#line 223 "" al__1.aunit = 10; +#line 223 "" f_back(&al__1); +#line 223 "" } +#line 224 "" i__1 = all_1.noinst; +#line 224 "" for (iv = 1; iv <= i__1; ++iv) { +#line 225 "" gotname = FALSE_; +#line 226 "" L16: +#line 226 "" s_rsfe(&io___44); +#line 226 "" do_fio(&c__1, instrum + (iv - 1 << 7), (ftnlen)128); +#line 226 "" e_rsfe(); +#line 227 "" if (s_cmp(instrum + (iv - 1 << 7), "%%", (ftnlen)2, (ftnlen)2) == 0) { +#line 228 "" s_rsfe(&io___46); +#line 228 "" do_fio(&c__1, line, (ftnlen)128); +#line 228 "" e_rsfe(); +#line 229 "" goto L16; +#line 230 "" } else if (*(unsigned char *)&instrum[(iv - 1) * 128] == '%') { +#line 231 "" ivq = *(unsigned char *)&instrum[(iv - 1 << 7) + 1] - 48; +#line 232 "" if (ivq != iv) { /* It's really a comment. Copy to parts, then get another trial name. */ +#line 236 "" allparts_(instrum + (iv - 1 << 7), &c__128, (ftnlen)128); +#line 237 "" goto L16; +#line 238 "" } else { +#line 239 "" s_copy(line, instrum + ((iv - 1 << 7) + 2), (ftnlen)128, ( ftnlen)126); +#line 240 "" s_copy(instrum + (iv - 1 << 7), line, (ftnlen)128, (ftnlen) 128); +#line 241 "" gotname = TRUE_; +#line 242 "" } +#line 243 "" } else { +#line 244 "" gotname = TRUE_; +#line 245 "" } /* c */ /* c The following checks for macro that write original C-clef as part of */ @@ -529,67 +740,117 @@ L16: /* * char(iy1+49)//char(iy2+49) */ /* instrum(iv) = instrum(iv)(inm1:inm2) */ /* end if */ +#line 260 "" if (! gotname) { +#line 261 "" s_wsle(&io___48); - do_lio(&c__9, &c__1, "You must provide a replacement instrument " +#line 261 "" + do_lio(&c__9, &c__1, "You must provide a replacement instrument "\ "name", (ftnlen)46); +#line 261 "" e_wsle(); +#line 262 "" s_stop("", (ftnlen)0); +#line 263 "" } +#line 264 "" io___49.ciunit = iv + 10; +#line 264 "" s_wsfe(&io___49); +#line 264 "" do_fio(&c__1, " ", (ftnlen)1); +#line 264 "" e_wsfe(); +#line 265 "" /* L14: */ +#line 265 "" } +#line 266 "" all_1.replacing = FALSE_; +#line 267 "" all_1.nvnow = nv; /* Clef string: Note insetup is still T, so "%%" will be treated specially */ +#line 271 "" s_rsfe(&io___50); +#line 271 "" do_fio(&c__1, line, (ftnlen)128); +#line 271 "" e_rsfe(); +#line 272 "" chkcom_(line, (ftnlen)128); +#line 273 "" if (all_1.replacing) { /* If here, we have next line after "%%", containing score's clef string */ /* Assume all clefs are handled with instrument comments. */ +#line 278 "" s_rsfe(&io___51); +#line 278 "" do_fio(&c__1, line, (ftnlen)128); +#line 278 "" e_rsfe(); +#line 279 "" chkcom_(line, (ftnlen)128); +#line 280 "" al__1.aerr = 0; +#line 280 "" al__1.aunit = 10; +#line 280 "" f_back(&al__1); +#line 281 "" } else { /* If here, line has the clef string in it. Handle the old way */ +#line 285 "" kvstart = 1; +#line 286 "" kvend = all_1.nvi[0]; +#line 287 "" i__1 = all_1.noinst; +#line 287 "" for (inst = 1; inst <= i__1; ++inst) { +#line 288 "" ci__1.cierr = 0; +#line 288 "" ci__1.ciunit = inst + 10; /* Writing concatenation */ +#line 288 "" i__4[0] = 2, a__2[0] = "(a"; +#line 288 "" *(unsigned char *)&ch__4[0] = all_1.nvi[inst - 1] + 48; +#line 288 "" i__4[1] = 1, a__2[1] = ch__4; +#line 288 "" i__4[2] = 1, a__2[2] = ")"; +#line 288 "" ci__1.cifmt = (s_cat(ch__3, a__2, i__4, &c__3, (ftnlen)4), ch__3); +#line 288 "" s_wsfe(&ci__1); +#line 288 "" do_fio(&c__1, line + (kvstart - 1), kvend - (kvstart - 1)); +#line 288 "" e_wsfe(); +#line 290 "" if (inst < all_1.noinst) { +#line 291 "" kvstart = kvend + 1; +#line 292 "" kvend = kvstart + all_1.nvi[inst] - 1; +#line 293 "" } +#line 294 "" /* L2: */ +#line 294 "" } +#line 295 "" } +#line 296 "" all_1.replacing = FALSE_; +#line 297 "" all_1.insetup = FALSE_; /* *****NOTE*****This comment applies to stuff done earlier! */ @@ -600,29 +861,50 @@ L16: /* Path string: ASSUME THIS WILL NEVER BE ALTERED IN PARTS! */ +#line 307 "" L18: +#line 307 "" s_rsfe(&io___55); +#line 307 "" do_fio(&c__1, line, (ftnlen)128); +#line 307 "" e_rsfe(); +#line 308 "" if (*(unsigned char *)line == '%') { +#line 309 "" allparts_(line, &c__128, (ftnlen)128); +#line 310 "" goto L18; +#line 311 "" } +#line 312 "" allparts_(line, &c__128, (ftnlen)128); /* Write instrument names. Will be blank if later part of a score. */ +#line 316 "" if (*(unsigned char *)&instrum[0] != ' ') { +#line 317 "" i__1 = all_1.noinst; +#line 317 "" for (iv = 1; iv <= i__1; ++iv) { +#line 318 "" len = lenstr_(instrum + (iv - 1 << 7), &c__79, (ftnlen)128); +#line 319 "" io___57.ciunit = iv + 10; +#line 319 "" s_wsfe(&io___57); +#line 319 "" do_fio(&c__1, "Ti", (ftnlen)2); +#line 319 "" do_fio(&c__1, instrum + (iv - 1 << 7), len); +#line 319 "" e_wsfe(); +#line 320 "" /* L3: */ +#line 320 "" } +#line 321 "" } /* The big loop. Except for '%%', put all comment lines in all parts. */ @@ -635,292 +917,475 @@ L18: /* Check for "P"; ignore in parts. */ /* Check for consecutive full-bar rests; if found, replace with rm[nn] */ +#line 333 "" iv = 1; +#line 334 "" iinst = 1; +#line 335 "" termrpt = FALSE_; +#line 336 "" L4: +#line 336 "" i__1 = s_rsfe(&io___59); +#line 336 "" if (i__1 != 0) { +#line 336 "" goto L999; +#line 336 "" } +#line 336 "" i__1 = do_fio(&c__1, line, (ftnlen)128); +#line 336 "" if (i__1 != 0) { +#line 336 "" goto L999; +#line 336 "" } +#line 336 "" i__1 = e_rsfe(); +#line 336 "" if (i__1 != 0) { +#line 336 "" goto L999; +#line 336 "" } +#line 337 "" lenline = lenstr_(line, &c__128, (ftnlen)128); +#line 338 "" if (lenline == 0) { +#line 338 "" goto L4; +#line 338 "" } +#line 339 "" zapbl_(line, &c__128, (ftnlen)128); +#line 340 "" chkcom_(line, (ftnlen)128); +#line 341 "" lenline = lenstr_(line, &c__128, (ftnlen)128); +#line 342 "" if (lenline == 0) { +#line 342 "" goto L4; +#line 342 "" } +#line 343 "" if (*(unsigned char *)line == 'T') { +#line 344 "" allparts_(line, &c__128, (ftnlen)128); +#line 345 "" s_rsfe(&io___61); +#line 345 "" do_fio(&c__1, line, (ftnlen)128); +#line 345 "" e_rsfe(); +#line 346 "" allparts_(line, &c__128, (ftnlen)128); +#line 347 "" goto L4; +#line 348 "" } else /* if(complicated condition) */ { /* Writing concatenation */ +#line 348 "" i__3[0] = 1, a__1[0] = sq; +#line 348 "" i__3[1] = 1, a__1[1] = sq; +#line 348 "" s_cat(ch__5, a__1, i__3, &c__2, (ftnlen)2); +#line 348 "" if (s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0) { +#line 349 "" allparts_(line, &c__128, (ftnlen)128); +#line 350 "" goto L4; +#line 351 "" } else if (i_indx("hl", line, (ftnlen)2, (ftnlen)1) > 0 && i_indx( " +-", line + 1, (ftnlen)3, (ftnlen)1) > 0) { +#line 353 "" allparts_(line, &c__128, (ftnlen)128); +#line 354 "" s_rsfe(&io___62); +#line 354 "" do_fio(&c__1, line, (ftnlen)128); +#line 354 "" e_rsfe(); +#line 355 "" allparts_(line, &c__128, (ftnlen)128); +#line 356 "" goto L4; +#line 357 "" } else if (iv == 1) { +#line 358 "" for (ia = 1; ia <= 10; ++ia) { +#line 359 "" L24: +#line 360 "" idxa = ntindex_(line, achar + (ia - 1), (ftnlen)128, (ftnlen) 1); +#line 361 "" isachar = idxa > 0; +#line 362 "" if (idxa > 1) { +#line 362 "" i__1 = idxa - 2; +#line 362 "" isachar = s_cmp(line + i__1, " ", idxa - 1 - i__1, ( ftnlen)1) == 0; +#line 362 "" } /* 1 2 3 4 5 6 7 8 9 10 */ /* data achar /'P','m','V','R','A','h','w','K','M','I'/ */ +#line 367 "" if (ia == 9) { +#line 367 "" i__1 = idxa; +#line 367 "" isachar = isachar && s_cmp(line + i__1, "S", idxa + 1 - i__1, (ftnlen)1) == 0; +#line 367 "" } +#line 369 "" if (isachar) { /* Check whether character is inside a quoted string by counting */ /* how many quotes precede it in the line */ +#line 375 "" oddquotesbefore_(line, &idxa, &yesodd, (ftnlen)128); +#line 376 "" if (yesodd) { +#line 376 "" isachar = FALSE_; +#line 376 "" } +#line 377 "" } +#line 378 "" if (isachar) { /* Find next blank */ +#line 382 "" for (ib = idxa + 1; ib <= 128; ++ib) { +#line 383 "" if (*(unsigned char *)&line[ib - 1] == ' ') { +#line 383 "" goto L7; +#line 383 "" } +#line 384 "" /* L6: */ +#line 384 "" } +#line 385 "" s_wsle(&io___68); - do_lio(&c__9, &c__1, "Problem with \"V,R,m,P,A,h,MS, o" +#line 385 "" + do_lio(&c__9, &c__1, "Problem with \"V,R,m,P,A,h,MS, o"\ "r w\"", (ftnlen)35); +#line 385 "" e_wsle(); +#line 386 "" s_wsle(&io___69); - do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons a" +#line 386 "" + do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons a"\ "t roadrunner dot com", (ftnlen)54); +#line 386 "" e_wsle(); +#line 388 "" s_stop("1", (ftnlen)1); +#line 389 "" L7: /* Next blank is at position ib. Later, if ia=1, must check for Pc" " ; */ /* i.e., look for '"' between P and blank */ +#line 394 "" if (ia == 4) { /* Check for terminal repeat. Note if there's a term rpt, there can't be any */ /* others. Also, must process repeats LAST, after m's and 'V's */ +#line 399 "" for (ic = ib + 1; ic <= 128; ++ic) { /* If any subsequent character on this line is neither blank nor "/", get out */ +#line 403 "" if (i_indx(" /", line + (ic - 1), (ftnlen)2, ( ftnlen)1) == 0) { +#line 403 "" goto L9; +#line 403 "" } +#line 404 "" if (*(unsigned char *)&line[ic - 1] == '/') { +#line 405 "" termrpt = TRUE_; +#line 406 "" i__1 = ib - 3; +#line 406 "" s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 - i__1); /* Process the line as if there were no "R" */ +#line 410 "" goto L10; +#line 411 "" } +#line 412 "" /* L8: */ +#line 412 "" } /* +++ 060812 */ /* If here, all chars after "R" symbol are blanks, so process the line normally, */ /* but only IF next line is not the M-Tx line " /" */ +#line 418 "" s_rsfe(&io___72); +#line 418 "" do_fio(&c__1, templine, (ftnlen)128); +#line 418 "" e_rsfe(); +#line 419 "" if (s_cmp(templine, " /", (ftnlen)2, (ftnlen)2) != 0) { +#line 420 "" al__1.aerr = 0; +#line 420 "" al__1.aunit = 10; +#line 420 "" f_back(&al__1); /* and flow out */ +#line 421 "" } else { /* We have the M-Tx case where one line ends with R? and next is " /". Add / to the line, */ /* and proceed as above */ /* Writing concatenation */ +#line 426 "" i__3[0] = ib, a__1[0] = line; +#line 426 "" i__3[1] = 1, a__1[1] = "/"; +#line 426 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 427 "" lenline += 2; +#line 428 "" termrpt = TRUE_; +#line 429 "" i__1 = ib - 3; +#line 429 "" s_copy(termsym, line + i__1, (ftnlen)2, ib - 1 - i__1); +#line 430 "" goto L10; +#line 431 "" } /* +++ 060812 */ +#line 434 "" } else if (ia == 1) { +#line 435 "" idxq = ntindex_(line, "\"", (ftnlen)128, (ftnlen)1); +#line 436 "" if (idxq > idxa && idxq < ib) { /* Quote is between P and next blank. Find 2nd quote, starting at the blank. */ +#line 440 "" idxq2 = ib - 1 + ntindex_(line, "\"", (ftnlen)128, (ftnlen)1); +#line 441 "" i__1 = idxq2; +#line 441 "" if (idxq == 0 || s_cmp(line + i__1, " ", idxq2 + 1 - i__1, (ftnlen)1) != 0) { +#line 442 "" s_wsle(&io___76); +#line 442 "" e_wsle(); +#line 443 "" s_wsle(&io___77); - do_lio(&c__9, &c__1, "Error copying P with q" +#line 443 "" + do_lio(&c__9, &c__1, "Error copying P with q"\ "uotes, idxq2:", (ftnlen)35); +#line 443 "" do_lio(&c__3, &c__1, (char *)&idxq2, (ftnlen) sizeof(integer)); +#line 443 "" e_wsle(); +#line 444 "" s_wsle(&io___78); +#line 444 "" do_lio(&c__9, &c__1, line, (ftnlen)60); +#line 444 "" e_wsle(); +#line 445 "" s_stop("1", (ftnlen)1); +#line 446 "" } +#line 447 "" ib = idxq2 + 1; +#line 448 "" } /* Do not transfer P into parts. */ +#line 452 "" goto L12; +#line 453 "" } else if (ia == 9) { /* Start Saving a macro. After leaving here, a symbol will be sent to all parts, */ /* If all on this line, set ib to end and exit normally. */ +#line 458 "" i__1 = ib; +#line 458 "" ndxm = i_indx(line + i__1, "M", 128 - i__1, (ftnlen)1) ; +#line 459 "" i__1 = ib + ndxm - 2; +#line 459 "" if (ndxm > 0 && s_cmp(line + i__1, " ", ib + ndxm - 1 - i__1, (ftnlen)1) == 0) { /* Macro ends on this line */ +#line 463 "" ib = ib + ndxm + 1; +#line 464 "" } else { /* Save leading part of current line */ +#line 468 "" lenhold = idxa - 1; +#line 469 "" if (lenhold > 0) { +#line 469 "" s_copy(holdln, line, (ftnlen)128, lenhold); +#line 469 "" } /* Transfer rest of line */ +#line 473 "" i__1 = 129 - idxa; +#line 473 "" allparts_(line + (idxa - 1), &i__1, 128 - (idxa - 1)); /* Read next line */ +#line 477 "" L20: +#line 477 "" s_rsfe(&io___81); +#line 477 "" do_fio(&c__1, line, (ftnlen)128); +#line 477 "" e_rsfe(); /* Check for comment, transfer and loop if so */ /* if (line(1:1) .eq.'%') then */ +#line 482 "" L23: +#line 482 "" if (*(unsigned char *)line == '%') { /* call allparts(line,128) */ /* go to 20 */ +#line 485 "" chkcom_(line, (ftnlen)128); +#line 486 "" goto L23; +#line 487 "" } /* Look for terminal ' M' */ +#line 491 "" if (*(unsigned char *)line == 'M') { +#line 492 "" ndxm = 1; +#line 493 "" } else { +#line 494 "" ndxm = i_indx(line, " M", (ftnlen)128, ( ftnlen)2); +#line 495 "" if (ndxm > 0) { +#line 495 "" ++ndxm; +#line 495 "" } +#line 496 "" } +#line 497 "" if (ndxm > 0) { /* Set parameters, exit normally (but later check for leading part of 1st line */ +#line 501 "" idxa = 1; +#line 502 "" ib = ndxm + 1; +#line 503 "" } else { /* No "M", transfer entire line, loop */ +#line 507 "" allparts_(line, &c__128, (ftnlen)128); +#line 508 "" goto L20; +#line 509 "" } +#line 510 "" } +#line 511 "" } else if (ia == 10) { /* Do not transfer MIDI command into parts */ +#line 515 "" goto L12; +#line 516 "" } else if (ia == 5) { /* First check for "AS", but S may come after other "A" options */ +#line 520 "" i__1 = idxa; +#line 520 "" idxs = i_indx(line + i__1, "S", ib - i__1, (ftnlen)1); +#line 521 "" if (idxs > 0) { /* Get rid of the string. First check if that's all there is in A. */ +#line 525 "" if (ib - idxa == nv + 2) { +#line 525 "" goto L12; +#line 525 "" } +#line 526 "" i__1 = idxa + idxs + nv; /* Writing concatenation */ +#line 526 "" i__3[0] = idxa + idxs - 1, a__1[0] = line; +#line 526 "" i__3[1] = ib - i__1, a__1[1] = line + i__1; +#line 526 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 527 "" } /* Check for user-defined part file name. Must start in column 1 and have */ @@ -929,219 +1394,353 @@ L23: /* ib is position of the next blank after "A" */ /* Don't allow any blanks in user */ +#line 535 "" i__1 = idxa; +#line 535 "" if (s_cmp(line + i__1, "N", idxa + 1 - i__1, (ftnlen) 1) != 0) { +#line 535 "" goto L9; +#line 535 "" } /* bail out */ +#line 536 "" if (idxa != 1) { +#line 537 "" s_wsle(&io___83); +#line 537 "" e_wsle(); +#line 538 "" s_wsle(&io___84); - do_lio(&c__9, &c__1, "You entered \"AN...\" some" +#line 538 "" + do_lio(&c__9, &c__1, "You entered \"AN...\" some"\ "where beyond first column; stopping.", ( ftnlen)60); +#line 538 "" e_wsle(); +#line 540 "" s_stop("1", (ftnlen)1); +#line 541 "" } /* pmxa already checked for valid one- or 2-digit number, so get it */ +#line 545 "" if (*(unsigned char *)&line[3] == '"') { /* Single digit instrument number */ +#line 549 "" s_rsfi(&io___85); +#line 549 "" do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof( integer)); +#line 549 "" e_rsfi(); +#line 550 "" idxstartname = 5; +#line 551 "" } else { +#line 552 "" s_rsfi(&io___88); +#line 552 "" do_fio(&c__1, (char *)&iudpfn, (ftnlen)sizeof( integer)); +#line 552 "" e_rsfi(); +#line 553 "" idxstartname = 6; +#line 554 "" } +#line 555 "" ludpfn[iudpfn - 1] = i_indx(line + (idxstartname - 1), "\"", 128 - (idxstartname - 1), (ftnlen)1) - 1; +#line 556 "" if (ludpfn[iudpfn - 1] < 0) { +#line 557 "" s_wsle(&io___89); +#line 557 "" e_wsle(); +#line 558 "" s_wsle(&io___90); - do_lio(&c__9, &c__1, "User-defined part file nam" +#line 558 "" + do_lio(&c__9, &c__1, "User-defined part file nam"\ "e must be in quotes", (ftnlen)45); +#line 558 "" e_wsle(); +#line 559 "" s_stop("1", (ftnlen)1); +#line 560 "" } +#line 561 "" idxendname = idxstartname + ludpfn[iudpfn - 1] - 1; +#line 562 "" s_copy(udpfnq + (iudpfn - 1 << 7), line + ( idxstartname - 1), (ftnlen)128, idxendname - ( idxstartname - 1)); /* Get a new line! */ +#line 566 "" goto L4; +#line 567 "" } else if (ia == 8) { /* Key change/transposition. */ /* If not instrument specific, copy to all parts */ +#line 572 "" i__1 = idxa; +#line 572 "" if (s_cmp(line + i__1, "i", idxa + 1 - i__1, (ftnlen) 1) != 0) { +#line 572 "" goto L9; +#line 572 "" } /* Instrument-wise key/transposition(s): Ki[nn][+/-][dd}[+/-][dd]... */ +#line 576 "" ibb = idxa + 2; /* Starts on digit after 'i' */ +#line 577 "" L40: +#line 578 "" ici__1.icierr = 0; +#line 578 "" ici__1.iciend = 0; +#line 578 "" ici__1.icirnum = 1; +#line 578 "" ici__1.icirlen = 1; +#line 578 "" ici__1.iciunit = line + (ibb - 1); +#line 578 "" ici__1.icifmt = "(i1)"; +#line 578 "" s_rsfi(&ici__1); +#line 578 "" do_fio(&c__1, (char *)&iiinst, (ftnlen)sizeof(integer) ); +#line 578 "" e_rsfi(); /* 1st digit of iinst */ +#line 579 "" i__1 = ibb; +#line 579 "" itemp = i_indx("01234567890", line + i__1, (ftnlen)11, ibb + 1 - i__1); +#line 580 "" if (itemp > 0) { +#line 581 "" ++ibb; +#line 582 "" iiinst = iiinst * 10 + itemp - 1; +#line 583 "" } +#line 584 "" ++ibb; /* now at first +/-. Need end of 2nd number */ +#line 585 "" i__1 = ibb; +#line 585 "" itemp = i_indx(line + i__1, "i", ib - i__1, (ftnlen)1) ; /* Rel pos'n of next 'i' */ +#line 586 "" if (itemp > 0) { +#line 587 "" iend = ibb + itemp - 1; +#line 588 "" } else { +#line 589 "" iend = ib - 1; +#line 590 "" } +#line 591 "" io___97.ciunit = all_1.iorig[iiinst - 1] + 10; +#line 591 "" s_wsfe(&io___97); /* Writing concatenation */ +#line 591 "" i__3[0] = 3, a__1[0] = "Ki1"; +#line 591 "" i__3[1] = iend - (ibb - 1), a__1[1] = line + (ibb - 1) ; +#line 591 "" s_cat(ch__6, a__1, i__3, &c__2, (ftnlen)131); +#line 591 "" do_fio(&c__1, ch__6, iend - (ibb - 1) + 3); +#line 591 "" e_wsfe(); +#line 592 "" if (itemp > 0) { +#line 593 "" ibb = iend + 2; +#line 594 "" goto L40; +#line 595 "" } +#line 596 "" goto L12; /* Remove K command from string, go to next ia */ +#line 597 "" } +#line 598 "" L9: +#line 599 "" i__1 = ib - idxa; +#line 599 "" allparts_(line + (idxa - 1), &i__1, ib - 1 - (idxa - 1)); +#line 600 "" L12: /* Remove the string from line */ +#line 604 "" if (idxa == 1) { +#line 605 "" s_copy(line, line + (ib - 1), (ftnlen)128, 128 - (ib - 1)); +#line 606 "" } else { /* Writing concatenation */ +#line 607 "" i__3[0] = idxa - 1, a__1[0] = line; +#line 607 "" i__3[1] = 128 - (ib - 1), a__1[1] = line + (ib - 1); +#line 607 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 608 "" } +#line 609 "" lenline = lenstr_(line, &c__128, (ftnlen)128); /* Loop if only blanks are left */ +#line 613 "" if (lenline == 0) { +#line 613 "" goto L4; +#line 613 "" } /* Must check for multiple "I" commands, so go to just after start of ia loop */ +#line 617 "" if (ia == 10) { +#line 617 "" goto L24; +#line 617 "" } /* Tack on front part from 1st line of saved macro */ +#line 621 "" if (lenhold > 0) { /* Writing concatenation */ +#line 622 "" i__4[0] = lenhold, a__2[0] = holdln; +#line 622 "" i__4[1] = 1, a__2[1] = " "; +#line 622 "" i__4[2] = lenline, a__2[2] = line; +#line 622 "" s_cat(line, a__2, i__4, &c__3, (ftnlen)128); +#line 623 "" lenhold = 0; +#line 624 "" } +#line 625 "" } +#line 626 "" /* L5: */ +#line 626 "" } +#line 627 "" } +#line 627 "" } /* Now a special loop to deal with 'X'. If it was %[n]X..., will have been */ /* copied into part [n] already. If no "B" or "P", remove. If "P", just */ /* remove the "P" so pmxa/b will process. If "B". do nothing. */ +#line 633 "" L10: +#line 634 "" nchk = 1; +#line 635 "" L13: +#line 635 "" ntinx = nchk - 1 + ntindex_(line + (nchk - 1), "X", 128 - (nchk - 1), ( ftnlen)1); +#line 636 "" if (ntinx > nchk - 1) { /* There is a non-TeX 'X' at ntinx. Loop if neither 1st nor after a blank. */ +#line 640 "" if (ntinx > 1) { +#line 641 "" i__1 = ntinx - 2; +#line 641 "" if (s_cmp(line + i__1, " ", ntinx - 1 - i__1, (ftnlen)1) != 0) { /* The X is not 1st char of PMX command. Advance starting point, loop. */ +#line 645 "" nchk = ntinx + 1; +#line 646 "" goto L13; +#line 647 "" } +#line 648 "" } /* We now know the X at ntinx starts a PMX command. Find next blank */ +#line 652 "" i__1 = ntinx; +#line 652 "" ib = ntinx + i_indx(line + i__1, " ", 128 - i__1, (ftnlen)1); /* There must be a blank to right of "X", so ib>ntinx */ /* locp = nchk-1+index(line(nchk:ib),'P') */ +#line 657 "" i__1 = ntinx; +#line 657 "" locp = ntinx + i_indx(line + i__1, "P", ib - i__1, (ftnlen)1); /* Did not need to use ntindex because we already know bounds of PMX command. */ /* if (locp .gt. nchk-1) then */ +#line 662 "" if (locp > ntinx) { /* Strip out the 'P' */ +#line 666 "" s_copy(templine, line, (ftnlen)128, locp - 1); +#line 667 "" i__1 = locp; /* Writing concatenation */ +#line 667 "" i__3[0] = locp - 1, a__1[0] = templine; +#line 667 "" i__3[1] = lenline - i__1, a__1[1] = line + i__1; +#line 667 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 668 "" --lenline; +#line 669 "" --ib; +#line 670 "" } +#line 671 "" if (i_indx(line + (ntinx - 1), ":", ib - (ntinx - 1), (ftnlen)1) > 0 || i_indx(line + (ntinx - 1), "S", ib - (ntinx - 1), (ftnlen) 1) > 0 || i_indx(line + (ntinx - 1), "B", ib - (ntinx - 1), ( @@ -1149,105 +1748,177 @@ L13: /* The X command is a shift, "Both", or "Part". Do not remove. */ +#line 677 "" nchk = ib + 1; +#line 678 "" goto L13; +#line 679 "" } /* Remove the X command. */ +#line 683 "" if (ntinx == 1) { +#line 684 "" if (ib < lenline) { +#line 685 "" i__1 = ib; +#line 685 "" s_copy(line, line + i__1, (ftnlen)128, lenline - i__1); +#line 686 "" } else { /* line contains ONLY the "X" command, so get a new line */ +#line 690 "" goto L4; +#line 691 "" } +#line 692 "" } else { +#line 693 "" s_copy(templine, line, (ftnlen)128, ntinx - 1); +#line 694 "" if (ib < lenline) { +#line 695 "" i__1 = ib; /* Writing concatenation */ +#line 695 "" i__3[0] = ntinx - 1, a__1[0] = templine; +#line 695 "" i__3[1] = lenline - i__1, a__1[1] = line + i__1; +#line 695 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 696 "" } else { +#line 697 "" s_copy(line, templine, (ftnlen)128, ntinx - 1); +#line 698 "" } +#line 699 "" } /* Recompute lenline */ +#line 703 "" lenline = lenstr_(line, &c__128, (ftnlen)128); /* Resume checking after location of removed command. */ +#line 707 "" nchk = ntinx; +#line 708 "" goto L13; +#line 709 "" } /* End of loop for X-checks */ +#line 713 "" oneof2 = ntindex_(line, "//", (ftnlen)128, (ftnlen)2) > 0; +#line 714 "" if (termrpt && all_1.botv[iv - 1] && frstln && *(unsigned char *)&line[ lenline - 1] == '/') { /* Must add a terminal repeat before the slash */ +#line 719 "" if (oneof2) { +#line 719 "" --lenline; +#line 719 "" } +#line 720 "" if (lenline > 1) { +#line 720 "" io___102.ciunit = all_1.iorig[iinst - 1] + 10; +#line 720 "" s_wsfe(&io___102); +#line 720 "" do_fio(&c__1, line, lenline - 1); +#line 720 "" e_wsfe(); +#line 720 "" } +#line 721 "" if (! oneof2) { /* Writing concatenation */ +#line 722 "" i__3[0] = 2, a__1[0] = termsym; +#line 722 "" i__3[1] = 2, a__1[1] = " /"; +#line 722 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 723 "" lenline = 4; +#line 724 "" } else { /* Writing concatenation */ +#line 725 "" i__3[0] = 2, a__1[0] = termsym; +#line 725 "" i__3[1] = 3, a__1[1] = " //"; +#line 725 "" s_cat(line, a__1, i__3, &c__2, (ftnlen)128); +#line 726 "" lenline = 5; +#line 727 "" } +#line 728 "" } +#line 729 "" if (termrpt && frstln && *(unsigned char *)&line[lenline - 1] == '/' && iv == all_1.nvnow) { +#line 729 "" termrpt = FALSE_; +#line 729 "" } +#line 731 "" io___103.ciunit = all_1.iorig[iinst - 1] + 10; +#line 731 "" s_wsfe(&io___103); +#line 731 "" do_fio(&c__1, line, lenline); +#line 731 "" e_wsfe(); +#line 732 "" if (oneof2) { +#line 733 "" frstln = FALSE_; +#line 734 "" } else if (! frstln) { +#line 735 "" frstln = TRUE_; +#line 736 "" } /* if (ntindex(line,'/').gt.0 .and. index(line,'//').eq.0) then */ +#line 738 "" if (ntindex_(line, "/", (ftnlen)128, (ftnlen)1) > 0 && ntindex_(line, "//", (ftnlen)128, (ftnlen)2) == 0) { +#line 739 "" iv = iv % all_1.nvnow + 1; +#line 740 "" iinst = all_1.instnum[iv - 1]; +#line 741 "" } +#line 742 "" goto L4; +#line 743 "" L999: +#line 744 "" cl__1.cerr = 0; +#line 744 "" cl__1.cunit = 10; +#line 744 "" cl__1.csta = 0; +#line 744 "" f_clos(&cl__1); /* In the mbrest checks, must run through ALL noinst files (not just noinow) */ +#line 748 "" i__1 = all_1.noinst; +#line 748 "" for (iinst = 1; iinst <= i__1; ++iinst) { /* cc+++ */ /* c */ @@ -1267,19 +1938,28 @@ L999: /* 51 continue */ /* close(40) */ /* cc+++ */ +#line 767 "" if (all_1.nvi[iinst - 1] == 1) { +#line 768 "" mbrests_(&iinst, jobname, &ljob, &ludpfn[iinst - 1], udpfnq + ( iinst - 1 << 7), (ftnlen)27, (ftnlen)128); +#line 769 "" } else { /* Send a signal with ljob to bypass most mbrest processing */ +#line 773 "" i__2 = -ljob; +#line 773 "" mbrests_(&iinst, jobname, &i__2, &ludpfn[iinst - 1], udpfnq + ( iinst - 1 << 7), (ftnlen)27, (ftnlen)128); +#line 774 "" } +#line 775 "" /* L11: */ +#line 775 "" } +#line 776 "" return 0; } /* MAIN__ */ @@ -1288,13 +1968,21 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) /* System generated locals */ integer ret_val; +#line 779 "" for (ret_val = *n; ret_val >= 1; --ret_val) { +#line 780 "" if (*(unsigned char *)&string[ret_val - 1] != ' ') { +#line 780 "" return ret_val; +#line 780 "" } +#line 781 "" /* L1: */ +#line 781 "" } +#line 782 "" ret_val = 0; +#line 783 "" return ret_val; } /* lenstr_ */ @@ -1315,19 +2003,33 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) static cilist io___106 = { 0, 0, 0, "(a)", 0 }; +#line 791 "" len = lenstr_(string, n, string_len); +#line 792 "" if (len == 0) { +#line 793 "" len = 1; +#line 794 "" s_copy(string, " ", string_len, (ftnlen)1); +#line 795 "" } +#line 796 "" i__1 = all_1.noinow; +#line 796 "" for (iinst = 1; iinst <= i__1; ++iinst) { +#line 797 "" io___106.ciunit = all_1.iorig[iinst - 1] + 10; +#line 797 "" s_wsfe(&io___106); +#line 797 "" do_fio(&c__1, string, len); +#line 797 "" e_wsfe(); +#line 798 "" /* L1: */ +#line 798 "" } +#line 799 "" return 0; } /* allparts_ */ @@ -1411,413 +2113,731 @@ integer lenstr_(char *string, integer *n, ftnlen string_len) static cilist io___161 = { 0, 40, 0, "(a)", 0 }; +#line 809 "" type4 = FALSE_; +#line 810 "" *(unsigned char *)sq = '\\'; +#line 811 "" alldone = FALSE_; +#line 812 "" al__1.aerr = 0; +#line 812 "" al__1.aunit = *iv + 10; +#line 812 "" f_rew(&al__1); +#line 813 "" if (*iv < 10) { +#line 814 "" *(unsigned char *)partq = (char) (*iv + 48); +#line 815 "" lpart = 1; +#line 816 "" } else { +#line 817 "" lpart = 2; +#line 818 "" if (*iv < 20) { /* Writing concatenation */ +#line 819 "" i__1[0] = 1, a__1[0] = "1"; +#line 819 "" *(unsigned char *)&ch__1[0] = *iv + 38; +#line 819 "" i__1[1] = 1, a__1[1] = ch__1; +#line 819 "" s_cat(partq, a__1, i__1, &c__2, (ftnlen)2); +#line 820 "" } else { /* Writing concatenation */ +#line 821 "" i__1[0] = 1, a__1[0] = "2"; +#line 821 "" *(unsigned char *)&ch__1[0] = *iv + 28; +#line 821 "" i__1[1] = 1, a__1[1] = ch__1; +#line 821 "" s_cat(partq, a__1, i__1, &c__2, (ftnlen)2); +#line 822 "" } +#line 823 "" } /* 130327 */ /* open(40,file=jobname(1:abs(ljob))//partq(1:lpart)//'.pmx') */ +#line 826 "" if (*ludpfn == 0) { +#line 827 "" o__1.oerr = 0; +#line 827 "" o__1.ounit = 40; +#line 827 "" o__1.ofnmlen = abs(*ljob) + lpart + 4; /* Writing concatenation */ +#line 827 "" i__2[0] = abs(*ljob), a__2[0] = jobname; +#line 827 "" i__2[1] = lpart, a__2[1] = partq; +#line 827 "" i__2[2] = 4, a__2[2] = ".pmx"; +#line 827 "" s_cat(ch__2, a__2, i__2, &c__3, (ftnlen)18); +#line 827 "" o__1.ofnm = ch__2; +#line 827 "" o__1.orl = 0; +#line 827 "" o__1.osta = 0; +#line 827 "" o__1.oacc = 0; +#line 827 "" o__1.ofm = 0; +#line 827 "" o__1.oblnk = 0; +#line 827 "" f_open(&o__1); +#line 828 "" } else { +#line 829 "" o__1.oerr = 0; +#line 829 "" o__1.ounit = 40; +#line 829 "" o__1.ofnmlen = *ludpfn + 4; /* Writing concatenation */ +#line 829 "" i__1[0] = *ludpfn, a__1[0] = udpfnq; +#line 829 "" i__1[1] = 4, a__1[1] = ".pmx"; +#line 829 "" s_cat(ch__3, a__1, i__1, &c__2, (ftnlen)132); +#line 829 "" o__1.ofnm = ch__3; +#line 829 "" o__1.orl = 0; +#line 829 "" o__1.osta = 0; +#line 829 "" o__1.oacc = 0; +#line 829 "" o__1.ofm = 0; +#line 829 "" o__1.oblnk = 0; +#line 829 "" f_open(&o__1); +#line 830 "" } +#line 831 "" for (i__ = 1; i__ <= 10000; ++i__) { +#line 832 "" io___113.ciunit = *iv + 10; +#line 832 "" s_rsfe(&io___113); +#line 832 "" do_fio(&c__1, line, (ftnlen)128); +#line 832 "" e_rsfe(); +#line 833 "" if (*(unsigned char *)&line[0] == '%' || s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0 || type4) { +#line 835 "" len = lenstr_(line, &c__128, (ftnlen)128); +#line 836 "" if (len > 0) { +#line 837 "" s_wsfe(&io___116); +#line 837 "" do_fio(&c__1, line, len); +#line 837 "" e_wsfe(); +#line 838 "" } else { +#line 839 "" s_wsfe(&io___117); +#line 839 "" do_fio(&c__1, " ", (ftnlen)1); +#line 839 "" e_wsfe(); +#line 840 "" } +#line 841 "" if (s_cmp(line, "---", (ftnlen)3, (ftnlen)3) == 0) { +#line 841 "" type4 = ! type4; +#line 841 "" } +#line 842 "" } else { +#line 843 "" goto L11; +#line 844 "" } +#line 845 "" /* L10: */ +#line 845 "" } +#line 846 "" s_wsle(&io___118); +#line 846 "" do_lio(&c__9, &c__1, "You should not be here in scor2prt. Call Dr. Don", (ftnlen)49); +#line 846 "" e_wsle(); +#line 847 "" s_stop("", (ftnlen)0); +#line 848 "" L11: /* Finished reading opening type4 TeX and comments. Next line to be read */ /* will contain the first of the input numbers */ +#line 853 "" dosetup_(iv, line, &mtrnum, &mtrden, (ftnlen)128); +#line 854 "" for (i__ = 1; i__ <= 10000; ++i__) { +#line 855 "" L13: +#line 855 "" io___121.ciunit = *iv + 10; +#line 855 "" i__3 = s_rsfe(&io___121); +#line 855 "" if (i__3 != 0) { +#line 855 "" goto L999; +#line 855 "" } +#line 855 "" i__3 = do_fio(&c__1, line, (ftnlen)128); +#line 855 "" if (i__3 != 0) { +#line 855 "" goto L999; +#line 855 "" } +#line 855 "" i__3 = e_rsfe(); +#line 855 "" if (i__3 != 0) { +#line 855 "" goto L999; +#line 855 "" } +#line 856 "" L7: +#line 856 "" len = lenstr_(line, &c__128, (ftnlen)128); /* Pass-through (and copy into part file) if instrumnet has >1 voice. */ +#line 860 "" if (*ljob < 0) { +#line 860 "" goto L2; +#line 860 "" } +#line 861 "" if (i_indx("TtTiTch+h-h l ", line, (ftnlen)14, (ftnlen)2) > 0) { /* Traps titles, instruments, composers, headers, lower strings. Read 2 lines. */ +#line 865 "" s_wsfe(&io___122); +#line 865 "" do_fio(&c__1, line, len); +#line 865 "" e_wsfe(); +#line 866 "" io___123.ciunit = *iv + 10; +#line 866 "" s_rsfe(&io___123); +#line 866 "" do_fio(&c__1, line, (ftnlen)128); +#line 866 "" e_rsfe(); +#line 867 "" len = lenstr_(line, &c__128, (ftnlen)128); +#line 868 "" goto L2; +#line 869 "" } +#line 870 "" if (i__ == 1 || i__ > 5 && *(unsigned char *)&line[0] == 'm') { /* Either just starting, or a new meter is defined. */ /* NOTE! The above test may be bogus. */ +#line 875 "" if (*(unsigned char *)&line[0] == '%') { +#line 876 "" s_wsfe(&io___124); +#line 876 "" do_fio(&c__1, line, len); +#line 876 "" e_wsfe(); +#line 877 "" goto L13; +#line 878 "" } +#line 879 "" if (i__ != 1) { /* New meter. Check for slashes (new meter change syntax) */ +#line 883 "" idxs = i_indx(line, "/", (ftnlen)128, (ftnlen)1); +#line 884 "" idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1); +#line 885 "" newmtr = idxs > 0 && (idxb == 0 || idxs < idxb); +#line 886 "" if (! newmtr) { /* Old way, no slashes, uses 'o' for lonesome '1' */ +#line 890 "" icden = 3; +#line 891 "" if (*(unsigned char *)&line[1] == 'o') { +#line 892 "" mtrnum = 1; +#line 893 "" } else { +#line 894 "" mtrnum = *(unsigned char *)&line[1] - 48; +#line 895 "" if (mtrnum == 1) { +#line 896 "" icden = 4; +#line 897 "" mtrnum = *(unsigned char *)&line[2] - 38; +#line 898 "" } +#line 899 "" } +#line 900 "" mtrden = *(unsigned char *)&line[icden - 1] - 48; +#line 901 "" } else { /* New way with slashes: idxs is index of 1st slash! */ +#line 905 "" ici__1.icierr = 0; +#line 905 "" ici__1.iciend = 0; +#line 905 "" ici__1.icirnum = 1; +#line 905 "" ici__1.icirlen = idxs - 2; +#line 905 "" ici__1.iciunit = line + 1; /* Writing concatenation */ +#line 905 "" i__2[0] = 2, a__2[0] = "(i"; +#line 905 "" *(unsigned char *)&ch__1[0] = idxs + 46; +#line 905 "" i__2[1] = 1, a__2[1] = ch__1; +#line 905 "" i__2[2] = 1, a__2[2] = ")"; +#line 905 "" ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen) 4), ch__4); +#line 905 "" s_rsfi(&ici__1); +#line 905 "" do_fio(&c__1, (char *)&mtrnum, (ftnlen)sizeof(integer)); +#line 905 "" e_rsfi(); +#line 906 "" i__3 = idxs; +#line 906 "" idxb = i_indx(line + i__3, "/", 128 - i__3, (ftnlen)1); +#line 907 "" i__3 = idxs; +#line 907 "" ici__1.icierr = 0; +#line 907 "" ici__1.iciend = 0; +#line 907 "" ici__1.icirnum = 1; +#line 907 "" ici__1.icirlen = idxs + idxb - 1 - i__3; +#line 907 "" ici__1.iciunit = line + i__3; /* Writing concatenation */ +#line 907 "" i__2[0] = 2, a__2[0] = "(i"; +#line 907 "" *(unsigned char *)&ch__1[0] = idxb + 47; +#line 907 "" i__2[1] = 1, a__2[1] = ch__1; +#line 907 "" i__2[2] = 1, a__2[2] = ")"; +#line 907 "" ici__1.icifmt = (s_cat(ch__4, a__2, i__2, &c__3, (ftnlen) 4), ch__4); +#line 907 "" s_rsfi(&ici__1); +#line 907 "" do_fio(&c__1, (char *)&mtrden, (ftnlen)sizeof(integer)); +#line 907 "" e_rsfi(); +#line 909 "" } +#line 910 "" } +#line 911 "" lenbeat = ifnodur_(&mtrden, "x", (ftnlen)1); +#line 912 "" lenmult = 1; +#line 913 "" if (mtrden == 2) { +#line 914 "" lenbeat = 16; +#line 915 "" lenmult = 2; +#line 916 "" } +#line 917 "" lenbar = lenmult * mtrnum * lenbeat; +#line 918 "" fwbrsym_(&lenbar, &nwbrs, wbrsym, &lwbrs, (ftnlen)3); +#line 919 "" } /* Finished setting up meter stuff and defining whole-bar rest symbols */ +#line 923 "" ip1 = 0; +#line 924 "" s_copy(line1, line, (ftnlen)128, (ftnlen)128); +#line 925 "" i__3 = nwbrs; +#line 925 "" for (iw = 0; iw <= i__3; ++iw) { +#line 926 "" if (iw > 0) { +#line 927 "" idx = ntindex_(line1, wbrsym + (iw - 1) * 3, (ftnlen)128, lwbrs); +#line 928 "" if (idx > 0) { /* Check for blank or shifted rest, discount it if it's there */ +#line 932 "" i__4 = idx + lwbrs - 1; +#line 932 "" if (s_cmp(line1 + i__4, " ", idx + lwbrs - i__4, (ftnlen) 1) != 0) { +#line 932 "" idx = 0; +#line 932 "" } +#line 933 "" } +#line 934 "" } else { +#line 935 "" idx = ntindex_(line1, "rp", (ftnlen)128, (ftnlen)2); /* Check for raised rest */ +#line 939 "" if (idx > 0) { +#line 940 "" i__4 = idx + 1; +#line 940 "" if (s_cmp(line1 + i__4, " ", idx + 2 - i__4, (ftnlen)1) != 0) { +#line 940 "" idx = 0; +#line 940 "" } +#line 941 "" } +#line 942 "" } +#line 943 "" if (idx > 0) { +#line 944 "" if (ip1 == 0) { +#line 945 "" ip1 = idx; +#line 946 "" } else { +#line 947 "" ip1 = min(ip1,idx); /* Maybe allows e.g. r0 rp ... */ +#line 948 "" } +#line 949 "" } +#line 950 "" /* L3: */ +#line 950 "" } /* Writing concatenation */ +#line 951 "" i__1[0] = 1, a__1[0] = sq; +#line 951 "" i__1[1] = 1, a__1[1] = sq; +#line 951 "" s_cat(ch__5, a__1, i__1, &c__2, (ftnlen)2); +#line 951 "" if (i__ < 5 || *(unsigned char *)&line[0] == '%' || s_cmp(line, ch__5, (ftnlen)2, (ftnlen)2) == 0 || ip1 == 0) { +#line 951 "" goto L2; +#line 951 "" } /* Switch to multibar rest search mode!!! Start forward in line(1) */ +#line 956 "" rpfirst = s_cmp(line1 + (ip1 - 1), "rp", (ftnlen)2, (ftnlen)2) == 0; +#line 957 "" iline = 1; +#line 958 "" nmbr = 1; +#line 959 "" if (rpfirst) { +#line 960 "" lwbrsx = 2; +#line 961 "" } else { +#line 962 "" lwbrsx = lwbrs; +#line 963 "" } +#line 964 "" ipe = ip1 + lwbrsx - 1; /* ip at end of 1st wbrsym */ +#line 965 "" L4: +#line 965 "" if (ipe == len) { /* Need a new line */ +#line 969 "" ++iline; +#line 970 "" L6: +#line 970 "" io___144.ciunit = *iv + 10; +#line 970 "" i__3 = s_rsfe(&io___144); +#line 970 "" if (i__3 != 0) { +#line 970 "" goto L998; +#line 970 "" } +#line 970 "" i__3 = do_fio(&c__1, line + (iline - 1 << 7), (ftnlen)128); +#line 970 "" if (i__3 != 0) { +#line 970 "" goto L998; +#line 970 "" } +#line 970 "" i__3 = e_rsfe(); +#line 970 "" if (i__3 != 0) { +#line 970 "" goto L998; +#line 970 "" } +#line 971 "" len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128); +#line 972 "" if (*(unsigned char *)&line[(iline - 1) * 128] == '%') { +#line 973 "" s_wsfe(&io___145); +#line 973 "" do_fio(&c__1, "% Following comment has been moved forward", ( ftnlen)42); +#line 973 "" e_wsfe(); +#line 974 "" s_wsfe(&io___146); +#line 974 "" do_fio(&c__1, line + (iline - 1 << 7), len); +#line 974 "" e_wsfe(); +#line 975 "" goto L6; +#line 976 "" } +#line 977 "" ipe = 0; +#line 978 "" goto L4; +#line 979 "" L998: /* No more input left */ +#line 983 "" s_wsle(&io___147); +#line 983 "" do_lio(&c__9, &c__1, "All done!", (ftnlen)9); +#line 983 "" e_wsle(); +#line 984 "" alldone = TRUE_; +#line 985 "" ipe = 0; +#line 986 "" --iline; +#line 987 "" len = lenstr_(line + (iline - 1 << 7), &c__128, (ftnlen)128); +#line 988 "" goto L4; +#line 989 "" } else { +#line 990 "" if (alldone) { +#line 991 "" *(unsigned char *)sym = ' '; +#line 992 "" } else { /* ipe<len here, so it's ok to get a symbol */ +#line 996 "" nextsym_(line + (iline - 1 << 7), &len, &ipe, &ipenew, sym, & lsym, (ftnlen)128, (ftnlen)80); +#line 997 "" } /* Check for end of block or bar line symbol */ +#line 1001 "" if (i_indx("/|", sym, (ftnlen)2, (ftnlen)1) > 0) { +#line 1002 "" ipe = ipenew; +#line 1003 "" goto L4; +#line 1004 "" } else { +#line 1005 "" wbrest = FALSE_; +#line 1006 "" if (alldone) { +#line 1006 "" goto L12; +#line 1006 "" } +#line 1007 "" i__3 = nwbrs; +#line 1007 "" for (iw = 1; iw <= i__3; ++iw) { +#line 1008 "" wbrest = wbrest || s_cmp(sym, wbrsym + (iw - 1) * 3, lsym, lwbrs) == 0; +#line 1009 "" /* L5: */ +#line 1009 "" } +#line 1010 "" wbrest = wbrest || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && lwbrs == 2 || s_cmp(sym, "rd", lsym, (ftnlen)2) == 0 && lwbrs == 3 || s_cmp(sym, "rp", lsym, (ftnlen)2) == 0 || s_cmp(sym, "r", lsym, (ftnlen)1) == 0 && rpfirst; +#line 1014 "" L12: +#line 1014 "" if (wbrest) { +#line 1015 "" ipe = ipenew; +#line 1016 "" ++nmbr; +#line 1017 "" goto L4; +#line 1018 "" } else { /* AHA! Failed prev. test, so last symbol was *not* mbr. */ /* It must be saved, and its starting position is ipenew-lsym+1 */ +#line 1023 "" if (nmbr > 1) { /* Write stuff up to start of mbr */ +#line 1027 "" if (ip1 > 1) { +#line 1027 "" s_wsfe(&io___152); +#line 1027 "" do_fio(&c__1, line, ip1 - 1); +#line 1027 "" e_wsfe(); +#line 1027 "" } /* Insert mbr symbol. Always end with a slash just in case next sym must be */ /* at start of block. May think this causes undefined octaves, but */ /* probably not since it's a single voice. */ +#line 1033 "" r__1 = nmbr + .01f; +#line 1033 "" ndig = (integer) r_lg10(&r__1) + 1; +#line 1034 "" s_wsle(&io___154); +#line 1034 "" do_lio(&c__9, &c__1, "Inserting rm, iv,nmbr:", ( ftnlen)22); +#line 1034 "" do_lio(&c__3, &c__1, (char *)&(*iv), (ftnlen)sizeof( integer)); +#line 1034 "" do_lio(&c__3, &c__1, (char *)&nmbr, (ftnlen)sizeof( integer)); +#line 1034 "" e_wsle(); +#line 1035 "" ci__1.cierr = 0; +#line 1035 "" ci__1.ciunit = 40; /* Writing concatenation */ +#line 1035 "" i__2[0] = 5, a__2[0] = "(a2,i"; +#line 1035 "" *(unsigned char *)&ch__1[0] = ndig + 48; +#line 1035 "" i__2[1] = 1, a__2[1] = ch__1; +#line 1035 "" i__2[2] = 4, a__2[2] = ",a2)"; +#line 1035 "" ci__1.cifmt = (s_cat(ch__6, a__2, i__2, &c__3, ( ftnlen)10), ch__6); +#line 1035 "" s_wsfe(&ci__1); +#line 1035 "" do_fio(&c__1, "rm", (ftnlen)2); +#line 1035 "" do_fio(&c__1, (char *)&nmbr, (ftnlen)sizeof(integer)); +#line 1035 "" do_fio(&c__1, " /", (ftnlen)2); +#line 1035 "" e_wsfe(); +#line 1036 "" if (alldone) { +#line 1036 "" goto L999; +#line 1036 "" } +#line 1037 "" ipc = ipenew - lsym + 1; +#line 1038 "" s_copy(line, line + ((iline - 1 << 7) + (ipc - 1)), ( ftnlen)128, len - (ipc - 1)); +#line 1039 "" } else { /* Write old stuff up to end of original lonesome wbr, save the rest. */ @@ -1827,63 +2847,112 @@ L12: /* non-comment line; then revert to normal mode on that. In 3rd case must */ /* split line. */ +#line 1048 "" if (alldone) { +#line 1049 "" s_wsfe(&io___156); +#line 1049 "" do_fio(&c__1, line, len); +#line 1049 "" e_wsfe(); +#line 1050 "" goto L999; +#line 1051 "" } else if (iline > 1) { +#line 1052 "" i__3 = iline - 1; +#line 1052 "" for (il = 1; il <= i__3; ++il) { +#line 1053 "" len = lenstr_(line + (il - 1 << 7), &c__128, ( ftnlen)128); +#line 1054 "" s_wsfe(&io___158); +#line 1054 "" do_fio(&c__1, line + (il - 1 << 7), len); +#line 1054 "" e_wsfe(); +#line 1055 "" /* L9: */ +#line 1055 "" } +#line 1056 "" s_copy(line, line + (iline - 1 << 7), (ftnlen)128, (ftnlen)128); +#line 1057 "" } else { /* Since iline = 1 the wbr is not the last sym, so must split */ +#line 1061 "" s_wsfe(&io___159); +#line 1061 "" do_fio(&c__1, line, ip1 + lwbrsx - 1); +#line 1061 "" e_wsfe(); +#line 1062 "" i__3 = ip1 + lwbrsx; +#line 1062 "" s_copy(line, line + i__3, (ftnlen)128, len - i__3) ; +#line 1063 "" } +#line 1064 "" } /* Exit multibar mode */ +#line 1068 "" goto L7; +#line 1069 "" } +#line 1070 "" } +#line 1071 "" } +#line 1072 "" L2: +#line 1073 "" if (len > 0) { +#line 1074 "" s_wsfe(&io___160); +#line 1074 "" do_fio(&c__1, line, len); +#line 1074 "" e_wsfe(); +#line 1075 "" } else { +#line 1076 "" s_wsfe(&io___161); +#line 1076 "" do_fio(&c__1, " ", (ftnlen)1); +#line 1076 "" e_wsfe(); +#line 1077 "" } +#line 1078 "" /* L1: */ +#line 1078 "" } +#line 1079 "" L999: +#line 1080 "" cl__1.cerr = 0; +#line 1080 "" cl__1.cunit = *iv + 10; +#line 1080 "" cl__1.csta = 0; +#line 1080 "" f_clos(&cl__1); +#line 1081 "" cl__1.cerr = 0; +#line 1081 "" cl__1.cunit = 40; +#line 1081 "" cl__1.csta = 0; +#line 1081 "" f_clos(&cl__1); +#line 1082 "" return 0; } /* mbrests_ */ @@ -1901,30 +2970,54 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) static cilist io___162 = { 0, 6, 0, 0, 0 }; +#line 1086 "" if (*idur == 6) { +#line 1087 "" ret_val = 1; +#line 1088 "" } else if (*idur == 3) { +#line 1089 "" ret_val = 2; +#line 1090 "" } else if (*idur == 1 || *idur == 16) { +#line 1091 "" ret_val = 4; +#line 1092 "" } else if (*idur == 8) { +#line 1093 "" ret_val = 8; +#line 1094 "" } else if (*idur == 4) { +#line 1095 "" ret_val = 16; +#line 1096 "" } else if (*idur == 2) { +#line 1097 "" ret_val = 32; +#line 1098 "" } else if (*idur == 0) { +#line 1099 "" ret_val = 64; +#line 1100 "" } else { +#line 1101 "" s_wsle(&io___162); +#line 1101 "" do_lio(&c__9, &c__1, "You entered an invalid note-length value", ( ftnlen)40); +#line 1101 "" e_wsle(); +#line 1102 "" s_stop("", (ftnlen)0); +#line 1103 "" } +#line 1104 "" if (*(unsigned char *)dotq == 'd') { +#line 1104 "" ret_val = ret_val * 3 / 2; +#line 1104 "" } +#line 1105 "" return ret_val; } /* ifnodur_ */ @@ -1940,40 +3033,75 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) "n ,i3, 26H/64 will not be recognized)", 0 }; +#line 1109 "" /* Parameter adjustments */ +#line 1109 "" wbrsym -= 3; +#line 1109 "" +#line 1109 "" /* Function Body */ +#line 1109 "" *nwbrs = 1; +#line 1110 "" *lwbrs = 2; +#line 1111 "" if (*lenbar == 16) { +#line 1112 "" s_copy(wbrsym + 3, "r4", (ftnlen)3, (ftnlen)2); +#line 1113 "" } else if (*lenbar == 32) { +#line 1114 "" s_copy(wbrsym + 3, "r2", (ftnlen)3, (ftnlen)2); +#line 1115 "" } else if (*lenbar == 64) { +#line 1116 "" s_copy(wbrsym + 3, "r0", (ftnlen)3, (ftnlen)2); +#line 1117 "" } else if (*lenbar == 8) { +#line 1118 "" s_copy(wbrsym + 3, "r8", (ftnlen)3, (ftnlen)2); +#line 1119 "" } else if (*lenbar == 128) { +#line 1120 "" s_copy(wbrsym + 3, "r9", (ftnlen)3, (ftnlen)2); +#line 1121 "" } else { +#line 1122 "" *nwbrs = 2; +#line 1123 "" *lwbrs = 3; +#line 1124 "" if (*lenbar == 24) { +#line 1125 "" s_copy(wbrsym + 3, "rd4", (ftnlen)3, (ftnlen)3); +#line 1126 "" s_copy(wbrsym + 6, "r4d", (ftnlen)3, (ftnlen)3); +#line 1127 "" } else if (*lenbar == 48) { +#line 1128 "" s_copy(wbrsym + 3, "rd2", (ftnlen)3, (ftnlen)3); +#line 1129 "" s_copy(wbrsym + 6, "r2d", (ftnlen)3, (ftnlen)3); +#line 1130 "" } else if (*lenbar == 96) { +#line 1131 "" s_copy(wbrsym + 3, "rd0", (ftnlen)3, (ftnlen)3); +#line 1132 "" s_copy(wbrsym + 6, "r0d", (ftnlen)3, (ftnlen)3); +#line 1133 "" } else { +#line 1134 "" s_wsfe(&io___163); +#line 1134 "" do_fio(&c__1, (char *)&(*lenbar), (ftnlen)sizeof(integer)); +#line 1134 "" e_wsfe(); +#line 1136 "" } +#line 1137 "" } +#line 1138 "" return 0; } /* fwbrsym_ */ @@ -2003,62 +3131,104 @@ integer ifnodur_(integer *idur, char *dotq, ftnlen dotq_len) /* Know its the last symbol if on return ipenew = len!. So should never */ /* be called when ipstart=len. */ +#line 1147 "" if (*ipeold >= *len) { +#line 1148 "" s_wsle(&io___164); +#line 1148 "" do_lio(&c__9, &c__1, "Called nextsym with ipstart>=len ", (ftnlen)33); +#line 1148 "" e_wsle(); +#line 1149 "" s_wsle(&io___165); +#line 1149 "" do_lio(&c__9, &c__1, "Send files to Dr. Don at dsimons@logicon.com", ( ftnlen)44); +#line 1149 "" e_wsle(); +#line 1150 "" s_stop("", (ftnlen)0); +#line 1151 "" } +#line 1152 "" i__1 = *len; +#line 1152 "" for (ip = *ipeold + 1; ip <= i__1; ++ip) { +#line 1153 "" if (*(unsigned char *)&line[ip - 1] != ' ') { /* symbol starts here (ip). We're committed to exit the loop. */ +#line 1157 "" if (ip < *len) { +#line 1158 "" i__2 = *len; +#line 1158 "" for (iip = ip + 1; iip <= i__2; ++iip) { +#line 1159 "" if (*(unsigned char *)&line[iip - 1] != ' ') { +#line 1159 "" goto L2; +#line 1159 "" } /* iip is the space after the symbol */ +#line 1163 "" *ipenew = iip - 1; +#line 1164 "" *lsym = *ipenew - ip + 1; +#line 1165 "" s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1)); +#line 1166 "" return 0; +#line 1167 "" L2: +#line 1167 "" ; +#line 1167 "" } /* Have len>=2 and ends on len */ +#line 1171 "" *ipenew = *len; +#line 1172 "" *lsym = *ipenew - ip + 1; +#line 1173 "" s_copy(sym, line + (ip - 1), (ftnlen)80, *ipenew - (ip - 1)); +#line 1174 "" return 0; +#line 1175 "" } else { /* ip = len */ +#line 1179 "" *ipenew = *len; +#line 1180 "" *lsym = 1; +#line 1181 "" s_copy(sym, line + (ip - 1), (ftnlen)80, (ftnlen)1); +#line 1182 "" return 0; +#line 1183 "" } +#line 1184 "" } +#line 1185 "" /* L1: */ +#line 1185 "" } +#line 1186 "" s_wsle(&io___168); - do_lio(&c__9, &c__1, "Error #3. Send files to Dr. Don at dsimons@logico" +#line 1186 "" + do_lio(&c__9, &c__1, "Error #3. Send files to Dr. Don at dsimons@logico"\ "n.com", (ftnlen)55); +#line 1186 "" e_wsle(); +#line 1187 "" return 0; } /* nextsym_ */ @@ -2098,97 +3268,158 @@ integer ntindex_(char *line, char *s2q, ftnlen line_len, ftnlen s2q_len) /* Use a temporary string to store the input and test, so can zap D"..." */ +#line 1202 "" s_copy(tline, line, (ftnlen)128, (ftnlen)128); +#line 1203 "" ndxs2 = i_indx(tline, s2q, (ftnlen)128, s2q_len); /* Return point below for rechecks after zapping D" " */ +#line 1207 "" L2: +#line 1208 "" ndxbs = i_indx(tline, "\\", (ftnlen)128, (ftnlen)1); +#line 1209 "" if (ndxbs > 0) { /* Special check in case \ is inside D"..." */ +#line 1213 "" ndxdq1 = i_indx(tline, "D\"", (ftnlen)128, (ftnlen)2); /* If the following test fails, flow out of if block; else loop up to 2. */ +#line 1217 "" if (ndxdq1 > 0) { /* Find end of D"..." */ +#line 1221 "" i__1 = ndxdq1 + 1; +#line 1221 "" ndxdq2 = ndxdq1 + 1 + i_indx(tline + i__1, "\"", 128 - i__1, ( ftnlen)1); +#line 1222 "" if (ndxdq2 == ndxdq1 + 1) { +#line 1223 "" s_wsle(&io___174); +#line 1223 "" do_lio(&c__9, &c__1, "Something is really wierd here", ( ftnlen)30); +#line 1223 "" e_wsle(); +#line 1224 "" s_stop("", (ftnlen)0); +#line 1225 "" } +#line 1226 "" s_copy(tline, tline, (ftnlen)128, ndxdq1 - 1); +#line 1227 "" i__1 = ndxdq2; +#line 1227 "" for (ic = ndxdq1; ic <= i__1; ++ic) { /* Writing concatenation */ +#line 1228 "" i__2[0] = ic - 1, a__1[0] = tline; +#line 1228 "" i__2[1] = 1, a__1[1] = " "; +#line 1228 "" s_cat(tline, a__1, i__2, &c__2, (ftnlen)128); +#line 1229 "" /* L3: */ +#line 1229 "" } +#line 1230 "" i__1 = ndxdq2; /* Writing concatenation */ +#line 1230 "" i__2[0] = ndxdq2, a__1[0] = tline; +#line 1230 "" i__2[1] = 128 - i__1, a__1[1] = line + i__1; +#line 1230 "" s_cat(tline, a__1, i__2, &c__2, (ftnlen)128); +#line 1231 "" goto L2; +#line 1232 "" } +#line 1233 "" } +#line 1234 "" if (ndxbs == 0 || ndxs2 < ndxbs) { +#line 1235 "" ret_val = ndxs2; /* print*,'No bs, or char is left of 1st bs, ntindex:',ntindex */ +#line 1237 "" } 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 1242 "" len = lenstr_(tline, &c__128, (ftnlen)128); +#line 1243 "" intex = TRUE_; /* print*,'intex+>',intex */ +#line 1245 "" i__1 = len; +#line 1245 "" for (ic = ndxbs + 1; ic <= i__1; ++ic) { +#line 1246 "" if (ic == ndxs2) { +#line 1247 "" if (intex) { +#line 1248 "" ret_val = 0; +#line 1249 "" i__3 = ic; +#line 1249 "" ndxs2 = i_indx(tline + i__3, s2q, len - i__3, s2q_len) + ic; /* print*,'ndxs2 =>',ndxs2 */ +#line 1251 "" } else { +#line 1252 "" ret_val = ndxs2; +#line 1253 "" return ret_val; +#line 1254 "" } /* print*,'Internal exit, intex, ntindex:',intex,ntindex */ +#line 1256 "" } else /* if(complicated condition) */ { +#line 1256 "" i__3 = ic; +#line 1256 "" if (intex && s_cmp(tline + i__3, "\\ ", ic + 2 - i__3, ( ftnlen)2) == 0) { +#line 1257 "" intex = FALSE_; /* print*,'intex+>',intex */ +#line 1259 "" } else /* if(complicated condition) */ { +#line 1259 "" i__3 = ic; +#line 1259 "" if (! intex && s_cmp(tline + i__3, " \\", ic + 2 - i__3, ( ftnlen)2) == 0) { +#line 1261 "" intex = TRUE_; /* print*,'intex+>',intex */ +#line 1263 "" } +#line 1263 "" } +#line 1263 "" } +#line 1264 "" /* L1: */ +#line 1264 "" } /* print*,'Out end of loop 1' */ +#line 1266 "" } /* print*,'Exiting ntindex at the end???' */ +#line 1268 "" return ret_val; } /* ntindex_ */ @@ -2206,14 +3437,23 @@ L2: /* Gets the next character out of line*128. If pointer iccount=128 on entry, */ /* then reads in a new line. Resets iccount to position of the new character. */ +#line 1277 "" if (*iccount == 128) { +#line 1278 "" s_rsfe(&io___178); +#line 1278 "" do_fio(&c__1, line, (ftnlen)128); +#line 1278 "" e_rsfe(); +#line 1279 "" *iccount = 0; +#line 1280 "" } +#line 1281 "" ++(*iccount); +#line 1282 "" *(unsigned char *)charq = *(unsigned char *)&line[*iccount - 1]; +#line 1283 "" return 0; } /* getchar_ */ @@ -2264,93 +3504,167 @@ doublereal readin_(char *line, integer *iccount, integer *iread, ftnlen /* 4 musicsize 20 */ /* 5 fracondent 0.05 */ +#line 1308 "" L4: +#line 1308 "" if (*iccount == 128) { +#line 1309 "" s_rsfe(&io___179); +#line 1309 "" do_fio(&c__1, line, (ftnlen)128); +#line 1309 "" e_rsfe(); +#line 1310 "" if (all_1.replacing) { +#line 1310 "" all_1.replacing = FALSE_; +#line 1310 "" } +#line 1311 "" chkcom_(line, (ftnlen)128); +#line 1312 "" *iccount = 0; +#line 1313 "" } +#line 1314 "" ++(*iccount); /* Find next non-blank or end of line */ +#line 1318 "" for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { +#line 1319 "" if (*(unsigned char *)&line[*iccount - 1] != ' ') { +#line 1319 "" goto L3; +#line 1319 "" } +#line 1320 "" /* L2: */ +#line 1320 "" } /* If here, need to get a new line */ +#line 1324 "" *iccount = 128; +#line 1325 "" goto L4; +#line 1326 "" L3: /* iccount now points to start of number to read */ +#line 1330 "" i1 = *iccount; +#line 1331 "" L5: +#line 1331 "" getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1); /* Remember that getchar first increments iccount, *then* reads a character. */ +#line 1335 "" if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 1335 "" goto L5; +#line 1335 "" } +#line 1336 "" i2 = *iccount - 1; +#line 1337 "" if (i2 < i1) { +#line 1338 "" s_wsle(&io___183); /* Writing concatenation */ +#line 1338 "" i__1[0] = 7, a__1[0] = "Found \""; +#line 1338 "" i__1[1] = 1, a__1[1] = durq; +#line 1338 "" i__1[2] = 19, a__1[2] = "\" instead of number"; +#line 1338 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); +#line 1338 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); +#line 1338 "" e_wsle(); +#line 1339 "" s_stop("1", (ftnlen)1); +#line 1340 "" } +#line 1341 "" icf = i2 - i1 + 49; +#line 1342 "" ici__1.icierr = 0; +#line 1342 "" ici__1.iciend = 0; +#line 1342 "" ici__1.icirnum = 1; +#line 1342 "" ici__1.icirlen = i2 - (i1 - 1); +#line 1342 "" ici__1.iciunit = line + (i1 - 1); /* Writing concatenation */ +#line 1342 "" i__1[0] = 2, a__1[0] = "(f"; +#line 1342 "" *(unsigned char *)&ch__3[0] = icf; +#line 1342 "" i__1[1] = 1, a__1[1] = ch__3; +#line 1342 "" i__1[2] = 3, a__1[2] = ".0)"; +#line 1342 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 1342 "" s_rsfi(&ici__1); +#line 1342 "" do_fio(&c__1, (char *)&ret_val, (ftnlen)sizeof(real)); +#line 1342 "" e_rsfi(); +#line 1343 "" if (! all_1.replacing) { +#line 1344 "" if (*iread == 0) { +#line 1345 "" i__2 = i2 - i1 + 1; +#line 1345 "" allparts_(line + (i1 - 1), &i__2, i2 - (i1 - 1)); +#line 1346 "" } else if (*iread == 1) { +#line 1347 "" allparts_("-999", &c__4, (ftnlen)4); +#line 1348 "" } else if (*iread == 2) { +#line 1349 "" allparts_("1", &c__1, (ftnlen)1); +#line 1350 "" } else if (*iread == 3) { +#line 1351 "" allparts_("-998", &c__4, (ftnlen)4); +#line 1352 "" } else if (*iread == 4) { +#line 1353 "" allparts_("20", &c__2, (ftnlen)2); +#line 1354 "" } else if (*iread == 5) { +#line 1355 "" allparts_(".05", &c__3, (ftnlen)3); +#line 1356 "" } else if (*iread != -1) { +#line 1357 "" s_wsle(&io___185); +#line 1357 "" do_lio(&c__9, &c__1, "Error with iread in readin", (ftnlen)26); +#line 1357 "" e_wsle(); +#line 1358 "" s_stop("", (ftnlen)0); +#line 1359 "" } +#line 1360 "" } +#line 1361 "" return ret_val; } /* readin_ */ @@ -2385,133 +3699,213 @@ L5: /* Assume that line has just been read. No need to change iccount since we only */ /* process full lines. */ +#line 1373 "" L1: +#line 1373 "" if (*(unsigned char *)line != '%') { +#line 1373 "" return 0; +#line 1373 "" } /* If here, line has some sort of comment */ +#line 1377 "" if (*(unsigned char *)&line[1] == '%') { +#line 1378 "" if (! all_1.insetup) { /* Suck up a line, then flow out of "if" block to get another and loop */ +#line 1382 "" s_rsfe(&io___186); +#line 1382 "" do_fio(&c__1, line, (ftnlen)128); +#line 1382 "" e_rsfe(); /* ++VV */ /* UNLESS (a) it has a score-only "M" and changes # of inst's. */ +#line 1388 "" if (i_indx(line, "M", (ftnlen)128, (ftnlen)1) > 0) { +#line 1389 "" idxl = i_indx(line, "L", (ftnlen)128, (ftnlen)1); +#line 1390 "" idxm = i_indx(line, "M", (ftnlen)128, (ftnlen)1); +#line 1391 "" idxn = i_indx(line, "n", (ftnlen)128, (ftnlen)1); +#line 1392 "" idxb = i_indx(line, " ", (ftnlen)128, (ftnlen)1); +#line 1393 "" if (idxl < idxm && idxm < idxn && (idxb == 0 || idxn < idxb)) { +#line 1395 "" i__1 = idxn; +#line 1395 "" all_1.noinow = *(unsigned char *)&line[i__1] - 48; +#line 1396 "" clefpend = TRUE_; /* Next noinow digits are original inst. #'s of new inst. set. Next noinow */ /* char's after that are clefs */ +#line 1401 "" all_1.nvnow = 0; +#line 1402 "" i__1 = all_1.noinow; +#line 1402 "" for (j = 1; j <= i__1; ++j) { +#line 1403 "" i__2 = idxn + 1 + j - 1; +#line 1403 "" all_1.iorig[j - 1] = *(unsigned char *)&line[i__2] - 48; +#line 1404 "" iposc0 = idxn + 1 + all_1.noinow; +#line 1405 "" i__2 = all_1.nvi[all_1.iorig[j - 1] - 1]; +#line 1405 "" for (k = 1; k <= i__2; ++k) { +#line 1406 "" ++all_1.nvnow; /* clefq(nvnow) = line(iposc0+nvnow:iposc0+nvnow) */ +#line 1408 "" all_1.instnum[all_1.nvnow - 1] = j; +#line 1409 "" all_1.botv[all_1.nvnow - 1] = k == 1 && j != 1; +#line 1410 "" /* L25: */ +#line 1410 "" } +#line 1411 "" /* L24: */ +#line 1411 "" } +#line 1412 "" } +#line 1413 "" } /* or if it's "h" or "l", need to suck up one more line */ +#line 1417 "" if (*(unsigned char *)line == 'h' && i_indx("+- ", line + 1, ( ftnlen)3, (ftnlen)1) > 0 || *(unsigned char *)line == 'T' || s_cmp(line, "l ", (ftnlen)2, (ftnlen)2) == 0) { +#line 1417 "" s_rsfe(&io___195); +#line 1417 "" do_fio(&c__1, line, (ftnlen)128); +#line 1417 "" e_rsfe(); +#line 1417 "" } /* 4/29/00 check for T string also */ +#line 1423 "" } else { /* In setup mode. Set flag, flow out and do use following line */ +#line 1427 "" all_1.replacing = TRUE_; +#line 1428 "" } +#line 1429 "" } else if (*(unsigned char *)&line[1] == '!') { /* Copy to all parts */ +#line 1433 "" allparts_(line + 2, &c__125, (ftnlen)126); +#line 1434 "" } else { /* Get value of hex integer 1,2,...,9,a,b,c in 2nd position, zero otherwise */ /* c Get value of extended hex integer 1,2,...,9,a,b,c,...,o in 2nd position, zero otherwise */ +#line 1439 "" ivq = i_indx("123456789abcdefghijklmno", line + 1, (ftnlen)24, ( ftnlen)1); /* Only treat as part-specific pmx line if number .le. noinst */ +#line 1443 "" if (ivq < 1 || ivq > all_1.noinst) { /* Simple comment. */ +#line 1447 "" allparts_(line, &c__128, (ftnlen)128); +#line 1448 "" } else { /* Instrument comment, copy only to part */ +#line 1452 "" lenline = lenstr_(line, &c__128, (ftnlen)128); +#line 1453 "" if (lenline > 2) { +#line 1454 "" io___198.ciunit = ivq + 10; +#line 1454 "" s_wsfe(&io___198); +#line 1454 "" do_fio(&c__1, line + 2, lenline - 2); +#line 1454 "" e_wsfe(); +#line 1455 "" } else { /* Transferring blank line */ +#line 1459 "" io___199.ciunit = ivq + 10; +#line 1459 "" s_wsfe(&io___199); +#line 1459 "" do_fio(&c__1, " ", (ftnlen)1); +#line 1459 "" e_wsfe(); +#line 1460 "" } +#line 1461 "" } +#line 1462 "" } +#line 1463 "" i__1 = s_rsfe(&io___200); +#line 1463 "" if (i__1 != 0) { +#line 1463 "" goto L2; +#line 1463 "" } +#line 1463 "" i__1 = do_fio(&c__1, line, (ftnlen)128); +#line 1463 "" if (i__1 != 0) { +#line 1463 "" goto L2; +#line 1463 "" } +#line 1463 "" i__1 = e_rsfe(); +#line 1463 "" if (i__1 != 0) { +#line 1463 "" goto L2; +#line 1463 "" } +#line 1464 "" zapbl_(line, &c__128, (ftnlen)128); +#line 1465 "" goto L1; +#line 1466 "" L2: +#line 1467 "" return 0; } /* chkcom_ */ @@ -2553,75 +3947,128 @@ L2: /* iset(9) (npages) will be replaced with (nsyst-1)/12+1 */ /* iset(2), if negative, will be followed by extra numbers to be transf. */ +#line 1486 "" iccount = 0; +#line 1487 "" for (iset = 1; iset <= 12; ++iset) { +#line 1488 "" partnum_(iv, &iccount, line, &xdata, (ftnlen)128); +#line 1489 "" if (iset == 2) { +#line 1490 "" if (xdata > 0.f) { +#line 1491 "" s_wsfe(&io___204); +#line 1491 "" i__1 = (integer) (xdata + .1f); +#line 1491 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 1491 "" e_wsfe(); +#line 1492 "" } else { +#line 1493 "" noi = -xdata + .1f; +#line 1494 "" s_wsfe(&io___206); +#line 1494 "" do_fio(&c__1, (char *)&noi, (ftnlen)sizeof(integer)); +#line 1494 "" e_wsfe(); +#line 1495 "" i__1 = noi; +#line 1495 "" for (ioi = 1; ioi <= i__1; ++ioi) { +#line 1496 "" partnum_(iv, &iccount, line, &xdata, (ftnlen)128); +#line 1497 "" s_wsfe(&io___208); +#line 1497 "" i__2 = (integer) (xdata + .1f); +#line 1497 "" do_fio(&c__1, (char *)&i__2, (ftnlen)sizeof(integer)); +#line 1497 "" e_wsfe(); +#line 1498 "" /* L2: */ +#line 1498 "" } +#line 1499 "" } /* else if (iset.ne.8 .and. xdata.lt.0) then */ +#line 1501 "" } else if (iset != 8 && iset != 5 && xdata < 0.f) { /* Must be either nv or npages */ +#line 1505 "" if ((integer) (-xdata + .1f) == 999) { /* It's nv */ +#line 1509 "" s_wsfe(&io___209); +#line 1509 "" do_fio(&c__1, (char *)&all_1.nvi[*iv - 1], (ftnlen)sizeof( integer)); +#line 1509 "" e_wsfe(); +#line 1510 "" } else { /* npages must be computed */ +#line 1514 "" s_wsfe(&io___210); +#line 1514 "" i__1 = (all_1.nsyst - 1) / 12 + 1; +#line 1514 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 1514 "" e_wsfe(); +#line 1515 "" } +#line 1516 "" } else if (iset != 7 && iset != 12) { /* write integer */ +#line 1520 "" s_wsfe(&io___211); +#line 1520 "" i__1 = i_nint(&xdata); +#line 1520 "" do_fio(&c__1, (char *)&i__1, (ftnlen)sizeof(integer)); +#line 1520 "" e_wsfe(); +#line 1521 "" } else { /* write floating number */ +#line 1525 "" s_wsfe(&io___212); +#line 1525 "" do_fio(&c__1, (char *)&xdata, (ftnlen)sizeof(real)); +#line 1525 "" e_wsfe(); +#line 1526 "" } +#line 1527 "" if (iset == 3) { +#line 1528 "" *mtrnum = i_nint(&xdata); +#line 1529 "" } else if (iset == 4) { +#line 1530 "" *mtrden = i_nint(&xdata); +#line 1531 "" } +#line 1532 "" /* L1: */ +#line 1532 "" } +#line 1533 "" return 0; } /* dosetup_ */ @@ -2659,75 +4106,131 @@ L2: /* Simplified number parsing. Only looks for comment lines and numbers. */ +#line 1541 "" L2: +#line 1541 "" if (*iccount == 128) { +#line 1542 "" io___213.ciunit = *iv + 10; +#line 1542 "" s_rsfe(&io___213); +#line 1542 "" do_fio(&c__1, line, (ftnlen)128); +#line 1542 "" e_rsfe(); +#line 1543 "" if (*(unsigned char *)line == '%') { +#line 1544 "" len = lenstr_(line, &c__128, (ftnlen)128); +#line 1545 "" s_wsfe(&io___215); +#line 1545 "" do_fio(&c__1, line, len); +#line 1545 "" e_wsfe(); +#line 1546 "" goto L2; +#line 1547 "" } +#line 1548 "" *iccount = 0; +#line 1549 "" } +#line 1550 "" ++(*iccount); /* Find next non-blank or end of line */ +#line 1554 "" for (*iccount = *iccount; *iccount <= 127; ++(*iccount)) { +#line 1555 "" if (*(unsigned char *)&line[*iccount - 1] != ' ') { +#line 1555 "" goto L3; +#line 1555 "" } +#line 1556 "" /* L4: */ +#line 1556 "" } /* If here, iccount=128 and need to get a new line */ +#line 1560 "" goto L2; +#line 1561 "" L3: /* iccount now points to start of number to read */ +#line 1565 "" i1 = *iccount; +#line 1566 "" L5: +#line 1566 "" getchar_(line, iccount, durq, (ftnlen)128, (ftnlen)1); /* Remember that getchar first increments iccount, *then* reads a character. */ +#line 1570 "" if (i_indx("0123456789.-", durq, (ftnlen)12, (ftnlen)1) > 0) { +#line 1570 "" goto L5; +#line 1570 "" } +#line 1571 "" i2 = *iccount - 1; +#line 1572 "" if (i2 < i1) { +#line 1573 "" s_wsle(&io___219); /* Writing concatenation */ +#line 1573 "" i__1[0] = 7, a__1[0] = "Found \""; +#line 1573 "" i__1[1] = 1, a__1[1] = durq; +#line 1573 "" i__1[2] = 19, a__1[2] = "\" instead of number"; +#line 1573 "" s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)27); +#line 1573 "" do_lio(&c__9, &c__1, ch__1, (ftnlen)27); +#line 1573 "" e_wsle(); +#line 1574 "" s_stop("1", (ftnlen)1); +#line 1575 "" } +#line 1576 "" icf = i2 - i1 + 49; +#line 1577 "" ici__1.icierr = 0; +#line 1577 "" ici__1.iciend = 0; +#line 1577 "" ici__1.icirnum = 1; +#line 1577 "" ici__1.icirlen = i2 - (i1 - 1); +#line 1577 "" ici__1.iciunit = line + (i1 - 1); /* Writing concatenation */ +#line 1577 "" i__1[0] = 2, a__1[0] = "(f"; +#line 1577 "" *(unsigned char *)&ch__3[0] = icf; +#line 1577 "" i__1[1] = 1, a__1[1] = ch__3; +#line 1577 "" i__1[2] = 3, a__1[2] = ".0)"; +#line 1577 "" ici__1.icifmt = (s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)6), ch__2); +#line 1577 "" s_rsfi(&ici__1); +#line 1577 "" do_fio(&c__1, (char *)&(*xdata), (ftnlen)sizeof(real)); +#line 1577 "" e_rsfi(); +#line 1578 "" return 0; } /* partnum_ */ @@ -2743,24 +4246,40 @@ L5: /* Local variables */ static integer i__; +#line 1590 "" i__1 = *len; +#line 1590 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 1591 "" if (*(unsigned char *)&string[i__ - 1] == ' ') { +#line 1591 "" goto L1; +#line 1591 "" } +#line 1592 "" if (i__ == 1) { +#line 1592 "" return 0; +#line 1592 "" } +#line 1593 "" goto L2; +#line 1594 "" L1: +#line 1594 "" ; +#line 1594 "" } /* If line is all blank, leave it alone */ +#line 1598 "" return 0; +#line 1599 "" L2: +#line 1600 "" s_copy(string, string + (i__ - 1), string_len, *len - (i__ - 1)); +#line 1601 "" return 0; } /* zapbl_ */ @@ -2777,15 +4296,25 @@ L2: /* This counts number of double quotes in lineq up to position indx-1, then */ /* sets yesodd according to whether number is odd or even */ +#line 1610 "" numdqs = 0; +#line 1611 "" i__1 = *indx - 1; +#line 1611 "" for (i__ = 1; i__ <= i__1; ++i__) { +#line 1612 "" if (*(unsigned char *)&lineq[i__ - 1] == '"') { +#line 1612 "" ++numdqs; +#line 1612 "" } +#line 1613 "" /* L1: */ +#line 1613 "" } +#line 1614 "" *yesodd = numdqs % 2 == 1; +#line 1615 "" return 0; } /* oddquotesbefore_ */ diff --git a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for b/Build/source/utils/pmx/pmx-src/scor2prt.for index c6ff8931ff2..018f44a4651 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/scor2prt.for +++ b/Build/source/utils/pmx/pmx-src/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 diff --git a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.mid b/Build/source/utils/pmx/pmx-src/tests/barsant.mid Binary files differindex 4adf2eb7751..3169e07d7ba 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.mid +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.mid diff --git a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.pml b/Build/source/utils/pmx/pmx-src/tests/barsant.pml index 25c21e17fbb..2249144d52b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.pml +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.pml @@ -1,4 +1,4 @@ -This is PMX, Version 2.7 , 3 Apr 13 +This is PMX, Version 2.73 , 2 Feb 16 Opening barsant.pmx Starting first PMX pass diff --git a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.pmx b/Build/source/utils/pmx/pmx-src/tests/barsant.pmx index 2dd564a1436..2dd564a1436 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.pmx +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.pmx diff --git a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.tex b/Build/source/utils/pmx/pmx-src/tests/barsant.tex index 4fac3a5db8c..4fac3a5db8c 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant.tex +++ b/Build/source/utils/pmx/pmx-src/tests/barsant.tex diff --git a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant1.pmx b/Build/source/utils/pmx/pmx-src/tests/barsant1.pmx index 210125bc432..210125bc432 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant1.pmx +++ b/Build/source/utils/pmx/pmx-src/tests/barsant1.pmx diff --git a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant2.pmx b/Build/source/utils/pmx/pmx-src/tests/barsant2.pmx index 55142dedaa4..55142dedaa4 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/tests/barsant2.pmx +++ b/Build/source/utils/pmx/pmx-src/tests/barsant2.pmx diff --git a/Build/source/utils/pmx/pmx-2.7.0/version.ac b/Build/source/utils/pmx/pmx-src/version.ac index ff3fc754e8e..7c43a3ea35b 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/version.ac +++ b/Build/source/utils/pmx/pmx-src/version.ac @@ -8,4 +8,4 @@ dnl dnl -------------------------------------------------------- dnl dnl m4-include this file to define the current pmx version -m4_define([pmx_version], [2.7.0]) +m4_define([pmx_version], [2.7.3]) diff --git a/Build/source/utils/pmx/pmx-2.7.0/w32getc.c b/Build/source/utils/pmx/pmx-src/w32getc.c index 32f9d625953..32f9d625953 100644 --- a/Build/source/utils/pmx/pmx-2.7.0/w32getc.c +++ b/Build/source/utils/pmx/pmx-src/w32getc.c diff --git a/Build/source/utils/pmx/pmxab.1 b/Build/source/utils/pmx/pmxab.1 index 806efcce76c..381324e5641 100644 --- a/Build/source/utils/pmx/pmxab.1 +++ b/Build/source/utils/pmx/pmxab.1 @@ -1,4 +1,4 @@ -.TH pmxab 1 "19 Jan 2013" "Version 2.6.19" "PMX Manual Page" +.TH pmxab 1 "2 Feb 2016" "Version 2.7.3" "PMX Manual Page" .SH NAME pmxab \- a MusiXTeX preprocessor .SH SYNOPSIS @@ -7,8 +7,8 @@ pmxab \- a MusiXTeX preprocessor .SH DESCRIPTION pmxab is a preprocessor for MusiXTeX. -It's usually invoked by a frontend pmx2pdf(1). -To use it to its full benefit you should have installed MusiXTeX Version 1.15 +It's usually invoked by a frontend musixtex(1). +To use it to its full benefit you should have installed MusiXTeX Version 1.21 or higher, and TeX itself. The goal of PMX is to faciliate the efficient typesetting of scores and parts that have an almost professional appearance. To learn more about typesetting @@ -17,7 +17,7 @@ with PMX, please read the PMX Manual. When invoked directly, pmxab produces tex output utilizing the MusiXTeX macro set. .SH SEE ALSO -pmx2pdf(1), scor2prt(1), musixtex(1) +scor2prt(1), musixtex(1) .SH AUTHORS PMX was written by Don Simons <dsimons@roadrunner.com>. This manual page was written by Roland Stigge <stigge@antcom.de> for the Debian diff --git a/Build/source/utils/pmx/scor2prt.1 b/Build/source/utils/pmx/scor2prt.1 index 4e38a161cb0..23abdf4c197 100644 --- a/Build/source/utils/pmx/scor2prt.1 +++ b/Build/source/utils/pmx/scor2prt.1 @@ -1,4 +1,4 @@ -.TH scor2prt 1 "5 March 2012" "Version 2.6.17" "scor2prt Manual Page" +.TH scor2prt 1 "2 Feb 2016" "Version 2.7.3" "scor2prt Manual Page" .SH NAME scor2prt \- source-parts separation program for pmx, a MusiXTeX preprocessor .SH SYNOPSIS diff --git a/Build/source/utils/pmx/version.ac b/Build/source/utils/pmx/version.ac index f3c343f0ad3..edba55a91da 100644 --- a/Build/source/utils/pmx/version.ac +++ b/Build/source/utils/pmx/version.ac @@ -8,4 +8,4 @@ dnl dnl -------------------------------------------------------- dnl dnl m4-include this file to define the current pmx version -m4_define([pmx_version], [2.7.0]) +m4_define([pmx_version], [2.7.3]) |