&dA &dA &d@ &dE ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» &d@ &dA &d@ &dE º MSKPAGE.Z and Related Programs º &d@ &dA &d@ &dE ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ &d@ &dA &dA &d@ Program to assemble linear i-files &dA &d@ into sets of systems for page specific output &dA &d@ &dA &d@ Version 4.2 (rev. 04/12/10) &dA &dA &d@ This source code is used to generate five programs: &dA &d@ &dEmskpage.z&d@ &dExmskpage.z&d@ &dEspaging.z&d@ &dEmscroll.z&d@ &dEscrpage.z&d@ &dA &dA &d@ Four of these programs are currently in active use, and have &dA &d@ the following relationship: &dA &dA &d@ Output to pages Scroll output &dA &d@ (SCROLL_OUT = 0) (SCROLL_OUT = 1) &dA &d@ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÂÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ &dA &d@ Regular output, ³ &dEmskpage.z&d@ ³ &dEmscroll.z&d@ ³ &dA &d@ no paramters ³ Pars = (0,0) ³ Pars = (0,1) ³ &dA &d@ (SCORE_PARS = 0) ³ ³ ³ &dA &d@ ÃÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÅÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ´ &dA &d@ Include score ³ &dEspaging.z&d@ ³ &dEscrpage.z&d@ ³ &dA &d@ parameters ³ Pars = (1,0) ³ Pars = (1,1) ³ &dA &d@ (SCORE_PARS = 1) ³ ³ ³ &dA &d@ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÁÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ &dA &d@ Compiling Paramaters (SCORE_PARS, SCROLL_OUT) &dA &dA &d@ The mskpage.z and mscroll.z programs are run from score type &dA &d@ libraries, e.g., &dCscore&d@, &dCskore&d@, &dCparts&d@, etc., in various sizes &dA &dA &d@ In contrast, the spaging.z and scrpage.z programs can only be &dA &d@ run from the &dCscrcon&d@ library. The reason is that these problems &dA &d@ rely on extra parameters generated only by autoscr, which puts &dA &d@ its output in scrcon. &dA &dA &d@ By convention, the output to multiple pages (SCROLL_OUT = 0) &dA &d@ should be directed to the library &dCpages&d@ within the working &dA &d@ library (described above). The output to a single scrolling &dA &d@ page (SCROLL_OUT = 1) should be directed to the library &dCspage&d@ &dA &d@ in the same working library. &dA &dA &d@ mskpage and its derivitives take advantage of a format file &dA &d@ in the library &dCformats&d@ (in the working directory), if one has &dA &d@ been created. If extensive work has been done on formatting &dA &d@ page output, the interline spacings (system spacings) may have &dA &d@ become skewed in various ways that would be undesirable for &dA &d@ simple scrolled output. For this reason, there may be a &dA &d@ second format library called &dCsformats&d@ containing format files &dA &d@ for use only with &dEmscroll.z&d@ and &dEscrpage.z&d@. &dA &dA &dA &dA &d@ Version control &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ 03-25-06 Adding code to construct "@ MVT:", "@ SYSTEM:" &dA &d@ "@ SOURCE:", "@ LINE:" and "@ TEXT:" records. &dA &dA &d@ 11-12-06 Fixing a small bug &dA &dA &d@ 11-20-06 Adding an option for running a "simple test" &dA &dA &d@ 11-20-06 Fixing a minor bug related to right justification &dA &dA &d@ 02-09-07 Fixing a minor bug related whole rests &dA &dA &d@ 10-15-07 Adding a feature that allows a line of music with &dA &d@ non floating rests to be removed if capital letters &dA &d@ were used to denote the rest type. In this situation &dA &d@ the autoset/autoscr program denotes rests with &dA &d@ jtype = "r" instead of jtype = "R". Mskpage treats &dA &d@ the small r as a flag, and substitutes a capital R &dA &d@ in the output file (we hope). &dA &dA &d@ 11-02-07 I need to do something about the case where there is &dA &d@ a key change at the end of a line &dA &dA &d@ 05-06-08 I found an area of mskpage which seems to be incomplete &dA &d@ This showed up in a case where a first ending was quite &dA &d@ long--spanning two pages, and starting at the beginning &dA &d@ of a line, i.e., thrown over from the bar line on the &dA &d@ previous page. I think I have written some robust code &dA &d@ to deal with this situation, but this code does not deal &dA &d@ with the case where an ending neither starts nor ends on &dA &d@ a page. Furthermore, this problem may extend to other &dA &d@ horizontal lines as well, in which case the algorithm &dA &d@ may need to be extended. &dA &dA &d@ 06-09-08 Referring to the previous entry, it turns out that mskpage &dA &d@ was deficient in dealing with several super-object types &dA &d@ extending over more than two systems. I have chosen to fix &dA &d@ only one of these cases at this time, namely dashes. &dA &d@ The fix requires new code in three places: &dA &dA &d@ 1) setting superdata(f12,k,6) = 234567 when an incomplete &dA &d@ dashes super-object is encountered at the end of a system. &dA &d@ This is a magic number for dashes only. &dA &dA &d@ 2) When processing a part on a new system, if &dA &d@ superdata(f12,k,6) = 234567, then set superdata(f12,k,7) = 1. &dA &d@ This signals an incompelete dashes super-object at the &dA &d@ beginning of a system. &dA &dA &d@ 3) Mskpage already tries to typeset incomplete (split) &dA &d@ super-objects at the end of a system line; the problem was &dA &d@ that if the object starting the super-object was not also on &dA &d@ that line, then there was no start and therefore no visable &dA &d@ super_object. Now, for dashes, if superdata(f12,k,7) = 1, &dA &d@ an object mark is placed at the beginning of the line. &dA &dA &d@ 4) Of course, superdata(f12,k,6) and superdata(f12,k,7) must &dA &d@ now be initialized to zero whenever a new super-object is &dA &d@ encountered. &dA &dA &d@ I think this type of code will also work for octave transpositions, &dA &d@ but not for slurs or wedges. &dA &dA &d@ 10-08-08 When typesetting parts, we sometimes want a wider page format. &dA &d@ I am introducing a compile variable WIDE, which when set will &dA &d@ widen the horizontal limits on systems. &dA &dA &d@ 10-08-08 mskpage has the annoying feature of placing the measure numbers &dA &d@ where they can get in the way of other things at the beginning &dA &d@ of the line. I changed this. Lets see how we like the new code. &dA &dA &d@ 10-31-08 I added a feature to autoset, which recognized the subdivision &dA &d@ of multiple rests into smaller units. Under normal conditions &dA &d@ when making parts, mskpage handles this just fine. But if &dA &d@ mskpage is used for comparing parts, this feature caused &dA &d@ some measures to be "double counted," thus throwing off the &dA &d@ counters and flags. The problem and its "fix" are described &dA &d@ in more detail in the code. Like many fixes however, there &dA &d@ may be some unwanted side effects. &dA &dA &d@ 11-06-08 There is a corner case I don't understand yet. It can result &dA &d@ in delta being 0 unexpectedly at a point in the line adjustment &dA &d@ loop, which leads to code failure. To avoid this, I include code &dA &d@ which terminates the line adjustment loop when delta = 0, but &dA &d@ the corner case still exists. &dA &dA &d@ 01-01-09 Adding notesize 16 &dA &dA &d@ 01-01-09 Expanding on the "wide" score feature. The 4th line of the &dA &d@ formats file may now contain extra words which can be used &dA &d@ to set the horizonal margins of the system. If the word &dA &d@ "wide" is found in the line, mskpage looks for two numbers. &dA &d@ These are interpreted as the number of dots, left and right, &dA &d@ to expand the margins. If no numbers are found, the defaults &dA &d@ are 100 and 100 dots. &dA &dA &d@ 01-29-09 I have encountered a new problem with object order. When there &dA &d@ is a clef change at the end of a measure, and this is preceded &dA &d@ by grace notes at the end of that measure, the autoset program &dA &d@ does the predictable thing, i.e., set the grace notes first, &dA &d@ then the clef change. But mskpage thinks that grace notes at &dA &d@ end of a measure can only be followed by more grace notes or &dA &d@ by a bar line. I'm not sure what the global "fix" for this &dA &d@ problem is; object order has always been problematic in this &dA &d@ program. What I propose here is a simple "case fix." I have &dA &d@ found a place in the program where a call to getcontrol caused &dA &d@ the control record &dCcrec&d@ to actually back up. Since this, in &dA &d@ theory, should never happen, and since this occurs specifically &dA &d@ when grace notes at the end of a measure are followed not by &dA &d@ a bar line but by an end-of-meausre clef change, I have added &dA &d@ some code to negate this backup. For the moment, this seems to &dA &d@ fix the problem. Stand by. &dA &dA &d@ 01-29-09 Adding a small feature that allows the instrument designation &dA &d@ for the grand staff (e.g., Pf) to be placed midway between the &dA &d@ the staves &dA &dA &d@ 02-01-09 Guess what! We really did run out of super-object capacity. &dA &d@ We need to make this bigger. The limit is now N_SUPER. &dA &dA &d@ 02-13-09 Well, I found the place where mskpage was misallocating space &dA &d@ for multiple rests at the beginning of a system line (parts only). &dA &d@ It's fixed now (I think). &dA &dA &d@ 03-06-09 There needs to be a way to enter the "wide" command when there &dA &d@ is no format file (or when a new format file is being compiled). &dA &dA &dA &d@ 11-30-09 Adding the "scrolling" versions of mskpage.z and spaging.z &dA &dA &dA &d@ &dE ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» &dA &d@ &dE º PAGING º &dA &d@ &dE º ============ º &dA &d@ &dE º(rev. 10/04/07) º &dA &d@ &dE ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ &dA &dA &dA &d@ This program is the second of a set of three programs designed &dA &d@ to convert &dEMUSEDATA Stage 2&d@ full-score files into &dESCORE pmx&d@ &dA &d@ files. The program was originally based on the 2.2 version &dA &d@ (rev. 12/04/00) of mskpage. The current version is merged &dA &d@ with mskpage on 10/12/07. The input to the program are non &dA &d@ page specific I-files, with additional information attached &dA &d@ by the autoscr program. &dA &dA &d@ While compiling page files, the paging program has new, &dA &d@ additional tasks to perform. It must pass on information &dA &d@ from non page specific i-files to page specific i-files which &dA &d@ the mskpage program does not have to deal with. The paging &dA &d@ program may also provide additional processing that will make &dA &d@ scorecon's job easier. In particular, there is a lot of &dA &d@ information relating to horizontal and vertical position, &dA &d@ which is being generated for the first time by paging and &dA &d@ which translates directly into SCORE parameters. &dA &dA &d@ Since versatility of size is not a consideration in data conversion, &dA &d@ the paging program is designed to operate at one size only, namely, &dA &d@ size-14. &dA #define XVERSION 0 #define SCORE_PARS 0 /* (makes spaging.z) #define SCROLL_OUT 0 /* (makes mscroll.z) #define DISP_DISK "j" &dA &dA &d@ Program modifications &dA #define ADD112506 1 &dA #define OVERRUN 1 #define BEAM_OFFSET 12 #define TIE_OFFSET 25 #define LARGE_BRACK 42 #define SMALL_BRACK 43 #define MEAS_SUGG 1 #define NOTEZ 14 #define M_NUM_FONT 37 #define UP 0 #define DOWN 1 #define NAMELEN 17 #define MREPORT 0 #define REPORT 0 #define REPORT2 0 #define SHOWLARR 0 #define SUPERSIZE 128 #define MAX_BNOTES 32 #define N_SUPER 16 /* New &dA02/01/09&d@ #define LIM1 20000 #define INT100 100 #define PRE_DIST 1 #define MNODE_TYPE 2 #define TIME_NUM 3 #define SNODE 4 #define ACT_FLAG 5 #define M_ADJ 6 #define MARR_TEMP 7 #define MARR_PARS 7 #define YES 0 #define NO 1 #define TRUE 0 #define FALSE 1 #define ON 0 #define OFF 1 #define OPT_INST 0 #define CONTINUO 0 #define MAGIC1 300 #define WIDE 0 #define BIG16 1 *process X &dA &dA &d@ #define statements brought over from ESKPAGE &dI#&d@define UP 0 &dI#&d@define DOWN 1 #define REPORT3 0 &dI#&d@define SUPERSIZE 128 #define SUPERMAX 50 &dI#&d@define MAX_BNOTES 32 #define LMARG 30 &dK#&d@define RMARG 1200 #define RMARG 1000 #define TMARG 50 &dK#&d@define BMARG 820 #define BMARG 720 #define LMARG2 400 #define RMARG2 800 #define TMARG2 300 #define BMARG2 600 #define MSGTAB1 20 #define MSGTAB2 220 #define MSGTAB3 420 #define MSGTAB4 680 #define MSGTAB5 20 #define MSGTAB5A 140 #define MSGTAB6 600 #define MSGTAB6A 670 #define MSGROW1 20 #define MSGROW2 40 #define MSGROW3 60 #define MSGROW4 80 #define MSGVLOC 0 #define MSGFONTZ 6 #define MSGFONT 34 #define MSGLINOPT 0 #define LMRG1 8 #define LMRG2 4 #define LMRG3 3 #define LMRG4 2 #define TMRG1 146 #define TMRG2 73 #define TMRG3 49 #define TMRG4 37 #define TOP_FLAG 0 #define BOTTOM_FLAG 1000000 #define N_SIZES 12 #define TIE_DISTS 200 #define DOT_CHAR 44 #define MACFILE "mskmac.k" &dA &dA str file.280,out.10000,line.280,line2.180,temp.180,temp2.180,temp3.180,temp1.180 str line3.180 str bigline.1000 str inlib.100,tline.180,outlib.100 str ttext.180,linepiece.180(5) str jtype.1,htype.1,xbyte.10(32),cjtype.1 str beamcode.6(MAX_BNOTES),syscode.80,superline.180,savesyscode.80 str formatfile.200 #if SCROLL_OUT int ldist,larr(30000,MARR_PARS),marr(6000,MARR_PARS),larc,marc,tarr(32) int tdist(32,2),nflg1,rflag(2000),barcount,barpar(2000,3) #else int ldist,larr(300,MARR_PARS),marr(60,MARR_PARS),larc,marc,tarr(32) int tdist(32,2),nflg1,rflag(40),barcount,barpar(40,3) #endif int tarr2(32),tarr3(32),tarr4(32,4),tarr5(32,2) int adjarr(300,4),adjarc,small(300),scnt,pdist,larc2 int textflag,cflag,stopflag int endflag,oldmpoint,dxoff(32),dyoff(32),oldmp2,firstpt,point int prev_point,point_adv int delta,rec,crec,saverec,endbarrec,drec(32) int beamh,beamt,beamfont,stemchar int backloc(32),uxstart(32),uxstop(32) int nuxstop(32) int savenoby(32) int hxpar(25),hpar(32,25),vpar(32,41),zak(2,7),vpar20(32) int a,b,c,d,e,g,h,i,j,k,n,x,y,z int q(12) int df,delta_e /* delta_e New &dA10/14/07 int @a,@b,@c,@d,@e,@k,@m,@q,@r int a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14 int c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16,c17,c18,c19,c20 int q1,q2,q3,q4,q5 int f(32,17),f1,f2,f3,f4,f5,f11,f12,f13 int notesize,mtfont,snode,dincf,supcnt,textlen,maxnotesize int barnum,oldbarnum,newbarnum int cntype,coby,cz,csnode int cdincf(32),ndincf(32),oldcdincf int rmarg,lowerlim,toplim int false_rmarg int superdata(32,N_SUPER,SUPERSIZE),supermap(32,N_SUPER),superpnt(32,N_SUPER) /* N_SUPER is New &dA02/01/09 int sp,sq(32),vst(32),psq(32) int x1,x2,y1,y2 int bcount,beamdata(MAX_BNOTES,2),bstem(MAX_BNOTES,2) int ntype,stem,key(32),clef(32,2),tcode(32),savtcode(32) int oby,sobx,soby,supernum int sobx2,saved_sobx2 int sitflag,tspan int page,sysh,syslen,sysy,gbar(2),gbarflag,tplace int w(32) int olddist(32),bolddist(32),obx,dvar1,dvar2,dv3,dv4,olddv1(32),cdv int oldcdv,cdv_adv,backtxobrec int lpt int firstbarflag int spc(255), curfont int start_beam(2),stop_beam(2) table X(400000) table Y(400000) table Z(400000) &dA &dA &d@ Variables added to enable mskpage to right justify last line &dA str tacetline.180,mvtline.180 int formatflag,justflag int syscnt,maxsystems int sysbarpar(400,5) int old_sysbarpar(400,2) int sav_sysbarpar(400,5) int savec int mspace(2000),mcnt int deadspace,lastk int old_extra,average_extra int start_look int new_start_look int start_sys int sys_count &dA &dA &d@ Variables added to enable mskpage to position numbers in the middle of &dA &d@ measures. &dA int half_back &dA &dA &d@ Variables added to deal with ties that cross system boundaries &dA str temp4.20 int conttie(32) int trec &dA &dA &d@ Variable added to deal with measures that are not fungable space-wise &dA int adj_space int small2(300),scnt2 int single_meas &dA &dA &d@ Variables added for 3.0 version &dA str outfile.280 int forp,forpz int mainyp,sv_mainyp int y1p,y2p,y3p int pn_left table F(1000) #if SCROLL_OUT table T(300000) #else table T(30000) #endif real rx,ry,rz &dA &dA &d@ Variables added for extended format files &dA #if SCROLL_OUT int plarr(30000,2),cum_larr(30000,2),larr_gen(200000),cum_larrz #else int plarr(300,2),cum_larr(300,2),larr_gen(20000),cum_larrz #endif int plarc,psysnum,edflag,larrx,cum_x,barcum_x &dA &dA &d@ Variables added for implementing optional staff lines &dA int rest7,intersys,firstsys,f11out,mnum,bottom_sq,tf11 int tsq(32),tvst(32),tnotesize(32),sys_bottom &dA &dA &d@ Variables added for implementing tag records &dA str abbr.40(200) int recflag(400000),abbr_cnt,current_recf int type1_dflag(32),type2_dflag(32) int save_type1_dflag(32),save_type2_dflag(32) &dA &dA &d@ Variables added for dealing with NEWFONTS &dA str XFontstr.76(12) int nsizes(12),revsizes(24) int XFonts(12,19) int Fspacex(90) int wedgefont(24) int scfont(24) int revmap(400) int Mbeamfont(24) int sizenum &dA &dA &d@ Variables added for extended music fonts &dA int dummy(12) int extendoff(12) &dA &dA &d@ Variables added for dealing with mid-movement justification &dA int t1,t2,t3,t4,t5,t6,t7 int sys_jflag int new_syscnt(80),new_maxsystems(80),section_cnt int mcnts(5000) int mspace2(20000) int no_action &dA &dA &d@ Variables for looking inside directories &dA str dir_contents.20(2000) int dir_size &dA &dA &d@ Variables added for dealing with wider margins &dA01/01/09&d@ &dA table GN(100) &dA &dA &d@ Variables added to distinguish between pages and spage output &dA int max_larc &dA &dA &dA &d@ Variables added to the paging program (the SCORECON project) &dA03/25/03&d@ &dA &dA &d@ mrest_data(32) = string containing P7 data for mrests while being set &dA &d@ header1 = header string for SCORECON I-files &dA &d@ header2 = contains composer and source &dA &d@ header3 = contains work number and title &dA &d@ header4 = contains page number &dA &d@ table Y = output table &dA &d@ xx(20) = work space &dA str mrest_data.80(32) str header1.180 str header2.180 str header3.180 str header4.80 int xx(20) &dA &dA &d@ Variables added for dealing with single line staff &dA str lbyte.1 int stave_type &dA &dA &d@ Variables added for dealing "@" records &dA str andata_file.200 str composer_work.80 str @system.120 str @line.50(50) str @sources.200(50) int andata_flag int tq_size &dA &dA &d@ Variables added for running a "simple test" &dA11/20/06&d@ &dA int simple_test &dA &dA &d@ Variable added to try to fix an end-of-measure bug &dA11/25/06&d@ &dA str last_jtype.1 &dA &dA &d@ Variable added to throw directives a the end of lines &dA &d@ to the following line &dA11/21/07&d@ &dA int new_direct(100,2) int save_direct(100,2) int new_dircnt int save_dircnt &dA &dA &d@ Variables added to fix a problem with P3 data &dA11/24/07&d@ &dA int p3_fix(100) int p3_fixcnt int p31,p32 int p31a,p32a int sgnp31,sgnp31a int pp3,pp3a table Q(1000) &dA &dA &d@ &dE &dA &d@ &dE Variables transferred from ESKPAGE &dA &d@ &dE &dA #if XVERSION str tiefile.280(4) str textline.232 str tbyte.1,save_jtype.1 str eskxbyte.1(10) str quote.1 str esksyscode.50 int eskdyoff(10),eskbackloc(10),ibackloc(10) int eskuxstart(10),eskuxstop(10),buxstop(10) int eskrec,esksaverec,trec2 int beamfy,qwid,bthick int underflag int pos(256),urpos(256),underspc(12),hyphspc(12) int wak(9),eskhpar(63),eskvpar(45),eskvpar20 int q(12),beamext(435,12),tiearr(N_SIZES,4,TIE_DISTS,12) int eskf(32,10),f01,f03,f04,eskf11,eskf12 int msknotesize int esksuperdata(SUPERMAX,SUPERSIZE),esksupermap(SUPERMAX),esksuperpnt(SUPERMAX) int tupldata(7),tbflag int esksp,esksq(32),eskvst(32) int z1,z2,z3 int d1,d2 int hd,vd,tiechar,tcnt,textend,expar(8) int esksysy,esksysh,esksyslen,sysflag,sysnum,esksysright int barbreak(10,2),brkcnt int addcurve int music_con(255) int ntext,tlevel int postx,posty int tpost_x,tpost_y,tpost_leng /* add &dA04/20/03&d@ int figoff(32) /* add &dA09/14/03&d@ int nsz(32) /* add &dA11/13/03&d@ int govstaff /* add &dA11/13/03&d@ int savensz /* add &dA11/13/03&d@ int savesub /* add &dA11/13/03&d@ int barlinks(1000) /* added &dA12/06/03&d@ int barlink_cnt /* added &dA12/06/03&d@ table X(100000) table X2(1000) &dA &d@ variables added to make screen display work int FA(750000) int activefont str gstr.3000000,tstr2.260000,tstr3.170000,tstr4.150000 str red_gstr.940000,red_tstr2.260000,red_tstr3.170000,red_tstr4.150000 str blue_horiz1t.400,blue_horiz2t.200,blue_horiz3t.150,blue_horiz4t.130 str blue_horiz1b.400,blue_horiz2b.200,blue_horiz3b.150,blue_horiz4b.130 str blue_vert1v.3500,blue_vert2v.1850,blue_vert3v.1300,blue_vert4v.1020 str blue_vert1r.3500,blue_vert2r.1850,blue_vert3r.1300,blue_vert4r.1020 int xco, yco int xze, yze str zline.80 int curdist int altflag int scx,scy,scf,scb &dA &d@ variables added for printing long slurs str longslur.320(250) int slur_edit_flag bstr bt.2500(250) bstr dotted.2500 int gapsize &dA &d@ variables added for editing int pointers(2000,10) int nodelist(1000,2) int super_pointers(500,4) int nodelistcnt int object_count,nodenum,measnum int super_count int linepoint,syspoint,curnode,savecurnode int xbacknode,xsavecurnode,xupnode int grand_space,oldrestx int trigger int obcursor,supercursor,relob_cnt,related_objects(2000) int o(8) int oldk,ptoggle str messages.180(40),sub_def.30(255),obj_def.30(15),super_def.30(12) str cmode.1,newcmode.1,rectype.1 str current_line.180,new_line.180 str current_def.180,new_def.180 int message_row(4) int X_point,table_size,SX_point int temp_store_ob(200,2) int system_rec(30),system_cnt int list_order(10000,5) str curdata.30(20) int CURSOR(25) bstr tbstr.800 str curstr.200 str msgstr.20000 str redmsgstr.20000 int xcur, ycur,x2cur,y2cur,acur,bcur str gline.360 int trecord_cnt int con1,con2,con3,con4 int conx1,cony1,conx2,cony2 int hght(140),dpth(140) int incre,textoff int aa,gg,hh str ttline.120 &dA &dA &d@ variables added for macros &dA11/25/03&d@ &dA str macfile.280 int macros(8,100),macstrokes(8),macchange int macropnt(8) #endif &dA &dA &d@ Start Program Code &dA &dK &d@ trace cum_larr(1,1) &dK &dK &d@ trace cum_larr(2,1) &dK &dK &d@ trace cum_larr(3,1) &dK &dK &d@ trace cum_larr(4,1) &dK &dK &d@ trace cum_larr(5,1) &dK &dK &d@ trace cum_larr(6,1) &dK &dK &d@ trace cum_larr(7,1) &dK &dK &d@ trace cum_larr(8,1) &dK &dK &d@ &dK &d@ used in finding a problem with "double counting" &dK &d@ trace marr(1,1) &dK &d@ of measures. &dK &d@ trace larr(1,1) &dK &dK &d@ trace larr(2,1) &dK &dK &d@ trace larr(7,1) &dK &dK &d@ trace barcount &dK &dK &d@ trace larc &dK mtfont = 31 cdv = 0 backtxobrec = 0 saved_sobx2 = 100 perform newfont_init #if XVERSION perform start_xversion #endif #if SCORE_PARS putc putc &dEÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ putc &dEº MUSEDATA to SCORE conversion process º&d@ putc &dEº ==================================== º&d@ putc &dEÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ putc putc Part II: Building page specific I-files from non page specific I-files putc putc The home directory for this window should be directory putc the OUTPUTS/SCRCON sub-directory the &dEmusical work&d@ you are putc converting. You should see the I-FILES sub-directroy in putc an F4 listing, and if there is no PAGES sub-directory, you putc should allocate one, as well as the necessary movement putc sub-directories inside PAGES, corresponding to the movements putc in I-FILES. putc putc #endif putc Make page files from intermediate files putc LIBQ1: putc Input Library name? getc inlib inlib = trm(inlib) if inlib = "" goto LIBQ1 end if inlib con ":" or inlib{1} = "/" else getdir line inlib = line // "/" // inlib end temp = inlib inlib = inlib // "/" LIBQ2: putc Output Library name? getc outlib outlib = trm(outlib) if outlib = "" goto LIBQ2 end if outlib con ":" or outlib{1} = "/" else getdir line outlib = line // "/" // outlib end putc starting number getc a1 putc number of parts getc f11 &dA &dA &d@ Look for format file and (&dA03/25/06&d@) andata file &dA formatfile = "" formatflag = 0 @a = 0 andata_flag = 0 andata_file = "" @b = 0 #if SCROLL_OUT @c = 0 #endif i = 0 if a1 = 1 perform look_dir (temp) if dir_size = f11 if temp con "i-files" temp3 = temp{mpt..} temp = temp{1,mpt-2} if temp3 con "/" temp3 = temp3{mpt+1..} temp3 = trm(temp3) /* this is a mvt name (usually a number) end perform look_dir (temp) loop for i = 1 to dir_size temp2 = dir_contents(i) temp2 = temp2 // pad(7) if temp2{1,7} = "formats" @a = 1 end if temp2{1,6} = "andata" @b = 1 end #if SCROLL_OUT if temp2{1,8} = "sformats" @c = 1 end #endif repeat end end end &dA &dA &d@ For the "scrolling version," look for an &dCsformats&d@ library first &dA #if SCROLL_OUT if @c = 1 temp1 = temp // "/sformats" perform look_dir (temp1) j = 0 if dir_size > 0 loop for j = 1 to dir_size temp2 = dir_contents(j) temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = trm(temp2) if temp2 = temp3 j = 10000 end repeat end if j = 10000 /* we found a format file in &dCsformats&d@ formatflag = 1 @a = 0 /* so don't use the &dCformats&d@ library end formatfile = temp1 // "/" // temp3 end #endif &dA if @a = 1 temp1 = temp // "/formats" perform look_dir (temp1) j = 0 if dir_size > 0 loop for j = 1 to dir_size temp2 = dir_contents(j) temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = trm(temp2) if temp2 = temp3 j = 10000 end repeat end if j = 10000 formatflag = 1 end formatfile = temp1 // "/" // temp3 end &dA &dA &d@ Look for "andata" file here (&dA03/25/06&d@) and get data &dA &d@ Set up @system and @line(.) strings &dA &dA &d@ Don't include andata in score conversions &dA #if SCORE_PARS @b = 0 #endif if @b = 1 temp1 = temp // "/andata" perform look_dir (temp1) j = 0 if dir_size > 0 loop for j = 1 to dir_size temp2 = dir_contents(j) temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = trm(temp2) if temp2 = temp3 j = 10000 end repeat end if j = 10000 andata_flag = 1 end andata_file = temp1 // "/" // temp3 open [5,1] andata_file getf [5] composer_work composer_work = trm(composer_work) loop for j = 1 to 1000 getf [5] temp tput [Q,j] ~temp repeat eof5: close [5] tq_size = j - 1 tget [Q,1] temp @system = "@ SYSTEM: " // composer_work // " -- " // temp{10..} loop for j = 2 to tq_size tget [Q,j] temp if temp{8} = "L" k = int(temp{10..}) if temp con ">" @line(k) = "@ LINE: " // chs(k) // " " // temp{mpt+2..} end end repeat end &dA &dA &dA &d@ Transfer source files to X table &dA putc transferring ... k = 0 abbr_cnt = 0 loop for f12 = 1 to f11 current_recf = 0 ++k f(f12,1) = k if a1 < 10 file = inlib // "0" // chs(a1) else file = inlib // chs(a1) end open [2,1] file getf [2] line &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS line = line // pad(30) if line{1,15} <> "SCORECON I-FILE" putc putc The i-files you are using were not created by autoscr and cannot putc be read properly by the paging program. The SCRCON and SCORE putc directories are very similar. Be sure you are in the SCRCON directory. putc putc &dEBye for now.&d@ putc stop end header1 = "SCORECON PAGE I-FILE. " // line{19..} getf [2] line header2 = line getf [2] line header3 = line getf [2] line &dA &dA &d@ Set line flag &dA f(f12,15) = 1 if line{1} = "l" f(f12,15) = 2 end &dA vst(f12) = int(line{3..}) /* first numerical parameter in top line f(f12,9) = int(line{sub..}) /* second numerical parameter in top line f(f12,14) = int(line{sub..}) /* third numerical parameter in top line f(f12,16) = 50 /* transposition f(f12,17) = 1 /* instrument number line = line{sub..} line = mrt(line) if line con "|" line2 = line{1,mpt-1} /* strip NTRACK data and transposition data line = line{mpt+1..} if line con "TRANS=" f(f12,16) = int(line{mpt+6..}) end if line con "INSTN=" f(f12,17) = int(line{mpt+6..}) end &dA &dA &d@ New &dA08/24/03&d@ &dA #if OPT_INST if line2 con "[" line2 = "" end #endif tput [Z,k] ~line2 end &dL &dL &d@ xmskpage code &dL &dL #else &dA &dA &d@ Get "@ SOURCE:" record (&dA03/25/06&d@) if there is one &dA if line{1,9} = "@ SOURCE:" line = line // pad(40) if line{11,6} <> " " @sources(f12) = line{11..} else @sources(f12) = "not specified" end getf [2] line else @sources(f12) = "not specified" end &dA &dA &d@ Set line flag &dA f(f12,15) = 1 if line{1} = "l" f(f12,15) = 2 end &dA vst(f12) = int(line{3..}) /* vertical offset to second staff (or 0) f(f12,9) = int(line{sub..}) /* vertical offset to text line f(f12,14) = int(line{sub..}) /* note size if sub <= len(line) line = line{sub..} line = mrt(line) /* part name else line = "" end #if OPT_INST if line con "[" line = "" end #endif tput [Z,k] ~line #endif &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL recflag(k) = current_recf &dA &dA &d@ This code insures that the movement name doesn't get printed twice &dA getf [2] line if line{3} = "D" getf [2] line else line = line // pad(80) ++k tput [Z,k] ~line recflag(k) = current_recf end c1 = 0 loop getf [2] line line = line // " " if line{1} = "T" c2 = int(line{3..}) if line{sub} = "|" c2 = int(line{sub+1..}) end c2 = int(line{sub..}) if c1 < c2 c1 = c2 end end &dA &dA &d@ Code to deal with Tags &dA if line{1} = "Y" /* This is a tag. Don't store it. if line{3} = "P" /* abbr part name if line{5} = "0" current_recf &= 0xff00 /* turn off abbr flag completely else ++abbr_cnt abbr(abbr_cnt) = line{5..} current_recf &= 0xff00 /* turn off any previous pointer current_recf += abbr_cnt /* and store new pointer end end if line{3} = "U" /* line control code c3 = int(line{5}) if c3 < 0 or c3 > 2 putc Invalid line control code: line = ~line stop end current_recf &= 0x00ff /* turn off any previous control code current_recf += (c3 << 8) /* and store new code end else #if SCORE_PARS if line{1,3} = "J B" if line con "|" line = line{1..mpt-1} /* strip NTRACK data end end #endif ++k tput [Z,k] ~line recflag(k) = current_recf /* Flag every record end repeat eof2: close [2] f(f12,2) = k if c1 = 0 c1 = 1 end f(f12,13) = c1 &dA &dA &d@ This code is put in to insure that searches do not extend beyond the end &dA &d@ of a particular i-file &dA &d@ ++k line = " " /* dummy line, beginning with " " tput [Z,k] ~line recflag(k) = 0 /* rec flag is 0 #if SCORE_PARS &dA &dA &d@ initialize superpnt(.,N_SUPER), supermap(.,N_SUPER), superdata(.,N_SUPER,SUPERSIZE) &dA &d@ drec(.), savenoby(.), uxstop(.), nuxstop(.), dxoff(.) &dA &d@ dyoff(.), uxstart(.), backloc(.), xbyte(.) &dA loop for j = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ superpnt(f12,j) = 0 supermap(f12,j) = 0 loop for h = 1 to SUPERSIZE superdata(f12,j,h) = 0 repeat repeat drec(f12) = 0 savenoby(f12) = 0 uxstop(f12) = 0 nuxstop(f12) = 0 dxoff(f12) = 0 dyoff(f12) = 0 uxstart(f12) = 0 backloc(f12) = 0 xbyte(f12) = "**********"{1,f(f12,13)} #endif ++a1 repeat putc done! &dA &dA &dA &d@ New &dA11/24/07&d@ &dA &dA &d@ We need to fix a disconnect in the score generation process. &dA &d@ When autoset generates notes on the same time node but with &dA &d@ different obx positions, it puts them out in an unpredictable &dA &d@ order. If there is a global x shift, this value is represented &dA &d@ with a "P3=" field in the object record, and a "P10=" field &dA &d@ in the note head ("K") records. The disconnect occurs when &dA &d@ the object with the "unshifted" position does not come first. &dA &d@ It appears that mskpage uses the first instance of an object &dA &d@ on a time node as the source for the "official" position for &dA &d@ that node. This is the position that lines up with other &dA &d@ parts having objects at that time position. This doesn't &dA &d@ present a problem for Dmuse typesetting, but it does create &dA &d@ a problem for with the P3 parameter in score typesetting. &dA &d@ Specifically, when the first instance of an object on a time &dA &d@ node is NOT the official position, then the P3 value for all &dA &d@ objects in this part on this node will NOT match the P3's in &dA &d@ the other parts. &dA &dA &d@ I propose the following fix, which need only be done by autoscr &dA &d@ and which should NOT effect the actual position of things. &dA &d@ We need to read through the entire source (Table Z) and look &dA &d@ for those places where note/rest objects have a "P3=" field. If &dA &d@ this is the first instance of a note/rest object on that time node, &dA &d@ then we need to identify all of the note/rest objects on that &dA &d@ time node set their "P3=" fields and "P10=" fields in relation &dA &d@ to what would be an "unshifted" first object. &dA &dA &d@ I apologize in advance for the strungout nature of this code. &dA #if SCORE_PARS a3 = -1 loop for i = 1 to k tget [Z,i] line .t5 a1 a1 a1 a1 a1 line = line // pad(3) if line{1,3} = "J B" a3 = -1 end if line{1,3} = "J N" or line{1,3} = "J R" if a1 = a3 /* make sure a1 is "new" goto FPP03 end a3 = a1 if line con "P3=" /* shifted object at "new" time node p3_fixcnt = 1 p3_fix(1) = i j = i + 1 FPP01: tget [Z,j] line .t5 a2 a2 a2 a2 a2 if line{1} = "J" if a2 = a1 line = line // pad(3) if line{1,3} = "J N" or line{1,3} = "J R" ++p3_fixcnt p3_fix(p3_fixcnt) = j end ++j goto FPP01 else goto FPP02 end end if line{1} = "E" /* emergency exit goto FPP02 end ++j goto FPP01 FPP02: i = j - 1 /* advance "i" if p3_fixcnt = 1 /* "do nothing" case (shouldn't happen) goto FPP03 end p31 = 0 p32 = 0 a4 = p3_fix(1) tget [Z,a4] line .t5 a5 a5 if line con "P3=" /* remove this line = line // " " a6 = mpt a7 = int(line{a6+3..}) a8 = sub line = line{1,a6-1} // line{a8..} line = trm(line) a8 = len(line) if line{a8} = "|" line = line{1,a8-1} line = trm(line) end end tput [Z,a4] ~line a10 = 0 a14 = a4 loop for a8 = 1 to 20 ++a4 tget [Z,a4] line .t3 a9 if line{1} = "K" and line con "|" line = line // " " if a9 = 0 a10 = 1 if line con "P10=" a7 = mpt + 4 if line{a7} = "-" sgnp31 = -1 ++a7 else sgnp31 = 1 end p31 = int(line{a7..}) a6 = sub if line{a6} = "." p32 = int(line{a6+1..}) a6 = sub else p32 = 0 end end end end repeat while line{1} <> "A" if a10 = 0 a4 = a14 loop for a8 = 1 to 20 ++a4 tget [Z,a4] line if line{1} = "K" and line con "|" line = line // " " a10 = 1 if line con "P10=" a7 = mpt + 4 if line{a7} = "-" sgnp31 = -1 ++a7 else sgnp31 = 1 end p31 = int(line{a7..}) a6 = sub if line{a6} = "." p32 = int(line{a6+1..}) a6 = sub else p32 = 0 end end end repeat while line{1} <> "A" and a10 = 0 end if a10 = 0 dputc Program error stop else pp3 = p31 * 100 + p32 end loop for j = 1 to p3_fixcnt a4 = p3_fix(j) tget [Z,a4] line .t5 a6 a6 a7 = a6 - a5 if a7 <> 0 if line con "|" line = line // " P3=" else line = trm(line) line = line // " | P3=" end if a7 < 0 line = line // "-" a7 = 0 - a7 end line = line // chs(a7) tput [Z,a4] ~line end loop for a8 = 1 to 20 ++a4 tget [Z,a4] line if line{1} = "K" and line con "|" line = line // " " if line con "P10=" a13 = mpt a7 = mpt + 4 if line{a7} = "-" sgnp31a = -1 ++a7 else sgnp31a = 1 end p31a = int(line{a7..}) a6 = sub if line{a6} = "." p32a = int(line{a6+1..}) a6 = sub else p32a = 0 end pp3a = p31a * 100 + p32a a11 = (sgnp31a * pp3a) - (sgnp31 * pp3) if a11 = 0 line = line{1,a13-1} // line{a6+1..} line = trm(line) else temp3 = "" if a11 < 0 a11 = 0 - a11 temp3 = "-" end a12 = a11 / 100 a9 = rem temp3 = temp3 // chs(a12) // "." if a9 < 10 temp3 = temp3 // "0" end temp3 = temp3 // chs(a9) line = line{1,a13+3} // temp3 // line{a6..} line = trm(line) end else if line con "P9=" a13 = mpt else if line con "P8=" a13 = mpt else if line con "P7=" a13 = mpt end end end a9 = int(line{a13+3..}) a6 = sub if line{a6} = "." a9 = int(line{a6+1..}) a6 = sub end a11 = 0 - (sgnp31 * pp3) temp3 = "P10=" if a11 < 0 a11 = 0 - a11 temp3 = temp3 // "-" end a12 = a11 / 100 a9 = rem temp3 = temp3 // chs(a12) // "." if a9 < 10 temp3 = temp3 // "0" end temp3 = temp3 // chs(a9) line = line{1,a6} // temp3 // line{a6..} line = trm(line) end tput [Z,a4] ~line end repeat while line{1} <> "A" repeat end end FPP03: repeat &dK &d@ loop for i = 1 to k &dK &d@ tget [Z,i] line &dK &d@ putc .w6 ~i ~line &dK &d@ repeat &dK &d@ getc #endif &dA &dA &d@ End of &dA11/24/07&d@ addition &dA &dA perform parameter_init &dA &dA &d@ Check for snode = 10000 at end of each part &dA loop for f12 = 1 to f11 tget [Z,f(f12,2)] line .t5 a dvar1 a a a if a <> 10000 putc Error: Part ~f12 does not end with an snode = 10000 putc last line = ~line º examine stop end repeat &dA &dA &d@ Set up mechanism for page specific output &dA perform pageform_init REALWORK: if justflag = 3 loop for i = 1 to maxsystems old_sysbarpar(i,1) = sysbarpar(i,1) old_sysbarpar(i,2) = sysbarpar(i,2) repeat end new_dircnt = 0 /* New &dA11/21/07&d@ save_dircnt = 0 /* New &dA11/21/07&d@ mnum = 1 sys_count = 1 syscnt = 0 savec = 0 mcnt = 0 deadspace = 0 stopflag = 0 endflag = 0 f4 = 0 adj_space = YES loop for i = 1 to 32 conttie(i) = 0 repeat loop for i = 1 to f11 f(i,5) = 0 f(i,7) = 0 f(i,8) = 0 f(i,11) = 0 key(i) = 0 &dA &dA &d@ initialize superpnt(.,N_SUPER), supermap(.,N_SUPER), superdata(.,N_SUPER,SUPERSIZE) &dA &d@ drec(.), savenoby(.), uxstop(.), nuxstop(.), dxoff(.) &dA &d@ dyoff(.), uxstart(.), backloc(.), xbyte(.) &dA loop for j = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ superpnt(i,j) = 0 supermap(i,j) = 0 loop for h = 1 to SUPERSIZE superdata(i,j,h) = 0 repeat repeat drec(i) = 0 savenoby(i) = 0 &dK &d@ uxstop(i) = 0 nuxstop(i) = 0 dxoff(i) = 0 dyoff(i) = 0 uxstart(i) = 0 backloc(i) = 0 xbyte(i) = "**********"{1,f(f12,13)} repeat sp = hxpar(3) + hxpar(9) loop for i = 1 to f11 sq(i) = psq(i) repeat if justflag < 2 page = 0 treset [Y] mainyp = 0 sv_mainyp = 0 #if SCORE_PARS tput [Y,1] X 31 1050 30 ~header1 tput [Y,2] X 31 1090 65 ~header2 tput [Y,3] X 31 1090 100 ~header3 tput [Y,4] X 31 2120 30 Page: 1 mainyp = 4 sv_mainyp = 4 #endif end if tacetline <> "" #if SCORE_PARS i = len(tacetline) i = i * 12 x = 1200 - i /* earlier version: x = 1400 - i if justflag < 2 ++mainyp tput [Y,mainyp] X 46 ~x ~sq(1) ~tacetline end #else if justflag < 2 ++mainyp tput [Y,mainyp] X 46 1200C ~sq(1) ~tacetline end #endif loop for i = 1 to f11 sq(i) += 150 repeat end if justflag < 2 ++mainyp if len(mvtline) > 3 if mvtline{1,3} = "(c)" mvtline = mvtline{4..} tput [Y,mainyp] X 46 1200C ~sq(1) ~mvtline else tput [Y,mainyp] X 46 575 ~sq(1) ~mvtline end else tput [Y,mainyp] X 46 575 ~sq(1) ~mvtline end end loop for i = 1 to f11 sq(i) += 120 /* This moves system down to accommodate mvtline repeat sysy = sq(1) sysh = sq(f11) - sq(1) + vpar(f11,8) + vst(f11) bottom_sq = sq(f11) sys_bottom = sq(f11) + vst(f11) &dA &dA &d@ 1. initialize variables &dA ldist = sp loop for f12 = 1 to f11 rec = f(f12,1) + 1 f(f12,4) = rec f(f12,6) = rec f(f12,10) = 0 olddist(f12) = 0 repeat f3 = 0 pdist = 0 larc = 0 barcount = 0 loop for i = 1 to 40 rflag(i) = 0 repeat textflag = 0 barnum = 0 #if SCORE_PARS oldbarnum = 1 /* was 0, now trying 1, which seems to work #else oldbarnum = 0 #endif newbarnum = 0 gbarflag = 0 f13 = 0 &dA &dA &d@ 2. Start initial system &dA &dA &d@ A. Generate entries in marr for clef, key and time &dA &d@ signatures in that order (snode = 6913) &dA syslen = hxpar(4) - sp marc = 0 perform setckt firstpt = ldist - sp &dA &dA &d@ B. Transfer marr to larr &dA loop for i = 1 to marc ++larc #if REPORT putc M~marr(i,1) ... #endif loop for j = 1 to MARR_PARS larr(larc,j) = marr(i,j) repeat repeat #if REPORT putc #endif marc = 0 deadspace = ldist stopflag = 0 sys_jflag = 0 mcnts(syscnt+1) = mcnt &dA &dA &d@ C. Jump over code that sets up to print pages 2ff. &dA &d@ Jump to section that begins reading input &dA &d@ data to construct the next measure (III-5). &dA goto CF &dA &dA &d@ &dA &d@ I. General music system loop (big loop) &dA &dA &d@ 1. Check to see if there is more music. &dA &d@ Jump to process end if not. (FINE) &dA &d@ CHH: sys_jflag = 0 mcnts(syscnt+1) = mcnt loop for f12 = 1 to f11 rec = f(f12,5) perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line if line{1} = "J" and jtype = "M" and snode = 10000 f(f12,8) = 1 end repeat perform endcheck if endflag = 1 if justflag > 0 sysbarpar(syscnt,5) = sysbarpar(syscnt,1) end goto FINE end &dA &dA &d@ 2. Determine location of new system. &dA &dA &d@ Note: We can make a preliminary determination of the vertical &dA &d@ size of the new system, but we will not know the final vertical &dA &d@ size until we have typeset the system and have performed the &dA &d@ the optional removal of "totally resting" lines. &dA sq(1) = bottom_sq + vst(f11) + intersys sp = hxpar(3) loop for i = 2 to f11 if w(1) = 0 /* use default spacings if f(i-1,9) = 0 sq(i) = sq(i-1) + vpar(i-1,14) else sq(i) = sq(i-1) + vpar(i-1,11) end else sq(i) = sq(i-1) + w(i-1) end if f(i-1,12) = 2 sq(i) += vst(i-1) end repeat sysy = sq(1) sysh = sq(f11) - sq(1) + vpar(f11,8) + vst(f11) syslen = hxpar(4) - sp bottom_sq = sq(f11) sys_bottom = sq(f11) + vst(f11) &dA &dA &d@ 3. Compute space for new clef and key &dA perform clefkeyspace deadspace = ldist &dA &dA &d@ 4. Initialize music system (line) variables &dA hxpar(8) = ldist + hxpar(7) line2 = pad(80) loop for f12 = 1 to f11 uxstart(f12) = hxpar(8) backloc(f12) = hxpar(8) olddist(f12) = bolddist(f12) f(f12,6) = f(f12,5) /* record at new measure of music for part(.) f(f12,4) = f(f12,5) f(f12,10) = f(f12,7) /* multiple rest counter for part(.) repeat pdist = ldist - sp f13 = 1 larc = 0 marc = 0 barcount = 0 loop for i = 1 to 40 rflag(i) = 0 repeat textflag = 0 oldbarnum = barnum stopflag = 0 if justflag < 2 firstsys = FALSE end &dA &dA &dA &d@ II. Read measures until ldist > hxpar(4), or until end of data. &dA &dA &d@ Read data one measure at a time. The definition of a complete &dA &d@ measure is when the space node = 6913. There may be several &dA &d@ objects in this position, including clef, key, and time changes, &dA &d@ and also some super-objects. All of these must be read and the &dA &d@ distances included in the "measure". If the last object is not &dA &d@ a bar line, the next object must be checked and the distance to &dA &d@ it used as a temporary negative adjustment to the potential length &dA &d@ of the line (so that there will be space for the last object). &dA &dA &d@ When the addition of a measure distance to the total distance &dA &d@ on a line results in a line overflow, we have two choices: (1) &dA &d@ we may try to condense the longer line to fit, or (2) we may &dA &d@ try to expand the shorter line (i.e. minus the last measure) to &dA &d@ fit. This decision and the resulting processes are in section &dA &d@ III of the process. &dA &dA &d@ We must first establish which parts are active in this measure. &dA &d@ This is also a good time to look for the terminating mark in all &dA &d@ parts. CF: #if SCROLL_OUT rmarg = 10000000 #else rmarg = hxpar(4) #endif false_rmarg = rmarg f2 = 0 nflg1 = 0xffffffff loop for f12 = 1 to f11 notesize = f(f12,14) if f(f12,10) = 0 /* first temporary multiple rest counter rec = f(f12,6) CR: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1,3} = "J S" and f11 > 1 if "467" con line{5} /* multiple rests and whole rests if mpt = 1 f(f12,10) = snode else f(f12,10) = 1 end CP: perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line if line{1,3} <> "J B" ++rec goto CP end &dA &dA &d@ reset olddist(.) to bar line after rest. This reset occurs only &dA &d@ for those parts where f(f12,10) (rest-counter) > 0. Note: at the &dA &d@ point where we start looking at this part again, i.e. the counter &dA &d@ is changing from 1 to 0, we must typeset the concluding bar line &dA &d@ and check to see if there are any addition 6913 type nodes, &dA &d@ e.g., time or key changes, which would have to be included on &dA &d@ this line. &dA olddist(f12) = dvar1 f(f12,6) = rec goto CQ end end if line{1} = "J" if snode = 10000 f(f12,8) = 1 end goto CQ end goto CR end CQ: repeat * perform endcheck if endflag = 1 if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = rmarg - ldist sysbarpar(syscnt,5) = barcount end if justflag <> 1 goto CG else &dK &d@ dputc ldist = ~ldist &dK &d@ dputc barcount = ~barcount &dK &d@ dputc delta = ~delta goto CE end end &dA &dA &d@ endcheck checks all values of f(.,8); they must be either all 0 &dA &d@ or all 1 &dA &dA &d@ Check for whole rests in all parts &dA loop for f12 = 1 to f11 if f(f12,10) = 0 goto CC end repeat &dA &dA &d@ If no branch, then whole rest is in all parts, &dA &dA &dA &d@ 0) check for forced termination &dA if sysbarpar(syscnt+1,3) = barcount and barcount > 0 &dK &d@ dputc Throwing blank measure to next line delta = rmarg - ldist * put in larr entry for terminating bar line ++larc larr(larc,MNODE_TYPE) = 18 /* New &dA05/25/03&d@ larr(larc,ACT_FLAG) = 0xffffffff /* " " larr(larc,M_ADJ) = adj_space /* " " goto CE end &dA &dA &d@ 1) increment ldist, check for overflow &dA ldist += hxpar(6) if ldist > false_rmarg * put in larr entry for terminating bar line ++larc larr(larc,MNODE_TYPE) = 18 larr(larc,ACT_FLAG) = 0xffffffff larr(larc,M_ADJ) = adj_space goto CE end ++mcnt mspace(mcnt) = ldist &dA &dA &d@ 2) check to see if this is the last measure of general rest. If &dA &d@ so, then we will want to look for additional objects such as &dA &d@ clefs, key changes, etc. beyond the terminating bar line. &dA &d@ The code to do this is at CCV. &dA a1 = 0 loop for f12 = 1 to f11 if f(f12,10) = 1 a1 = hxpar(6) ndincf(f12) = 0 end repeat if a1 > 0 f2 = 1 --mcnt goto CCV end &dA &dA &d@ 3) recompute delta &dA delta = rmarg - ldist &dA &dA &d@ 4) advance record pointer and bolddist; decrement f(.,10) &dA loop for f12 = 1 to f11 f(f12,5) = f(f12,6) bolddist(f12) = olddist(f12) --f(f12,10) repeat &dA &dA &d@ 5) increment barcount, set empty bar flag for this bar, zero marc &dA ++barcount ++barnum rflag(barcount) = hxpar(6) &dA &dA &d@ 6) branch; if delta = 0, go to print, else get next measure &dA if delta = 0 * put in larr entry for terminating bar line ++larc larr(larc,MNODE_TYPE) = 18 /* New &dA05/25/03&d@ larr(larc,ACT_FLAG) = 0xffffffff /* " " larr(larc,M_ADJ) = adj_space /* " " if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 sysbarpar(syscnt,5) = 0 /* New &dA05/28/05&d@ end goto CG end goto CF &dAÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ&d@ &dA &dA &d@ At this point we have established that there is at least one active &dA &d@ part in the measure. We now have a well-defined task. We must look &dA &d@ through the active parts (where f(.,10) = 0) for the object(s) which &dA &d@ has (have) the next smallest division number. We are concerned &dA &d@ here with objects that need to "line up". These objects we &dA &d@ call "proper" objects and include: &dA &dA &d@ 1. regular notes, cue notes, figures, isolated objects (NRQFI) &dA &d@ 2. bar lines (B) &dA &d@ 3. key signatures, time signatures (KT) &dA &dA &d@ For purposes of determining position and space, we can skip over &dA &d@ those types of objects in a part that do not have to line up, but &dA &d@ the distances through these objects to the line-up type objects &dA &d@ must be taken into account. The objects that do not have to &dA &d@ line up are called "passing" objects and include: &dA &dA &d@ 1. clef signs (C) &dA &d@ 2. directives (D) &dA &d@ 3. grace notes (G) &dA &d@ 4. symbols (S) &dA &d@ 5. marks (M) &dA &dA &d@ Clef signs actually get special treatment. If they follow a &dA &d@ bar line and have snode = 6913, they are classified as proper &dA &d@ objects; otherwise they are passing objects and their position &dA &d@ is determined by the next proper object in the part. &dA &dA &d@ Our search will cover all objects with snode < 6913. When &dA &d@ snode = 6913, we are at the end of a controlling measure. This &dA &d@ situation will be covered later in the program. &dA &dA &d@ There is one anomaly which should be mentioned. We may encounter &dA &d@ a non-controlling bar line in the middle of our search. In this &dA &d@ case, we will generate two nodes with the same snode number. &dA &d@ These can be differentiated by the node type (marr(.,MNODE_TYPE)). (&dA05/25/03&d@) &dA CC: loop for f12 = 1 to f11 f(f12,5) = f(f12,6) /* set the "beginning of measure" pointers bolddist(f12) = olddist(f12) cdincf(f12) = 0 ndincf(f12) = 0 repeat oldcdincf = 0 loop for k = 1 to 32 tdist(k,1) = 0 repeat &dA &dA &d@ Set tarr array for active parts in this measure. &dA &d@ Set textflag = 1, if any active parts are parts which contain text. &dA loop for f12 = 1 to f11 tarr(f12) = f(f12,10) if f(f12,10) = 0 and f(f12,9) > 0 textflag = 1 end repeat &dA &dA &dA &d@ CHECK POINT: When a new node is identified, the distance to that &dA &d@ node must be added to all the olddist(.) variables, not just to &dA &d@ parts in the node. Then if the next node is generate by part(s) &dA &d@ not in this set (the case which we define as syncopation), you won't &dA &d@ get some huge distance between these nodes. This, however, leads &dA &d@ to another problem. The distance to this next node may become very &dA &d@ small, or even negative. We need to set some minimum distance &dA &d@ for this node; also, we need to identify this node with a new type, &dA &d@ because it will have its own rules for adding distance. The type &dA &d@ shall be 20 + note type that would be generated by the increment &dA &d@ in divisions, or in the case of tuplets, the type shall be 40. &dA &d@ The minimum distance in the case of syncopation shall be determined &dA &d@ in the following manner. &dA &dA &d@ Spacing of Syncopated Nodes &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ Definition: A node is syncopated when it contains no parts which &dA &d@ were also contained in the previous node. &dA &dA &d@ To compute the minimum distance to a syncopated node: &dA &dA &d@ 1) determine the duration of all of the nodes coming into this &dA &d@ node &dA &dA &d@ To do this, we will have to look ahead to the next node &dA &d@ in every active part and read field 8, the preceding &dA &d@ duration parameter. This information can be collected &dA &d@ at the time we are putting the objects for the node &dA &d@ together, since this process requires that we look at &dA &d@ objects up to the point where the node number changes. &dA &d@ When this change does occur, the value of dincf will be &dA &d@ the duration of this node in this part. &dA &dA &d@ 2) the shortest such duration becomes the "controlling duration" &dA &dA &d@ 3) the space occupied by the node generating the controlling &dA &d@ duration becomes the "controlling space" &dA &dA &d@ The space is the advance in the x-coordinate for this &dA &d@ node. This we will have to determine at the time the &dA &d@ syncopation is discovered. At least we will already &dA &d@ know the controlling duration and therefore the part &dA &d@ which must be examined. We must look forward to the &dA &d@ first &dDproper&d@ object which has a new node number. &dA &dA &d@ 4) determine the ratio between the duration advance to this &dA &d@ node and the controlling duration (always less than 1) &dA &dA &d@ The duration advance for a particular node can only be &dA &d@ computed by keeping track of the duration advances for &dA &d@ all active parts from the previous controlling bar line &dA &d@ (bar line with snode = 6913). We must assume that all &dA &d@ active parts will have a node at the beginning of the &dA &d@ measure, even if it is a rest. &dA &dA &d@ 5) the minimum distance is this ratio times the controlling space &dA &dA &d@ Note: syncopated nodes should be reasonably rare in the music &dA &d@ we are currently working with. &dA &dA @r = 0 loop @q = 0 &dA &dA &d@ Find the parts which constitute the next node (less than 6913) in &dA &d@ measure. Set tarr2(.) = 1 for these parts. &dA n = 20000 loop for f12 = 1 to f11 notesize = f(f12,14) tarr2(f12) = 0 if tarr(f12) = 0 /* i.e. if part is active and not at end of measure rec = f(f12,6) CTT: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "Q" stopflag = 1 goto CTT end if line{1} = "J" /* this is what you are looking for (next object) if snode < n n = snode loop for i = 1 to f12 tarr2(i) = 0 repeat end if snode = n tarr2(f12) = 1 end if snode = 6913 ++@q tarr(f12) = 1 /* end of measure for this part tarr2(f12) = 0 end goto CSS end goto CTT else ++@q end CSS: repeat &dA &dA &d@ Check for end of measure; if so, set value for rflag(barcount) = 0 &dA if @q = f11 a1 = 0 goto CCV /* this is the exit for the measure loop end &dA &dA &d@ establish minimum ndincf for active parts coming into this node &dA @b = 20000 @c = 0 loop for f12 = 1 to f11 if tarr(f12) = 0 and ndincf(f12) < @b @b = ndincf(f12) @c = f12 end repeat &dA &dA &d@ Determine values of marr for this node &dA ++marc marr(marc,PRE_DIST) = 0 marr(marc,MNODE_TYPE) = 17 marr(marc,SNODE) = n marr(marc,ACT_FLAG) = 0 marr(marc,M_ADJ) = adj_space marr(marc,MARR_TEMP) = 3 /* New &dA02/09/07&d@ &dE3 = unset&d@ */ loop for k = 1 to 32 tdist(k,1) = 0 repeat k = 0 @d = 0 /* WARNING: very tricky code @e = 0 loop for f12 = 1 to f11 notesize = f(f12,14) rec = f(f12,6) if tarr2(f12) = 1 &dA &d@ update the cumulative distance increment flag for this part &dA &d@ and set marr(marc,TIME_NUM); also check to see accumulation is correct. New &dA05/25/03 cdincf(f12) += ndincf(f12) if @d = 0 @d = cdincf(f12) marr(marc,TIME_NUM) = @d - oldcdincf /* New &dA05/25/03 oldcdincf = @d else if @d <> cdincf(f12) putc Error: Problem in accumulation of durations putc Suspected location: part ~f12 measure ~marc in this system putc or possibly bar ~barnum in the music. putc putc To find error, look at durations in stage2 file for this part putc as well as for the top part (which provides the original count). putc Look also for the possible inconsistant use of non-contolling bar putc lines. putc putc A couple of things to note: (1) The bar nubmer given above is putc only approximate. If there is a pickup at the beginning, for putc example, the bar number could be one number too high. Try putc looking at the previous bar. putc putc (2) In most cases, the duration problem will be an obvious encoding putc error; but there is a subtle case which can escape normal detection. putc This is the case where an irest in a part produces an isolated putc node in a part. Isolated means that there in not another object putc in that part at that location. In this case it is necessary to putc ask the &dEautoset&d@ to allocate space for this irest, even though it putc is not printed. This is done by using the "P C1:p1" print putc suggestion below the offending irest. This problem is also putc discussed at about line 1550 in the s2-spec.b46 ten documentation putc file. QQ1: putc putc Type $$ to see protions of the i-files which might contain the putc problem. putc Type !! to exit program; Simple puts you in examine mode. getc line line = trm(line) if line = "" examine stop end if line = "$$" QQ2: putc Type the number of the part you want to examine. f12 = 0 getc f12 if f12 > 0 and f12 <= f11 rec = f(f12,6) putc Portion of I-file for part ~f12 putc ===================================== loop for i = rec - 10 to rec + 20 tget [Z,i] line putc .w5 ~i ~line repeat putc goto QQ2 else stop end end goto QQ1 end end CT: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if f11 = 1 and jtype = "S" and ntype >= 4 if ntype = 4 marr(marc,MARR_TEMP) = 1 /* multiple rest flag end else if "TCGMSD" con jtype goto CT end end &dA &dA &d@ if part with min ndincf is also current, compute controlling space &dA if f12 = @c @e = dvar1 - olddv1(f12) end * olddv1(f12) = dvar1 i = dvar1 - olddist(f12) &dA &dA &d@ /* Code added &dA02/25/97&d@. I think this is where we must correct for &dA &d@ for extra distance put in by AUTOSET but not used. &dA if snode = 1 and conttie(f12) = 0 trec = rec b = 0 - f(f12,14) /* b - notesize CTa: tget [Z,trec] temp4 .t3 a if "TKkW" con temp4{1} if temp4{1} = "k" and b > a b = a end ++trec goto CTa end b += f(f12,14) /* b is possibly negative i += b /* remove this "dead" space end &dA &dA &d@ End of &dA02/25/97&d@ addition. Let's hope it works! &dA &dA &dA &d@ i could possibly be too small, or negative, if the node is &dA &d@ syncopated. We won't be able to compute this until this &dA &d@ loop is finished &dA if "CKTDBSFIM" con jtype /* only K,B,F and I are left, actually if mpt < 5 ntype = 13 + mpt else ntype = 17 end end if ntype < marr(marc,MNODE_TYPE) if marr(marc,MNODE_TYPE) = 18 putc ntype = ~ntype marr(~marc ,2) = 18 putc Error: Non-controlling bar line error at ~barnum examine stop end marr(marc,MNODE_TYPE) = ntype if f11 = 1 &dA &dA &d@ Code modification &dA02/09/07&d@: 0 will be "sticky" &dA if ntype = 9 and cflag = 1 marr(marc,MARR_TEMP) = 2 else marr(marc,MARR_TEMP) = 0 end &dK &d@ if ntype = 9 and cflag = 1 &dK &d@ marr(marc,MARR_TEMP) = 2 &dK &d@ end &dA end end if i > marr(marc,PRE_DIST) marr(marc,PRE_DIST) = i end ++k tdist(k,1) = f12 tdist(k,2) = dvar1 &dA &dA &d@ If this node is not a non-controlling bar line (ntype = 18), we &dA &d@ must look further in this file for additional proper objects &dA &d@ (notes, figures, rests, cues) on this node. The purpose is to &dA &d@ find the smallest ntype. We must also advance f(f12,6) to the first &dA &d@ record beyond the last object in the node. rec will also point &dA &d@ beyond the last object in the node and at or before the next object &dA &d@ beyond the node &dA f(f12,6) = rec if ntype <> 18 CR2: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line if line{1} <> "J" ++rec goto CR2 end if snode = marr(marc,SNODE) /* New &dA05/25/03&d@ if "CKTDBSFIM" con jtype if mpt < 5 ntype = 13 + mpt else ntype = 17 end end if ntype < marr(marc,MNODE_TYPE) /* New &dA05/25/03&d@ marr(marc,MNODE_TYPE) = ntype /* " " &dA &dA &dA &d@ Code modification &dA02/09/07&d@: Be sure to set (marc,MARR_TEMP) &dA &d@ to 0, if this is a regular node &dA if f11 = 1 if ntype = 9 and cflag = 1 else marr(marc,MARR_TEMP) = 0 end end &dA &dA &d@ End of modification end ++rec f(f12,6) = rec goto CR2 end end goto CS else if line{1} = " " line = trm(line) if line = "" putc A search for Bar line was unsuccessful in part ~f12 . putc Measure number = ~barnum . Try checking durations, especially putc those used in "back" records. putc perform show_Ytable putc putc &dAProgram Halted&d@ putc stop end end end goto CT end &dA &dA &d@ We must also determine the new values for ndincf(.) for notes &dA &d@ in this node (for all active parts, if first pass (@r = 0)). &dA CS: if tarr(f12) = 0 if @r = 1 if tarr2(f12) = 0 goto CS2 end else @r = 1 end CR3: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" ndincf(f12) = dincf else goto CR3 end end CS2: repeat &dA &dA &d@ Code added &dA02/09/07&d@: If marr(marc,MARR_TEMP) is unset, set it to 0 &dA if marr(marc,MARR_TEMP) = 3 marr(marc,MARR_TEMP) = 0 end &dA &dA &d@ Before going on to the next node, we must: &dA &dA &d@ 1) Compute node flag(s) and determine if this node is &dA &d@ syncopated or not. &dA * perform showmarr &dA a = 0x80000000 b = 0 loop for f12 = 1 to f11 if tarr2(f12) = 1 b |= a end a >>= 1 repeat k = 0 if b & nflg1 = 0 k = 1 end nflg1 = b &dA &dA &d@ 2) If syncopated node, compute minimum value for marr(marc,PRE_DIST). &dA &d@ Minimum distance is determined by algorithm described &dA &d@ earlier. Also the type for the previous node needs to be &dA &d@ recomputed, based on the elapsed duration. If this duration &dA &d@ is 576 multiplied or divided by a power of 2, then the &dA &d@ newtype will be the type of the duration + 20. Otherwise &dA &d@ the type will be 40. &dA if k = 1 * dputc Syncopated node in bar ~barnum &dA &dA &d@ @b is controlling duration &dA &d@ @c is part with controlling duration &dA &d@ if @e > 0, @e is controlling space; otherwise, compute it now &dA if @e = 0 rec = f(@c,6) DS: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if "CGMS" con jtype goto DS end @e = dvar1 - olddv1(@c) else goto DS end end &dA &dA &d@ @e is controlling space &dA @e = @e * marr(marc,TIME_NUM) / @b #if REPORT putc T7 minimum syncopated space = ~@e #endif if marr(marc,PRE_DIST) < @e marr(marc,PRE_DIST) = @e end * compute new ntype @c = @b / 9 if rem = 0 loop for @a = 1 to 11 @c >>= 1 repeat while @c > 0 marr(marc-1,MNODE_TYPE) = @a + 20 else marr(marc-1,MNODE_TYPE) = 40 end end &dA &dA &d@ 3) Adjust olddist(.) for parts where f(f12,10) = 0 &dA perform adjolddist &dA &dA &d@ 4) Increment ldist &dA ldist += marr(marc,PRE_DIST) &dA &dA &d@ Proceed to next node &dA repeat &dA &dA &d@ Decrease multiple rest counters; save f(.,10) in case ldist > rmarg &dA CCV: loop for f12 = 1 to f11 tarr3(f12) = f(f12,10) if f(f12,10) > 0 --f(f12,10) end repeat &dA &dA &d@ Now is the time to deal with nodes with snode = 6913. This includes &dA &d@ types G,S,M,C,D,B,K,T (not N,R,Q,F,I). The first proper object-node &dA &d@ will always be a type B (bar line). Types B,K,T will generate proper &dA &d@ object-nodes. Type C will generate a proper node if it follows &dA &d@ the bar line. &dA &dA &d@ Look at bar &dA ++marc marr(marc,PRE_DIST) = 0 marr(marc,MNODE_TYPE) = 18 marr(marc,SNODE) = 6913 marr(marc,ACT_FLAG) = 0xffffffff marr(marc,M_ADJ) = adj_space marr(marc,MARR_TEMP) = 0 &dA &dA &d@ I think this is the point where we need to set a new value for adj_space. &dA &d@ Basically, the normal condition is for adj_space = YES; but if a terminating &dA &d@ barline object in one of the active parts has a print suggestion that &dA &d@ indicates that the next measure must not have its spaces altered in the &dA &d@ line adjustment process, then the adj_space flag must be set to NO. &dA adj_space = YES @d = 0 loop for f12 = 1 to f11 notesize = f(f12,14) if f(f12,10) = 0 if ndincf(f12) > 0 cdincf(f12) += ndincf(f12) if @d = 0 @d = cdincf(f12) marr(marc,TIME_NUM) = @d - oldcdincf else if @d <> cdincf(f12) putc Error: Problem in accumulation at bar line ~barnum examine stop end end end rec = f(f12,6) DT1: perform save3 #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1,3} = "J B" i = dvar1 - olddist(f12) if i > marr(marc,PRE_DIST) marr(marc,PRE_DIST) = i end olddist(f12) = dvar1 f(f12,6) = rec if oby >= 1000000 t1 = oby / 1000000 if t1 = 1 or t1 = 3 adj_space = NO end #if SCROLL_OUT #else if t1 = 10 sys_jflag = barcount + 1 end #endif end else goto DT1 end end repeat &dA &dA &d@ Adjust distances &dA loop for f12 = 1 to f11 if f(f12,10) > 0 olddist(f12) += marr(marc,PRE_DIST) end repeat ldist += marr(marc,PRE_DIST) &dK &d@ perform showmarr &dK &d@ getc &dA &dA &d@ Look for clef, key, time signature in 6913 type node &dA perform setckt &dA &dA &d@ Check length, branch back, or proceed &dA &dK &d@ dputc T02 ldist = ~ldist barcount = ~barcount ++mcnt mspace(mcnt) = ldist &dK &d@ dputc mspace(~mcnt ) = ~mspace(mcnt) if ldist > false_rmarg goto CK end &dA &dA &d@ Transfer marr to larr &dA &dA &dA &dA &d@ New code added &dA10/31/08&d@ to deal with an obscure situation that &dA &d@ arrises from the new feature (for parts) that allows multiple rests &dA &d@ to be broken into smaller units. A multiple rest generates a single &dA &d@ marr(.,.) entry (a bar line with 0 space), which under normal &dA &d@ conditions is transferred to larr(.,.). And normally there would be &dA &d@ real musical notes following this barline. However, when a multiple &dA &d@ rest is broken into smaller units, a second 0 space barline follows &dA &d@ the first. This creates a problem later in the code because this &dA &d@ extra bar is "double counted," i.e., it is counted as part of the &dA &d@ multiple rest (handled one way), and as a measure with musical &dA &d@ notes (handled another way). Put another way, the larr(.,.) array &dA &d@ has too many bar lines in it, so the data in the last measure is &dA &d@ not processed, causing a misalignment of pointers. &dA &dA &d@ The "fix" used here is to skip the tranfer of marr(.,.) to larr(.,.) &dA &d@ when marc = 1, and the space parameter of the previous larr(.,.) &dA &d@ entry is 0 (as it is for the last bar of a multiple rest). I &dA &d@ have not checked to see if there are other situations which &dA &d@ produce this condition -- a possible new problem. &dA if marc = 1 and larc > 0 and larr(larc,1) = 0 and larr(larc,2) = 18 goto NO_TRANS end &dA &dA loop for i = 1 to marc ++larc #if REPORT2 putc M~marr(i,1) ... #endif loop for j = 1 to MARR_PARS larr(larc,j) = marr(i,j) repeat repeat #if REPORT2 putc #endif &dA &dA &d@ Adjust delta and counters &dA NO_TRANS: /* New label &dA10/13/08&d@ delta = rmarg - ldist ++barcount ++barnum #if REPORT putc T20 barnum = ~barnum #endif * a1 is set earlier; normal case, a1 = 0, for end of G.P. a1 = hxpar(6) rflag(barcount) = a1 loop for f12 = 1 to f11 if delta = 0 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) end if stopflag = 1 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) end repeat if delta = 0 if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 sysbarpar(syscnt,5) = sys_jflag end goto CG end if sysbarpar(syscnt+1,3) = barcount and barcount > 0 loop for f12 = 1 to f11 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) repeat goto CE end if stopflag = 1 goto CCE end marc = 0 goto CF &dA &dA &d@ This is where the program jumps back to get another measure &dA &dA &dA &dA &dA &d@ At this point, we have added too much music to a line (ldist > false_rmarg) &dA &dA &d@ Provisional transfer of marr to larr (to text "squeezing") &dA CK: larc2 = larc loop for i = 1 to marc ++larc2 loop for j = 1 to MARR_PARS larr(larc2,j) = marr(i,j) repeat repeat &dA &dA &d@ III. Compute new distances &dA &dA &d@ Compute new distances for object nodes on a line. This &dA &d@ is where we determine how to right justify the line. It &dA &d@ is also where we decide whether or not to "squeeze" &dA &d@ an extra measure onto the line or not. &dA &dA &d@ larc = number of object-nodes on the line &dA &d@ larc2 = number of object-nodes on extended line &dA &dA &dA &d@ &dIA. General calculations: Identify shortest duration in &dA &d@ &dI extended line and determine quantity and location &dA &d@ &dI of smallest distances &dA &dA &dA &d@ First, we need to know how many barlines are in this line &dA &d@ of music. Specifically, if there is only one, then we &dA &d@ must allow space modifications irrespective of whether &dA &d@ a print suggestion asked that there be none. &dA c2 = 0 single_meas = NO loop for c1 = 1 to larc2 if larr(c1,MNODE_TYPE) = 18 ++c2 end repeat if c2 = 1 single_meas = YES end a1 = larc2 a9 = 0 perform getsmall #if MEAS_SUGG if single_meas = NO loop for c1 = 1 to scnt2 small(c1) = small2(c1) repeat scnt = scnt2 end #endif &dA &dA &d@ &dIB. If there is no text, determine shortest adjustable distance &dA &d@ &dI between notes and the number of notes that have this distance. &dA &d@ &dI If an additional measure can be accommodated by decreasing &dA &d@ &dI this distance by x%, then this should be done. &dA if textflag = 0 * scnt = number of notes with smallest distance b = e * scnt / 15 /* allows for about 6.6% compression c = ldist - rmarg #if REPORT2 putc size = ~e # of nodes = ~scnt ldist = ~ldist putc overdistance = ~c maxcompression = ~b getc #endif if c <= b and c > 0 savec = c &dA &dA &d@ &dETry&d@ to accommodate additional measure by compressing shortest notes &dA #if REPORT2 putc Compressing shortest notes; e = ~e #endif ++barcount rflag(barcount) = 0 larc = larc2 loop for f12 = 1 to f11 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) repeat &dA &dA &d@ small(.) contains the node numbers where the distance may be decreased &dA &d@ scnt = number of candidate nodes &dA &d@ e = shortest distance &dA &d@ a = alternation flag for deleting space in type-40 syncopated pairs &dA &d@ b = distance subtraction flag &dA &d@ c = distance to subtract &dA a = 0 b = 0 loop j = 1 loop for i = 2 to larc if i = small(j) if j < scnt ++j end if larr(i-1,MNODE_TYPE) < 40 if larr(i,PRE_DIST) > e b = 1 else goto CPB end --larr(i,PRE_DIST) else if b = 0 goto CPB end if a = 0 --larr(i,PRE_DIST) else --larr(i-1,PRE_DIST) end end --c if c = 0 /* Success! Go lay out music at CG if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 - savec sysbarpar(syscnt,5) = sys_jflag end goto CG end end CPB: repeat if a = 0 a = 1 else a = 0 end if b = 0 --e #if REPORT2 putc new e = ~e #endif b = 1 else b = 0 end repeat end end &dA &dA &d@ Since the effort to squeeze an extra measure onto a line has &dA &d@ failed at this point, we must restore the earlier values of &dA &d@ f(.,10), which were advanced when we added the bar line to &dA &d@ the last (prospective) measure. &dA CCE: loop for f12 = 1 to f11 f(f12,10) = tarr3(f12) repeat --mcnt /* delete length from list &dA &dA &d@ If f2 = 1, then we tried unsuccessfully to add an extra measure &dA &d@ of general rest. We must now add a larr entry for the &dA &d@ terminating bar line &dA if f2 = 1 ++larc larr(larc,MNODE_TYPE) = 18 /* New &dA05/25/03&d@ larr(larc,ACT_FLAG) = 0xffffffff /* " " larr(larc,M_ADJ) = adj_space /* " " end &dA &d@ &dA &d@ &dIC. Assign delta (extra space) to various nodes within line. &dA &d@ &dI &dA &d@ &dI a. Try to assign delta to multiple measure rests or whole &dA &d@ &dI measure rests &dA &d@ CE: #if REPORT2 putc T1 delta = ~delta #endif if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = delta sysbarpar(syscnt,5) = sys_jflag end &dA &dA &d@ Look for multiple measure rests &dA if f11 = 1 n = 0 loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 1 ++n end repeat if n > 0 a = delta / n + 1 if a <= MAGIC1 loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 1 if a > delta a = delta end larr(c1,PRE_DIST) += a delta -= a &dK &d@ if delta = 0 /* Not necessary &dK &d@ goto CG &dK &d@ end end repeat goto CG else a = MAGIC1 if a > delta /* should never happen, but just to be safe a = delta end loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 1 larr(c1,PRE_DIST) += a delta -= a end repeat end end end &dA &dA &d@ Look for single measure rests &dA if f11 = 1 n = 0 loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 2 ++n end repeat if n > 0 a = delta / n + 1 b = hxpar(6) * 4 / barcount if a > b a = b end loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 2 if a > delta a = delta end larr(c1,PRE_DIST) += a delta -= a if delta = 0 goto CG end end repeat end end n = 0 loop for j = 1 to barcount if rflag(j) > 0 ++n end repeat if n > 0 a = delta / n + 1 b = hxpar(6) * 2 / barcount if a > b a = b end loop for j = 1 to barcount if rflag(j) > 0 if a > delta a = delta end rflag(j) += a delta -= a if delta = 0 goto CG end end repeat end &dA &dA &d@ &dI &dA &d@ &dI b. Try to assign delta to notes larger than smallest &dA &d@ &dI &dA &d@ &dA &dA &d@ 1. construct adjarr, compute maximum possible adjustment &dA &dA &dA &d@ We need to know how many barlines are in this line of music. &dA &d@ Specifically, if there is only one, then we must allow space &dA &d@ modifications irrespective of whether a print suggestion asked &dA &d@ that there be none. &dA c2 = 0 single_meas = NO loop for c1 = 1 to larc if larr(c1,MNODE_TYPE) = 18 ++c2 end repeat if c2 = 1 single_meas = YES end a1 = larc a9 = 1 perform getsmall #if MEAS_SUGG if single_meas = NO loop for c1 = 1 to scnt2 small(c1) = small2(c1) repeat scnt = scnt2 end #endif #if REPORT2 putc T2 delta = ~delta putc T3 smallest note on line = ~k smallest internote d = ~e #endif &dA &dA &d@ k = ntype for shortest node on line &dA &d@ e = smallest standard internode distance &dA &dA &dA &d@ Smallest standard internode distance is sometimes not relevent, especially &dA &d@ in the case where there is text underlay. Let us also look at the median &dA &d@ of the distances for the shortest node on the line &dA j = 0 loop for i = 1 to larc - 1 if larr(i,MNODE_TYPE) = k ++j adjarr(j,1) = larr(i+1,PRE_DIST) end repeat a1 = j loop for i = 1 to a1 - 1 loop for j = i + 1 to a1 if adjarr(i,1) < adjarr(j,1) c = adjarr(i,1) adjarr(i,1) = adjarr(j,1) adjarr(j,1) = c end repeat repeat a1 = a1 + 1 >> 1 h = adjarr(a1,1) if h > (e * 5 / 4) e = h end adjarc = 0 if k > 6 a = k + 1 else a = k end loop for i = 2 to larc if larr(i,MNODE_TYPE) = 18 and larr(i-1,MNODE_TYPE) < a goto CD end if larr(i,TIME_NUM) > 0 dv3 = larr(i,TIME_NUM) * 10 / df if dv3 > 10 &dA &dA &d@ Code modification &dA12/11/03&d@ &dA &dA &d@ Note &dA04/12/10&d@ The code below is ridiculous and absurd and is &dA &d@ being replaced by some "magic" numbers that do the same thing. &dA &dK &d@ rx = flt(dv3) &dK &d@ rx = rx / 10.0 &dK &d@ ry = lnx(rx) / lnx(2.0) &dK &d@ rz = pow(1.5,ry) &dK &d@ rz *= 10.0 &dK &d@ dv3 = fix(rz) if dv3 < 80 c18 = dv3 - 10 + 1 c19 = ors("AABBCCDDEEFFFGGHHHIIJJJKKKLLLMMMNNNOOOPPPPQQQRRRRSSSTTTTUUUUVVVVWWWWXX"{c18}) - 55 else if dv3 < 515 c18 = dv3 - 75 / 10 + 1 c19 = ors("!$&(*,.024679;<>@ACDFGIJKMNPQRSUVWYZ[\]_`abc"{c18}) else c19 = dv3 - 515 / 10 + 100 end end dv3 = c19 &dA c = dv3 * e / 10 /* maximum final distance &dA &dA &d@ Case: node is preceded by adjustable distance (larr(i,TIME_NUM) > 0); &dA &d@ duration preceding node (larr(i,TIME_NUM)) is greater than min. dur. &dA &d@ c = amount by which duration may be increased &dA if c > 0 #if MEAS_SUGG if larr(i,M_ADJ) = YES ++adjarc adjarr(adjarc,1) = i adjarr(adjarc,2) = c adjarr(adjarc,3) = 0 end #else ++adjarc adjarr(adjarc,1) = i adjarr(adjarc,2) = c adjarr(adjarc,3) = 0 #endif end end end CD: repeat &dA &dA &d@ 2. compute adjarr(.,3) = current largest distance for nodes similar to this one. &dA &dA &dA &d@ First, determine maximum PRE_DIST for each TIME_NUM &dA d = 0 loop for i = 1 to adjarc a = adjarr(i,1) b = larr(a,PRE_DIST) c = larr(a,TIME_NUM) j = 0 if d > 0 loop for j = 1 to d if tarr5(j,1) = c if tarr5(j,2) < b tarr5(j,2) = b end j = 1000 end repeat end if j < 1000 ++d tarr5(d,1) = c tarr5(d,2) = b end repeat &dA &dA &d@ Second, sort by increasing TIME_NUM, smallest first &dA loop for i = 1 to d - 1 loop for j = i + 1 to d if tarr5(i,1) > tarr5(j,1) c = tarr5(i,1) tarr5(i,1) = tarr5(j,1) tarr5(j,1) = c c = tarr5(i,2) tarr5(i,2) = tarr5(j,2) tarr5(j,2) = c end repeat repeat &dA &dA &d@ Third, make sure that increasing TIME_NUM has increasing distance &dA loop for i = 1 to d - 1 a = tarr5(i,2) * 5 / 4 if tarr5(i+1,2) < a tarr5(i+1,2) = a end repeat &dA &dA &d@ Fourth, assign the various maximums to their respective adjarr(.,3) &dA loop for i = 1 to adjarc a = adjarr(i,1) b = larr(a,TIME_NUM) &dA &dA &d@ &dA07/14/04&d@ The code below appears to contain a minor bug. It appears to be &dA &d@ possible for tarr5(.,2) = 0, in which case, adjarr(.,3) should also &dA &d@ be zero. I think the purpose of the test condition below the loop &dA &d@ is to flag the case where &dEno match&d@ was found in the loop, in which &dA &d@ case adjarr(.,3) would also be zero. We need to have another way &dA &d@ to flag this condition. &dA &dK &d@ loop for j = 1 to d &dK &d@ if tarr5(j,1) = b &dK &d@ adjarr(i,3) = tarr5(j,2) &dK &d@ end &dK &d@ repeat &dK &d@ if adjarr(i,3) = 0 &dK &d@ putc Program Error &dK &d@ stop &dK &d@ end n = 0 /* new test flag loop for j = 1 to d if tarr5(j,1) = b adjarr(i,3) = tarr5(j,2) n = 1 end repeat if n = 0 putc No match found in tarr5(.,1) element set and larr array. putc Program Error stop end &dA &d@ End of &dA07/14/04&d@ code change repeat &dA &dA &dA &d@ &dA11/06/08&d@ There is a corner case I don't understand yet. It can result &dA &d@ in delta being 0 at this point, which leads to code failure. &dA &d@ To avoid this, I include the following code. The problem &dA &d@ of the corner case still exists, however. &dA if delta = 0 goto CG end &dA &dA n = 0 loop for i = 1 to adjarc a = adjarr(i,1) /* larr index for i-th adjarr element n += (adjarr(i,3) - larr(a,PRE_DIST)) repeat &dA &d@ &dA &d@ 3. determine adjarr(.,4) = distances to add to bring all nodes &dA &d@ up to the "largest in class" &dA if n < delta n = delta end h = delta loop for i = 1 to adjarc a = adjarr(i,1) /* larr index for i-th adjarr element dvar1 = (adjarr(i,3) - larr(a,PRE_DIST)) * h / n adjarr(i,4) = dvar1 delta -= dvar1 repeat loop for i = 1 to adjarc if delta = 0 i = adjarc else ++adjarr(i,4) --delta end repeat &dA &d@ &dA &d@ 4. if delta is still > 0, try increasing adjarr(.,4) up to allowed maximum &dA if delta > 0 n = 0 loop for i = 1 to adjarc a = adjarr(i,1) /* larr index for i-th adjarr element b = (adjarr(i,2) - larr(a,PRE_DIST) - adjarr(i,4)) if b > 0 n += b end repeat if n < delta n = delta end h = delta loop for i = 1 to adjarc a = adjarr(i,1) /* larr index for i-th adjarr element b = (adjarr(i,2) - larr(a,PRE_DIST) - adjarr(i,4)) if b > 0 dvar1 = b * h / n adjarr(i,4) += dvar1 delta -= dvar1 end repeat loop for i = 1 to adjarc if delta = 0 i = adjarc else ++adjarr(i,4) --delta end repeat end &dA #if REPORT2 putc adjarr array loop for i = 1 to adjarc putc .w8 ~adjarr(i,1) ~adjarr(i,2) ~adjarr(i,3) ~adjarr(i,4) repeat #endif &dA &dA &d@ 5. add distance &dA loop for i = 1 to adjarc h = adjarr(i,1) larr(h,PRE_DIST) += adjarr(i,4) /* New &dA12/11/03&d@ #if REPORT2 putc T6 distance ~adjarr(i,4) added to node ~h #endif repeat #if REPORT2 putc T8 delta now is ~delta #endif if delta = 0 goto CG end &dA &dA &d@ &dI &dA &d@ &dI c. Assign distance to smallest notes &dA &d@ &dI &dA &d@ &dA &d@ small(.) = node numbers where distance can be added &dA &d@ scnt = number of such nodes &dA &d@ a = alternation flag for incerting space in type 40 syncopated nodes &dA &d@ b = addition flag &dA &d@ e = smallest internote distance &dA &d@ delta_e = difference between smallest distance and next smallest distance &dA &d@ delta = distance to subtract &dA a = 0 b = 0 #if REPORT2 putc Assigning ~delta to smallest notes; e = ~e #endif n = delta_e + 1 / 2 /* New &dA10/14/07&d@ if n < 3 n = 3 end if scnt > 0 loop for h = 1 to n /* Limit to loop is new &dA10/14/07&d@ j = 1 loop for i = 2 to larc if i = small(j) if j < scnt ++j end if larr(i-1,MNODE_TYPE) < 40 /* New &dA05/25/03&d@ if larr(i,PRE_DIST) > e /* " " goto CPE else b = 1 end ++larr(i,PRE_DIST) /* New &dA05/25/03&d@ else if b = 0 goto CPE end if a = 0 ++larr(i,PRE_DIST) /* New &dA05/25/03&d@ else ++larr(i-1,PRE_DIST) /* New &dA05/25/03&d@ end end --delta if delta = 0 goto CG end end CPE: repeat if a = 0 a = 1 else a = 0 end if b = 0 b = 1 ++e #if REPORT2 putc new e = ~e #endif else b = 0 end repeat end &dA &dA &d@ &dI &dA &d@ &dI d. Assign remaining distance wherever you can &dA &d@ &dI &dA loop loop for i = 2 to larc if larr(i,TIME_NUM) > 0 /* New &dA05/25/03&d@ ++larr(i,PRE_DIST) /* " " --delta if delta = 0 goto CG end end repeat repeat &dA &dA &d@ &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dA &d@ &dE³ ³&d@ &dA &d@ &dE³ Distances are computed. Now it is time to read the ³&d@ &dA &d@ &dE³ file the second time and typeset the music ³&d@ &dA &d@ &dE³ ³&d@ &dA &d@ &dE³ PRINT OUT THE MUSIC ³&d@ &dA &d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ Compute offsets for bar lines and values of larc for bar lines &dA &dA &d@ barcount = number of bars in a line &dA &d@ barpar(.,1) = horizontal length of measure &dA &d@ barpar(.,2) = value of larc2 for bar-node at end of measure &dA &d@ barpar(.,3) = bar type (ntype) at end of measure &dA CG: &dA &d@ &dA12/17/03&d@ &dA &dA &d@ At this point, the larr(larc,.) array is fixed and ready for &dA &d@ use. If XVERSION, and if this is the final pass (justflag < 2), &dA &d@ and if formatflag = 1, and if the format file contains larr data &dA &d@ (forp < forpz), then now is the time to compare the larr data &dA &d@ with the larr(larc,.) array just generated. If there is a &dA &d@ perfect match up of the MNODE_TYPE elements, then the stored &dA &d@ PRE_DIST elements can replace the computed ones. &dA &d@ &dA &dA &dA &d@ New &dA11/02/07&d@. We need to correct a "corner" case here. When the last item &dA &d@ object in a line is a key change or a time change, the program places this &dA &d@ beyond the end of the line. I'm not sure why this happens, and it would be &dA &d@ complicated to try to fix. But there is an easy solution here. Simply &dA &d@ figure out the space needed, and subtract it from the various larr nodes. &dA &d@ While we are at it, the distance between the last bar line and the time &dA &d@ change is sometimes excessive. So let's set this to the standard distance &dA &d@ as well. Keep an eye on this change, however; there may be exceptions to &dA &d@ this fix. &dA j = 0 loop for i = 1 to larc &dK &d@ putc .w6 ~i ~larr(i,MNODE_TYPE) ~larr(i,PRE_DIST) j += larr(i,PRE_DIST) repeat if chr(larr(larc,MNODE_TYPE)) in [14..16] i = rmarg - false_rmarg if larr(larc,MNODE_TYPE) = 15 i -= (hxpar(5) / 2) end if larr(larc,MNODE_TYPE) = 16 i -= (hxpar(13) / 2) end &dK &d@ putc Space needed here is ~i Total is ~j if larr(larc,PRE_DIST) > hxpar(7) and larr(larc-1,MNODE_TYPE) = 18 g = larr(larc,PRE_DIST) - hxpar(7) &dK &d@ putc First remove extra space after bar line g = ~g if g > i g = i end larr(larc,PRE_DIST) -= g i -= g end g = i c = 7 loop loop for h = 2 to larc k = larr(h,PRE_DIST) * i * 10 / j if k < 10 and k > c k = 10 end k /= 10 if rem > 5 ++k end larr(h,PRE_DIST) -= k &dK &d@ putc subtracting ~k from node ~h = ~larr(h,PRE_DIST) g -= k if g <= 0 &dK &d@ putc Done goto END_CORRECT end repeat --c repeat END_CORRECT: &dK &d@ getc end #if XVERSION if justflag < 2 if formatflag = 1 /* there is a format file if forp < forpz /* and it contains larr data tget [F,forp+1] bigline a = int(bigline{4..}) if a <> psysnum + 1 putc The FORMAT file contains a format error. putc System number = ~(psysnum + 1) putc putc &dAProgram Halted&d@ putc stop end sub = 7 loop for i = 1 to 200 a = int(bigline{sub..}) b = int(bigline{sub..}) if b = 0 plarc = i - 1 i = 200 else plarr(i,PRE_DIST) = a plarr(i,MNODE_TYPE) = b end repeat edflag &= 0x01 /* turn off selective edit for this line if plarc <> larc edflag |= 0x02 /* turn on selective edit for this line else loop for i = 1 to larc if larr(i,MNODE_TYPE) <> plarr(i,MNODE_TYPE) edflag |= 0x02 /* turn on selective edit for this line end repeat if bit(1,edflag) = 0 /* if selective edit for this line is off loop for i = 1 to larc larr(i,PRE_DIST) = plarr(i,PRE_DIST) /* replacing distances repeat end end end end end #endif &dA &dA &d@ &dA12/17/03&d@ &dA &dA &d@ At this point, the cumulative larr array can be initialized. &dA &d@ if endflag = 1 and justflag <> 1 c4 = ldist - sp - pdist else c4 = syslen - pdist end #if SCROLL_OUT loop for i = 1 to 30000 cum_larr(i,1) = 0 cum_larr(i,2) = 0 repeat #else loop for i = 1 to 300 cum_larr(i,1) = 0 cum_larr(i,2) = 0 repeat #endif &dA mspace(mcnt) += deadspace * 100000 #if REPORT2 if justflag > 1 putc sysbarpar(~syscnt ,1) = ~sysbarpar(syscnt,1) putc sysbarpar(~syscnt ,2) = ~sysbarpar(syscnt,2) end #endif if endflag = 1 and justflag <> 1 i = ldist - sp else i = syslen end if justflag < 2 sv_mainyp = mainyp ++mainyp y1p = mainyp tput [Y,mainyp] S 0 ~sp ~sysy ~i ~sysh ~f11 "~syscode " end * loop for i = 1 to barcount barpar(i,3) = 0 repeat * putc T9 delta = ~delta * #if SHOWLARR loop for a1 = 1 to larc perform showlarr repeat putc #endif &dA &dA &d@ First handle special case of entire system of rests &dA if larc = 0 cum_x = 0 /* &dA12/17/03&d@ cum_larrz = 0 /* " loop for i = 1 to barcount cum_x += rflag(i) /* &dA12/17/03&d@ ++cum_larrz /* " cum_larr(cum_larrz,1) = cum_x /* " cum_larr(cum_larrz,2) = 1 /* " barpar(i,1) = rflag(i) barpar(i,2) = 1 repeat goto CG2 end &dA &dA &d@ Normal case: notes in at least one part in system &dA larc2 = 1 d = 0 cum_x = 0 /* &dA12/17/03&d@ barcum_x = 0 /* &dA12/17/03&d@ &dA &dA &d@ Handle special case of beginning of piece &dA if f(1,4) = 2 loop for j = larc2 to larc if larr(j,SNODE) = 6913 and larr(j,MNODE_TYPE) <> 18 cum_x += larr(j,PRE_DIST) /* &dA12/17/03&d@ cum_larr(j,1) = cum_x /* " cum_larr(j,2) = 0 /* " d += larr(j,PRE_DIST) else larc2 = j goto CG4 end repeat end CG4: loop for i = 1 to barcount &dK &d@ dputc i = ~i rflag = ~rflag(i) barcount = ~barcount if rflag(i) > 0 barpar(i,1) = rflag(i) + d barcum_x += barpar(i,1) /* &dA12/17/03&d@ cum_x = barcum_x /* " barpar(i,2) = larc2 *DB putc T17 (~i :~barpar(i,1) ,~barpar(i,2) ) ... d = 0 else if i > 1 and rflag(i-1) > 0 cum_larr(larc2,1) = cum_x /* &dA12/17/03&d@ if larr(larc2,PRE_DIST) = 0 /* " cum_larr(larc2,2) = 1 /* " else /* " cum_larr(larc2,2) = 0 /* " end /* " ++larc2 end c = 0 loop for j = larc2 to larc &dA &dA &d@ Exit sequence: either you run out of 6913 nodes, or you hit another &dA &d@ bar line (i.e. with a multiple rest in between). &dA if c = 1 if larr(j,SNODE) <> 6913 larc2 = j goto CG3 else if larr(j,MNODE_TYPE) = 18 larc2 = j goto CG3 end end end * cum_x += larr(j,PRE_DIST) cum_larr(j,1) = cum_x cum_larr(j,2) = 0 d += larr(j,PRE_DIST) if larr(j,MNODE_TYPE) = 18 and larr(j,SNODE) = 6913 c = 1 barpar(i,2) = j barpar(i,1) = d barcum_x += barpar(i,1) cum_x = barcum_x *DB putc T17 (~i :~d ,~j ) ... d = 0 end repeat end CG3: if i = barcount if rflag(i) > 0 cum_larrz = larc + 1 cum_larr(cum_larrz,1) = cum_x else cum_larrz = larc end end repeat &dK &d@ if cum_larr(cum_larrz,1) > c4 &dK &d@ dputc Program error, or something else wrong. &dK &d@ end &dK &dK &d@ c5 = cum_larrz &dK &d@ dputc cum_larr(~c5 ,1) = ~cum_larr(c5,1) and c4 = ~c4 *DB putc T17 &dA &dA &d@ Reset record pointers, set up second whole measure rest array &dA &d@ CG2: loop for f12 = 1 to f11 f(f12,6) = f(f12,4) f(f12,11) = f(f12,7) repeat if justflag > 0 sysbarpar(syscnt,4) = sysbarpar(syscnt,2) + barpar(barcount,1) end &dK &d@ putc real space = ~sysbarpar(syscnt,2) &dK &d@ putc hypothetical space = ~sysbarpar(syscnt,4) &dA &dA &d@ If f13 = 0 (and justflag < 2), check to see if part names &dA &d@ need to be backed up. Compute pn_left &dA if f13 = 0 and justflag < 2 and f11 > 1 c1 = 0 loop for f12 = 1 to f11 notesize = f(f12,14) rec = f(f12,1) tget [Z,rec] line if line <> "" if line{1} = "!" temp = line{2,2} line = line // pad(4) line = line{4..} else temp = chs(mtfont) end c5 = int(temp) perform spacepar (c5) if len(line) <= NAMELEN line = trm(line) c2 = 0 loop for c3 = 1 to len(line) c2 += spc(ors(line{c3})) repeat if c1 < c2 c1 = c2 end else line = line // " " j = 0 FLL: h = 0 loop for k = 1 to len(line) if line{k} = " " if k > NAMELEN if h > 0 k = h end ++j linepiece(j) = trm(line{1,k}) line = mrt(line{k..}) goto FLL else h = k end end repeat line = trm(line) if len(line) > 0 and j < 5 ++j linepiece(j) = line end loop for k = 1 to j c2 = 0 loop for c3 = 1 to len(linepiece(k)) c2 += spc(ors(linepiece(k){c3})) repeat if c1 < c2 c1 = c2 end repeat end end repeat c2 = maxnotesize << 1 if c1 > hxpar(9) - c2 pn_left = c1 - hxpar(9) + c2 else pn_left = 0 end end &dA &dA &d@ Loop through parts one at a time and print out. Set delta &dA &d@ to total number of bars for this line. We will use barcount &dA &d@ as the exit indicator for each part. &dA &dA &d@ There are certain variables which are used only to print parts. &dA &d@ The variables and their storage locations are listed below. &dA &dA &d@ Variable &dA &d@ ÄÄÄÄÄÄÄÄÄÄ &dA &d@ superpnt(32,N_SUPER) &dA &d@ supermap(32,N_SUPER) &dA &d@ superdata(32,N_SUPER,SUPERSIZE) &dA &d@ drec(32) &dA &d@ savenoby(32) &dA &d@ uxstop(32) &dA &d@ nuxstop(32) &dA &d@ dxoff(32) &dA &d@ dyoff(32) &dA &d@ uxstart(32) &dA &d@ backloc(32) &dA &d@ xbyte(32) &dA delta = barcount loop for f12 = 1 to f11 &dA &dA &d@ Fixing a bug in the TAKEOUT system &dA12/22/05&d@ &dA if justflag < 2 type1_dflag(f12) = save_type1_dflag(f12) type2_dflag(f12) = save_type2_dflag(f12) end &dA i = f(f12,15) lbyte = "Ll"{i} notesize = f(f12,14) firstbarflag = 0 dxoff(f12) = 10000 &dA &dA &d@ &dIa. Set up Line record. If f13 = 0, put objects for instrument &dA &d@ &dI names; else, print clef, key, time-sig and other information. &dA i = sq(f12) - sysy if f13 = 0 xbyte(f12) = "**********"{1,f(f12,13)} if justflag < 2 &dA &dA &d@ &dA03/25/06&d@ put in @ LINE record for this line &dA if andata_flag > 0 ++mainyp tput [Y,mainyp] ~@line(f12) end ++mainyp &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS x = f(f12,16) y = f(f12,17) tput [Y,mainyp] ~lbyte ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 | TRANS=~x INSTN=~y &dL &dL &d@ xmskpage code &dL &dL #else &dA #if CONTINUO tput [Y,mainyp] ~lbyte ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) -200 #else tput [Y,mainyp] ~lbyte ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 #endif &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif end * print instrument name if f11 > 1 rec = f(f12,1) tget [Z,rec] line if line <> "" if line{1} = "!" temp = line{2,2} line = line // pad(4) line = line{4..} else temp = chs(mtfont) end x = 0 - hxpar(9) - pn_left if len(line) <= NAMELEN y = vpar(f12,6) if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y 1 6913 0 0 end line = trm(line) if justflag < 2 ++mainyp tput [Y,mainyp] W 0 0 ~temp ~line end else y = vpar(f12,9) line = line // " " j = 0 FIXLINE: h = 0 loop for k = 1 to len(line) if line{k} = " " if k > NAMELEN if h > 0 k = h end ++j y -= vpar(f12,3) linepiece(j) = trm(line{1,k}) line = mrt(line{k..}) goto FIXLINE else h = k end end repeat line = trm(line) if len(line) > 0 and j < 5 ++j y -= vpar(f12,3) linepiece(j) = line end &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS &dA &dA &d@ The nature of score convertion dictates that each line of &dA &d@ the instrument designation must have its own object record &dA if justflag < 2 loop for k = 1 to j ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~j 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~temp ~linepiece(k) y += vpar(f12,6) repeat end &dL &dL &d@ xmskpage code &dL &dL #else if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~j 6913 0 0 end y = 0 loop for k = 1 to j if justflag < 2 ++mainyp tput [Y,mainyp] W 0 ~y ~temp ~linepiece(k) end y += vpar(f12,6) repeat &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif end end end else if justflag < 2 &dA &dA &d@ &dA03/25/06&d@ put in @ LINE record for this line &dA if andata_flag > 0 ++mainyp tput [Y,mainyp] ~@line(f12) end &dA ++mainyp xx(1) = f(f12,9) xx(2) = dyoff(f12) xx(3) = uxstart(f12) xx(4) = backloc(f12) xx(5) = vst(f12) xx(6) = f(f12,14) &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS xx(7) = f(f12,16) xx(8) = f(f12,17) tput [Y,mainyp] ~lbyte ~i ~xx(1) ~xx(2) ~xx(3) ~xx(4) ~xbyte(f12) ~xx(5) ~xx(6) | TRANS=~xx(7) INSTN=~xx(8) &dL &dL &d@ xmskpage code &dL &dL #else #if CONTINUO tput [Y,mainyp] ~lbyte ~i ~xx(1) ~xx(2) ~xx(3) ~xx(4) ~xbyte(f12) ~xx(5) ~xx(6) -200 #else tput [Y,mainyp] ~lbyte ~i ~xx(1) ~xx(2) ~xx(3) ~xx(4) ~xbyte(f12) ~xx(5) ~xx(6) 0 #endif &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif &dA &dA &d@ This code added &dA01/06/04&d@ to implement abbreviated part names &dA c4 = f(f12,6) c2 = recflag(c4) & 0xff if c2 > 0 temp = abbr(c2) c5 = int(temp) temp = temp{sub..} temp = mrt(temp) &dA &dA &d@ New &dA01/29/09&d@: Adding code to deal with grand staff &dA c7 = 0 temp = temp // pad(4) if temp{1,3} = "(g)" /* special case of grand staff c7 = vst(f12) >> 1 temp = temp{4..} end temp = trm(temp) perform spacepar (c5) if temp con "/" temp2 = temp{mpt+1..} temp = temp{1,mpt-1} else temp2 = "" end c2 = 0 loop for c3 = 1 to len(temp) if temp{c3} = "_" temp{c3} = " " end &dK &d@ c2 += spc(ors(temp{c3})) /* &dA06/04/08&d@ More precise calculation of length if temp{c3,2} = "\0" ++c3 else c2 += spc(ors(temp{c3})) end repeat c4 = 0 if temp2 <> "" loop for c3 = 1 to len(temp2) if temp2{c3} = "_" temp2{c3} = " " end &dK &d@ c4 += spc(ors(temp2{c3})) /* &dA06/04/08&d@ More precise calculation of length if temp2{c3,2} = "\0" ++c3 else c4 += spc(ors(temp2{c3})) end repeat end if c4 > c2 c2 = c4 end c4 = notesize * 3 + c7 /* c7 is New &dA01/29/09&d@ c3 = maxnotesize << 1 c2 += c3 ++mainyp if temp2 = "" tput [Y,mainyp] J D 0 -~c2 ~c4 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~c5 ~temp else c7 = 0 loop while temp2{1} = " " c7 += spc(32) temp2 = temp2{2..} repeat c6 = c4 >> 1 tput [Y,mainyp] J D 0 -~c2 ~c4 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 -~c6 ~c5 ~temp ++mainyp tput [Y,mainyp] J D 0 -~c2 ~c4 1 6913 0 0 ++mainyp tput [Y,mainyp] W ~c7 ~c6 ~c5 ~temp2 end end &dA end &dA &dA &dA &d@ New &dA05/06/08&d@. If the beginning of an ending superobject has been thrown over &dA &d@ to a new page, then a mark for this superobject must be placed &dA &d@ at the beginning of the line. &dEclefkey&d@ is the best place to do &dA &d@ this. The flags will be superdata(.,.,5) and superdata(.,.,7). &dA &d@ The magic number 123456 is used to signal an ending superobject, &dA &d@ and 2 is the value of superdata(.,.,5) which signals that the &dA &d@ ending was thrown over from the previous measure. supernum is &dA &d@ used as the flag for clefkey to typeset a mark. &dA supernum = 0 loop for j = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ if superdata(f12,j,5) = 2 and superdata(f12,j,7) = 123456 supernum = supermap(f12,j) end if superdata(f12,j,6) = 234567 /* New &dA06/09/08&d@ magic number for dashes superdata(f12,j,7) = 1 /* New &dA06/09/08&d@ end /* New &dA06/09/08&d@ repeat &dA &dA &d@ End of &dA05/06/08&d@ addition perform clefkey &dA &dA &dA &d@ New code &dA11/21/07&d@; Typeset directives thrown from previous systme &dA if save_dircnt > 0 and justflag < 2 loop for c12 = 1 to save_dircnt if save_direct(c12,1) = f12 c13 = save_direct(c12,2) tget [Z,c13] line2 .t5 c14 c15 c16 c17 if bit(1,c14) = 1 goto LKJ01 end if bit(2,c14) = 1 goto LKJ01 end if bit(3,c14) = 1 and f12 = f11 goto LKJ01 end goto LKJ02 LKJ01: c11 = c13 - 1 LKJ03: tget [Z,c11] line3 .t5 c18 c19 if line3{1,3} <> "J B" and c11 > 1 --c11 goto LKJ03 end c20 = c15 - c19 /* This is the horizontal offset (I think) line2 = line2{1,4} // chs(c14) // " " // chs(c20) // " " // chs(c16) // " " // chs(c17) // " 6913 0 0" ++c13 tget [Z,c13] line3 &dK &d@ dputc ~line2 &dK &d@ dputc ~line3 &dK &d@ putc ++mainyp tput [Y,mainyp] ~line2 ++mainyp tput [Y,mainyp] ~line3 end LKJ02: repeat end &dA &dA &d@ End of &dA11/21/07&d@ addition end * &dA &dA &d@ &dIb. Check for multiple rests running over from previous line. &dA &d@ &dI Also initialize certain variables. &dA barnum = oldbarnum larc2 = 0 rec = f(f12,6) crec = 0 csnode = 6913 point = pdist prev_point = point point_adv = 0 oldmpoint = point if f13 = 1 oldmp2 = point else oldmp2 = firstpt end last_jtype = " " /* added &dA11/25/06&d@ barcount = 0 if f(f12,11) > 0 rest7 = 0 /* added &dA12/24/03&d@ perform save5 if barcount = delta goto CW end end &dA &dA &d@ &dIc. Process the data for each part. Compute new x-position for all &dA &d@ &dI objects. Collect information on super objects; these may have &dA &d@ &dI to be split at the end of line. Determine where to stop looking &dA &d@ &dI (this has turned out to be a problem area for this program). &dA if justflag < 2 type1_dflag(f12) = ON type2_dflag(f12) = OFF &dK &d@ dputc looping through part ~f12 &dK &d@ getc end CZ: tget [Z,rec] line .t3 jtype c2 c2 c2 c2 snode &dK &d@ dputc .w4 ~f12 ~line &dA &dA &d@ New code added &dA01/06/04&d@ to deal with line control flags &dA if justflag < 2 c2 = recflag(rec) >> 8 &dK &d@ dputc recflag = ~c2 line = ~line if c2 <> 1 &dK &d@ if type1_dflag(f12) = ON &dK &d@ dputc turning type1_dflag(~f12 ) OFF &dK &d@ end type1_dflag(f12) = OFF end if c2 = 2 &dK &d@ if type2_dflag(f12) = OFF &dK &d@ dputc turning type2_dflag(~f12 ) ON &dK &d@ end type2_dflag(f12) = ON end &dA &dA &d@ Fixing a bug in the TAKEOUT system &dA12/22/05&d@ &dA save_type1_dflag(f12) = type1_dflag(f12) save_type2_dflag(f12) = type2_dflag(f12) end &dA ++rec if line{1} = "Q" goto CZ end &dA &dA &d@ Process multiple rests and whole rests &dA if line{1,3} = "J S" and "467" con line{5} and f11 > 1 #if SCORE_PARS if line con "|" mrest_data(f12) = line{mpt..} line = line{1,mpt-1} end #endif --rec perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec &dA &dA &d@ a) check for underlines &dA c9 = 0 loop for c8 = 1 to f(f12,13) if f(f12,9) > 0 and "_,.;:!?" con xbyte(f12){c8} if mpt > 1 c9 = 1 end y = sq(f12) + f(f12,9) xbyte(f12){c8} = "*" end repeat &dK &d@ if c9 = 1 &dK &d@ This change found in more recent mskpage &dK &d@ uxstop(f12) -= hpar(f12,4) &dK &d@ end &dA &dA &d@ b) process rest(s) &dA if barcount = delta f(f12,11) = 0 f(f12,6) = rec - 1 f(f12,5) = rec - 1 goto CW end rest7 = 0 if ntype = 4 f(f12,11) = snode else f(f12,11) = 1 &dA &dA &d@ Added &dA12/24/03&d@ for optional staff lines &dA if ntype = 7 rest7 = 1 end &dA end loop tget [Z,rec] line ++rec repeat while line{1,3} <> "J B" --rec perform save5 if barcount = delta goto CW end goto CZ end * if line{1} = "J" &dA &dA &d@ O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ We must compute the new obx for this object. To do this, we &dA &d@ will use the information the larr array. We must be reminded &dA &d@ at this point about the kinds of nodes which are in the larr &dA &d@ array. The larr array locates objects of type N,R,Q,F,I,B,K,T. &dA &d@ In addition, type C generates a larr node, if it follows a &dA &d@ B type node and has snode = 6913. The value of snode for the &dA &d@ larr nodes in a particular measure is always non-decreasing. &dA &d@ In general, the value increases with each node. Exceptions &dA &d@ are as follows: 1) At the end of a measure, there may be &dA &d@ several nodes with snode = 6913. The first of these is &dA &d@ always a B type. Those that follow may include C,K, and T &dA &d@ types in that order. 2) It can happen that there is a &dA &d@ non-controlling bar line in the middle of a measure. In this &dA &d@ case, the bar line (B) will have the same larr(.,SNODE) value (&dA05/25/03&d@) &dA &d@ as the next node. There can be several proper objects with &dA &d@ the same snode value in a node, e.g. F and N types are &dA &d@ commonly found together. In this case, the type for the &dA &d@ node is the first time encountered in the part. It is &dA &d@ important when reading the part to realize that there &dDwill not&d@ &dA &d@ be a new larr node for each proper object encountered. New &dA &d@ larr nodes are generated &dDonly&d@ by: 1) an advance in snode, &dA &d@ 2) a type N,R,Q,F,I following a type B, when snode < 6913, &dA &d@ 3) a C and/or K and/or T after a type B, when snode = 6913. &dA &d@ Grace notes (G), symbols (S), directives (D), and marks (M) &dA &d@ will always take their position from the proper object that &dA &d@ follows. It still isn't clear to me whether marks or symbols &dA &d@ can have their own unique snode number. &dA &dA &d@ To sum all of this up, it is very important that the reading &dA &d@ and interpreting of objects in the intermediate file not get &dA &d@ out of phase with the nodes in larr. If this happens, the &dA &d@ positions of objects will become messed up. &dA if jtype = "M" and snode = 10000 putc Error: Unexpected end of file for part ~f12 examine stop end --rec * Get the remaining object related parameters perform save3 /* oby will be used; it will be modified as needed #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line &dA &dA &d@ Compute the new obx. &dA &dA &d@ Case I: controlling bar line &dA if jtype = "B" and snode = 6913 &dA &dA &d@ New &dA05/25/03&d@ Remove any measure print suggestions here (also &dA05/28/05&d@) &dA if oby >= 1000000 c9 = oby / 1000000 oby = rem sub = 5 c8 = int(line{sub..}) /* bar number c7 = int(line{sub..}) /* obx c6 = int(line{sub..}) /* oby line = "J B " // chs(c8) // " " // chs(c7) // " " // chs(oby) // line{sub..} end if oby >= 1000 oby -= 1000 /* convert to proper bar flag (double etc.) end firstbarflag = 1 csnode = 6913 oldcdv = cdv /* New &dA12/19/03 perform getcontrol ++barcount if oby > 0 and barnum < ntype barnum = ntype end f4 = 0 if barcount = delta f4 = 1 endbarrec = rec + 1 end point = oldmpoint + barpar(barcount,1) prev_point = point point_adv = 0 half_back = point - oldmp2 / 2 larc2 = barpar(barcount,2) oldmpoint = point oldmp2 = point obx = 0 /* differential obx goto DE end &dA &dA &d@ Case II: everything else &dA a1 = crec oldcdv = cdv perform getcontrol &dA &dA &dA &d@ New &dA01/29/09&d@ &dA &dA &d@ Fixing the object order problem. Here we impose the special &dA &d@ condition that getcontrol should not be allowed to "back up" when &dA &d@ dealing with grace notes at the end of a measure. &dA if a1 > crec and csnode = 6913 if jtype = "G" or jtype = "C" crec = a1 cdv = oldcdv end end &dA cdv_adv = cdv - oldcdv obx = dvar1 - cdv /* differential obx if crec <> a1 prev_point = point i = larc2 + 1 #if SCROLL_OUT max_larc = 30000 #else max_larc = 300 #endif loop for larc2 = i to max_larc point += larr(larc2,PRE_DIST) if larr(larc2,SNODE) = csnode a10 = larr(larc2,MNODE_TYPE) if a10 < 12 or a10 > 20 or a10 = cntype goto DE end end repeat &dA &dA &d@ Adding a second filter that relaxes the condition for success (&dA01/18/04&d@) &dA point = prev_point /* since you are trying again, get old value of point loop for larc2 = i to max_larc point += larr(larc2,PRE_DIST) if larr(larc2,SNODE) = csnode a10 = larr(larc2,MNODE_TYPE) if csnode = 6913 and a10 = 18 goto DE end end repeat &dA else goto DE end putc Logical error in finding node in part ~f12 at bar ~barnum putc putc Type $$ to see the section of i-file that generated this error. putc Type !! to exit program, or simple to examine code. getc line line = trm(line) if line = "$$" loop for i = rec - 30 to rec + 40 tget [Z,i] line if i = rec putc .w6 ~i &dA~line else putc .w6 ~i ~line end repeat end putc Type !! to exit program, or simple to examine code. getc examine stop &dA &dA &d@ differential obx and point now determined &dA DE: point_adv = point - prev_point obx += point ++rec if jtype = "N" and f(f12,9) > 0 /* text only &dA Code added 2-8-93 &dA &d@ There was a problem with the continuation line not stopping &dA &d@ when it was supposed to after a carry over from a previous measure. &dA &d@ The problem occured only when the stopping note was the first in &dA &d@ the new bar. I was not able to completely understand the logic &dA &d@ of the code using nuxstop, but I was able to determine that the &dA &d@ value of nuxstop had been set in the previous system of music &dA &d@ and was greater than rmarg. I therefore introduced a new variable &dA &d@ called &dAfirstbarflag&d@, which is 0 when setting the first bar on a &dA &d@ line, and 1 otherwise. I think the problem may occur only when &dA &d@ nuxstop > rmarg and firstbarflag = 0. Therefore, in this case I &dA &d@ have reset nuxstop to the expected value of sp+obx+hpar(f12,2). if firstbarflag = 0 and nuxstop(f12) > rmarg nuxstop(f12) = sp + obx + hpar(f12,2) end &dA End of code added 2-8-93 &d@ #if SCORE_PARS if savenoby(f12) = oby nuxstop(f12) = sp + obx + hpar(f12,2) uxstop(f12) = nuxstop(f12) else uxstop(f12) = nuxstop(f12) nuxstop(f12) = sp + obx + hpar(f12,2) end #else if savenoby(f12) = oby nuxstop(f12) = sp + obx + hpar(f12,2) else nuxstop(f12) = sp + obx + hpar(f12,2) end #endif savenoby(f12) = oby * uxstop(f12) = sp + obx + hpar(f12,2) end &dK &d@ if jtype = "R" and cflag = 1 if "Rr" con jtype and cflag = 1 /* New &dA10/15/07&d@ obx = oldmpoint - oldmp2 + barpar(barcount+1,1) / 2 - notesize + oldmp2 if f(f12,12) = 1 obx = 20000 /* Taking this out &dA05/25/03&d@ (not checked) ???? end end if jtype = "C" if f(f12,12) = 2 and oby >= 1000 clef(f12,2) = ntype else clef(f12,1) = ntype end end if jtype = "K" key(f12) = ntype end if jtype = "T" if barcount = delta tcode(f12) = ntype else tcode(f12) = 10000 end end &dA &dA &d@ Re-writing this section &dA12/24/03&d@. The problem is that the old code &dA &d@ dealt with suppressing D-type records below the top staff line by &dA &d@ simply skipping them. This worked as long as the full score was being &dA &d@ printed. But if the top line is taken out for some reason, then &dA &d@ "top line" directives are lost. The solution is to suppress D-type &dA &d@ records by setting the font in the W-subobjects to zero. This way &dA &d@ the directives can be turned back on, if necessary &dA if jtype = "D" if ntype = 0 goto CZ3 end if bit(1,ntype) = 1 goto CZ3 end if bit(2,ntype) = 1 and f12 = 1 goto CZ3 end if bit(3,ntype) = 1 and f12 = f11 goto CZ3 end &dA &dA &d@ Now, turn off W-subobjects associated with this directive &dA c8 = rec SKD2: tget [Z,c8] line2 .t3 sobx soby z temp if line2{1} = "W" and z <> 0 line2 = "W " // chs(sobx) // " " // chs(soby) // " 0 " line2 = line2 // "(" // chs(z) // ")" // temp tput [Z,c8] ~line2 ++c8 goto SKD2 end end &dA &dA &d@ General Object Related Activity &dA &dA &d@ 1. Collect super-object information &dA CZ3: line = line{5..} perform strip2 line = trm(line) oby = int(line) &dA &dA &d@ Don't fix oby yet, because we may need staff info when constructing &dA &d@ tie, slur, beam, tuplet, transpos, dashes, trills or wedges superobjects &dA &dA &d@ if oby >= 700 and f(f12,12) = 2 &dA &d@ oby -= 1000 /* for superobjects, need oby relative to staff &dA &d@ end &dA if justflag < 2 #if CONTINUO if jtype = "F" obx += hpar(f12,23) end #endif ++mainyp &dA &dA &d@ &dA12/17/03&d@ &dA &dA &d@ Here is where we determine the larr index which generated &dA &d@ the value of "point". We will use larr_gen(.) to pass this &dA &d@ information on to pointer(.,10) for this object in the edit &dA &d@ section of the program. &dA if psysnum = 0 j = point else j = point - pdist /* reason: For 2nd and subsequent systems, larr does end /* not include the clef and key larr_gen(mainyp) = 0 /* starting point should be set to 0 (just in case) &dK &d@ if mnum > 120 &dK &d@ dputc point = ~point pdist = ~pdist j = ~j &dK &d@ loop for i = 1 to larc &dK &d@ dputc ~cum_larr(i,1) &dK &d@ repeat &dK &d@ putc &dK &d@ end loop for i = 1 to cum_larrz if j = cum_larr(i,1) larr_gen(mainyp) = i i = 10000 end repeat if i < 10000 dputc Program error: can't find point in larr_gen #if XVERSION stop #endif end &dA tput [Y,mainyp] J ~jtype ~ntype ~obx ~line end perform strip4 lpt = 0 tline = txt(line,[' '],lpt) supcnt = int(tline) if supcnt > 0 loop for i = 1 to supcnt tline = txt(line,[' '],lpt) j = int(tline) if j = 0 putc putc &dAError&d@: Wrong number of superobjects putc putc This is actually an obscure error that can be caused putc by AUTOSET trying to collapse two parts (I:2) into one. putc We suggest you check source files for duplicated triplets, putc or perhaps other duplicated super-objects (duplicate ties putc and slurs are O.K.) putc putc Another cause could be beam super-object "=" characters putc extending across grace notes. putc putc examine stop end &dA &d@ look for previous reference to this superobject loop for k = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ if supermap(f12,k) = j goto WA end repeat h = 0 loop for k = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ if supermap(f12,k) = 0 h = k k = N_SUPER /* New &dA02/01/09&d@ end repeat if h = 0 putc Error: No more superobject capacity examine stop end &dA &dA &d@ if not found, then set up reference to this superobject &dA &d@ also set superdata(f12,k,5) = 0 for those super-objects &dA &d@ which depend on two locations only and which can be &dA &d@ split across a line or page break &dA k = h supermap(f12,k) = j superpnt(f12,k) = 1 superdata(f12,k,5) = 0 superdata(f12,k,6) = 0 /* New &dA06/09/08&d@ superdata(f12,k,7) = 0 /* New &dA06/09/08&d@ &dA &d@ k (value 1 to N_SUPER) = pointer into superdata for this superobject WA: h = superpnt(f12,k) &dA &d@ store object information in superdata and increment superpnt superpnt(f12,k) = h + 2 superdata(f12,k,h) = obx superdata(f12,k,h+1) = oby /* unfixed 7-22-93 &dA &d@ if this object is the last bar in a line, &dA &d@ then set last bar flag in superdata if jtype = "B" and h = 1 superdata(f12,k,6) = f4 end repeat end &dA &dA &d@ End of General Object-related Activity &dA &d@ saverec = rec &dK &d@ if jtype = "R" if "Rr" con jtype /* New &dA10/15/07&d@ loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} xbyte(f12){c8} = "*" end repeat end &dA &dA &d@ End of &dA12/27/05&d@ change (eliminating code that did nothing) if jtype = "B" &dA &dA &d@ If this is the first part in which this particular bar line is &dA &d@ encountered, then set value of barpar(.,3) and f5 &dA if snode = 6913 and barpar(barcount,3) = 0 if oby >= 700 and f(f12,12) = 2 oby -= 1000 end barpar(barcount,3) = oby f5 = 0 #if SCROLL_OUT ++mainyp tput [Y,mainyp] w 0 -60 38 ~ntype #endif end if rec = endbarrec sobx = 0 if oby >= 700 /* &dA oby -= 1000 /* &dA &d@ Added &dA04/03/94&d@ end /* &dA if oby > 8 f5 = 2 ABX1: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "K" if z = 44 if sobx < 0 f5 |= 0x04 else f5 |= 0x01 end else if z > 88 line2 = trm(line2) if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end end end ++rec goto ABX1 end end if oby = 10 and f5 > 3 sobx = 0 - hpar(f12,16) - hpar(f12,17) - hpar(f12,18) soby = vpar(f12,3) if justflag < 2 ++mainyp tput [Y,mainyp] K ~sobx ~soby 44 soby = vpar(f12,5) ++mainyp tput [Y,mainyp] K ~sobx ~soby 44 end end if larc2 = larc and sobx > 0 bolddist(f12) = bolddist(f12) + sobx + hpar(f12,11) end end oby = 0 end if snode = 6913 &dA Code added 8-24-93 &dA &d@ It can happen that there are one or more grace notes before a controlling &dA &d@ barline in this part. In this case, snode will be = 6913, but the &dA &d@ grace note(s) DO NOT generate a larr node. Therefore these proper &dA &d@ objects must not be considered as candidates for the end of the line. if jtype = "G" goto CZ end &dA End of code added 8-24-93 &d@ i = point + sp &dA &d@ dputc larc = ~larc larc2 = ~larc2 length = ~i max = ~hxpar(4) &dA &d@ In determining whether this node is the last node in the line &dA &d@ for this part, we must consider the case where there was a clef &dA &d@ change or time change or key change at the end of the line and &dA &d@ where this change occurred in some parts but not in others. &dA &d@ For this purpose, we have introduced a fifth element in the &dA &d@ larr array, which is 0 for nodes <> 6913 and is a flag for active &dA &d@ parts for nodes = 6913 (bit 0 corresponds to part 1). If the &dA &d@ current node is a bar line, but is not the last node, and if &dA &d@ all remaining nodes are of the type, snode = 6913, and none &dA &d@ of these nodes has the current part as active, then this is &dA &d@ the last node on the line, EVEN THOUGH LARC <> LARC2! k = 0 if larc2 <> larc and f4 = 1 q1 = rec loop for h = larc2 + 1 to larc if larr(h,SNODE) <> 6913 goto C21A end if bit(f12-1,larr(h,ACT_FLAG)) = 1 goto ABX16 /* goto secondary test end repeat k = 1 goto C21A /* This is a test &dA10/12/07&d@ ABX16: /* secondary test tget [Z,q1] line2 .t5 q2 q2 q2 q2 q2 ++q1 if line2{1} <> "J" goto ABX16 /* keep looking for a "J" end if q2 = 6913 goto C21A /* set k = 1 if not 6913 end k = 1 /* bar &dAis&d@ last node on line end C21A: if larc2 = larc or k = 1 &dA &dA &d@ check to see of the current record = the control record &dA &d@ if not then this is not the last record in the line &dA h = saverec - 1 if h <> crec &dA &dA &d@ if not last record in line, look for time directive or clef sign &dA if jtype = "D" if ntype <> 1 dxoff(f12) = obx - point dyoff(f12) = oby drec(f12) = rec - 1 end else if jtype = "C" goto CZ end if jtype = "M" /* added &dA9-29-93&d@ but not thoroughly tested goto CZ end putc Error: Unexplained non-controlling object at end of line putc This error can sometimes result from a mistake in one of the putc source files. Essentially, MSKPAGE found an object at the putc end of a measure that it did not expect to find. For example, putc word objects such as "Da Capo" may occur at the end of a measure, putc but letter dynamics (symbols) should not. In one case I ran putc across recently, a word musical direction (B,C,or D) was mistakenly putc encoded as a letter dynamic (G). This generated a symbol at putc the end of a measure, which caused MSKPAGE to fail at this point. putc Enter $$ to see the relevant portion of the i-file putc Enter !! to terminate program getc line2 line2 = trm(line2) if line2 = "$$" loop for k = crec - 30 to crec + 30 tget [Z,k] line2 if k = h putc .w6 ~k &dI~line2 &d@ .t60 Unexplained object else if k = crec putc .w6 ~k &dA~line2 &d@ .t60 End of measure else putc .w6 ~k ~line2 end end repeat putc putc Enter !! to terminate program getc end examine stop end &dA &dA &dA &d@ &dA11/21/07&d@ Expanding this section to allow directives to be cast to the next line &dA &d@ (using c12, c13) &dA &dK &d@ if endflag = 0 /* skip over directives &dKS&d@KD1: tget [Z,rec] line2 .t3 sobx soby z &dK &d@ if line2{1} = "W" &dK &d@ ++rec &dK &d@ goto SKD1 &dK &d@ end &dK &d@ end if endflag = 0 c12 = 0 if jtype = "D" /* skip over directives and store data for next line c13 = rec - 1 SKD1: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "W" c12 = 1 ++rec goto SKD1 end end if c12 = 1 ++new_dircnt new_direct(new_dircnt,1) = f12 new_direct(new_dircnt,2) = c13 end end &dA &dA &d@ End of &dA11/21/07&d@ expansion goto CZ end &dA &dA &d@ look for sub-objects to typeset &dA k = 0 ABX2: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "W" /* code added &dA02-23-97&d@ if justflag < 2 tget [Z,rec-1] line2 if line2{1,3} = "J B" /* then this WORD is a centered number tget [Z,rec] line2 line2 = line2{3..} h = int(line2) line2 = line2{sub..} line2 = mrt(line2) h -= half_back line2 = "W " // chs(h) // " " // line2 end ++mainyp tput [Y,mainyp] ~line2 end ++rec goto ABX2 end /* end of &dA02-23-97&d@ addition if line2{1} = "K" h = sobx if z = 63 h += hpar(f12,6) end if z > 63 and z < 66 h += hpar(f12,7) end if z > 36 and z < 39 h += hpar(f12,9) end if z > 70 and z < 81 h += hpar(f12,10) end line2 = trm(line2) if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end if h > k k = h end ++rec goto ABX2 end if line2{1} = "A" /* Added &dA11-11-93&d@ if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end ++rec goto ABX2 end if k > 0 bolddist(f12) += k end &dA &dA &d@ check for super-objects at this point in the file &dA loop tget [Z,rec] line ++rec temp = line{1} if temp = "H" superline = trm(line) lpt = 3 tline = txt(line,[' '],lpt) &dA &d@ line structure = supernum htype . . . supernum = int(tline) &dA &d@ get superdata for this superobject loop for k = 1 to N_SUPER /* N_SUPER is New &dA02/01/09 if supermap(f12,k) = supernum goto WB2 end repeat putc Error: No refererce to superobject ~supernum in previous objects examine stop * k = index into superdata WB2: htype = txt(line,[' '],lpt) perform save1 supermap(f12,k) = 0 end repeat while temp = "H" --rec &dA &dA &d@ look for incomplete superobjects and underlines &dA f(f12,6) = rec f(f12,5) = rec #if REPORT putc part = ~f12 barnum = ~barnum NEXTREC = ~rec #endif loop for k = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ if supermap(f12,k) = 0 goto CL end rec = f(f12,6) &dA &dA &d@ 1) look for object that terminates this super-object &dA &d@ get x and y coordinates of this object &dA loop perform save3 /* want vstaff info; (raw oby) #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if snode = 10000 putc Error: No terminating object for super-object ~supermap(f12,k) putc putc This error occurred in part number ~f12 of the score at putc approximately measure number ~(barnum - 1) . The first step would be putc to look in the stage2 source file for this part. Be sure to look putc in the right file; it's name may not be the same as it's order putc in the score. putc putc If you do not find any obvious error in the stage2 source file, putc you should look in the i-file which generated this error. The putc super-object number is given above. Load the i-file into a putc screen and do a search for that specific number. It will turn putc up somewhere as a super-object (one of the last numbers in an putc object line). You can then determine the object to which this putc super-object is attached and the exact measure in which it is putc first referenced. This should give you some clue as to what putc kind of super-object it was and why the terminating object was putc missing. putc putc The location of the error may be related to location of the putc super-object only indirectly. For example, a beam on some grace putc notes (a super_object) might be open and closed properly, but if putc a (much) later grace note has an "=" in column 26 (i.b46 e.b46 , super- putc object not properly started), then mskpage may try to re-open putc the earlier super-object -- hence a much lower super-object putc number than would be expected at the error location. I actually putc had a case where the given location was near the beginning of a putc file, but the coding error was near the end of a &dCprevious file! putc putc If you still cannot find an error in the source file, the problem putc may be in the software. Make a bug report and include a copy putc of the relevant source file. putc putc Enter !! to terminate program. getc examine stop end x = dvar1 - bolddist(f12) y = oby perform strip8 lpt = 0 tline = txt(line,[' '],lpt) n = int(tline) if n > 0 loop for a1 = 1 to n tline = txt(line,[' '],lpt) a2 = int(tline) if a2 = supermap(f12,k) goto WC /* Object found end repeat end end repeat &dA &dA &d@ 2) look for superobject (beyond object) &dA WC: loop perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" and snode = 10000 putc Error: Missing superobject ~supermap(f12,k) , possible extra beam code examine stop end if line{1} = "H" lpt = 3 tline = txt(line,[' '],lpt) n = int(tline) if supermap(f12,k) = n htype = txt(line,[' '],lpt) if htype = "B" putc Error: Beam extends over control bar line examine stop end &dA &dA &d@ Incomplete Tie (section re-coded &dA05/28/03&d@ to fix suggestions for incomplete ties) &dA if htype = "T" sub = lpt y1 = int(line{sub..}) x1 = int(line{sub..}) x2 = int(line{sub..}) c1 = int(line{sub..}) c2 = int(line{sub..}) c3 = int(line{sub..}) sitflag = int(line{sub..}) tspan = rmarg - sp - x1 if justflag < 2 * create mark for end of tie ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n * create "first half" of super-object ++mainyp tput [Y,mainyp] H ~n T ~y1 ~x1 0 ~c1 ~c2 0 ~sitflag 0 end &dA &d@ * * * &dA &d@ By setting supermap(k) = 0 at this point, you will cause &dA &d@ superdata to be collected on only the terminating note of &dA &d@ the tie. In this case, superpnt(.) will be 2 instead of 4, &dA &d@ and the program will know to typeset a small end-tie. &dA &d@ * * * conttie(f12) = 1 /* Code added &dA02/25/97&d@ supermap(f12,k) = 0 goto CL end &dA &dA &d@ Incomplete Slur &dA if htype = "S" tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) a3 = int(tline) x1 = a3 + superdata(f12,k,1) tline = txt(line,[' '],lpt) a4 = int(tline) y1 = a4 + superdata(f12,k,2) if y1 > 700 y1 -= 1000 /* correct for vstaff flag end tline = txt(line,[' '],lpt) x2 = int(tline) + rmarg + x - sp tline = txt(line,[' '],lpt) a5 = 0 if y > 700 y -= 1000 /* correct for vstaff flag a5 = 1000 /* and add vstaff offset to location flag end y2 = int(tline) + y * compute second height as a percentage of total change a2 = x2 - x1 a1 = rmarg - sp - x1 * 20 / a2 y2 = y2 - y1 * a1 / 20 + y1 x2 = rmarg - sp y2 += a5 * set broken super-object flag if y2 = 0 y2 = 1 end superdata(f12,k,5) = y2 /* include virtual staff flag if justflag < 2 * create mark for end of slur ++mainyp tput [Y,mainyp] J M 0 ~syslen ~y2 0 6913 0 1 ~n * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n S ~sitflag ~a3 ~a4 0 0 0 0 0 end goto CL end &dA &dA &d@ Incomplete figure continuation lines &dA if htype = "F" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) x2 = rmarg - sp * set broken super-object flag superdata(f12,k,5) = 1 if justflag < 2 * create mark for end of figure continuation lines ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n F ~a3 ~x1 0 0 end goto CL end &dA &dA &d@ Incomplete octave transposition &dA if htype = "V" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(f12,k,2) /* tline = txt(line,[' '],lpt) a1 = 0 x2 = rmarg - sp a4 = x2 - x1 * set broken super-object flag superdata(f12,k,5) = 1 * create mark for end of octave transposition (mindful of virtual staff possibility) if justflag < 2 if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n V ~a3 ~x1 0 ~y1 0 end goto CL end &dA &dA &d@ Incomplete ending &dA if htype = "E" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) a2 = 0 x2 = rmarg - sp * create mark for end of incomplete ending if justflag < 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end &dA &dA &d@ &dA05/06/08&d@ superdata(.,.,5) has been designated as the flag from a split ending &dA &d@ In earlier verious of mskpage, it had only one non-zero value, namely 1 &dA &d@ Now it has three possible non-zero values: &dA &dA &d@ 1 = normal split. (I believe this may no longer be used) &dA &d@ 2 = split where the ending starts at the beginning of the page &dA &d@ 3 = signals that the ending was started on a previous page &dA &dA &d@ superdata(.,.,7) is used to flag this superobject as an ending (magic number) &dA if superdata(f12,k,6) = 0 or superdata(f12,k,5) = 2 /* New &dA05/06/08 * write "first half" of super-object if justflag < 2 ++mainyp tput [Y,mainyp] H ~n E ~a3 ~x1 0 ~y1 ~a1 0 end &dA*&d@ set broken super-object flag to 3 superdata(f12,k,5) = 3 else if justflag < 2 ++mainyp tput [Y,mainyp] H ~n N end &dA*&d@ set broken super-object flag to 2 superdata(f12,k,5) = 2 end &dK*&d@ set broken super-object flag &dK &d@ superdata(f12,k,5) = 1 superdata(f12,k,7) = 123456 /* New &dA05/06/08 goto CL end &dA &dA &d@ Incomplete dashes &dA if htype = "D" tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) x2 = rmarg - sp * set broken super-object flag superdata(f12,k,5) = 1 superdata(f12,k,6) = 234567 /* New &dA06/09/08&d@ magic number for dashes if justflag < 2 &dA &dA &dA &d@ New code &dA06/09/08&d@ If this is a page length set of dashes, put in a &dA &d@ mark for the beginning &dA if superdata(f12,k,7) = 1 x1 = hxpar(8) - sp if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~n end x1 = 0 end &dA &dA &d@ End of &dA06/09/08&d@ Code &dA &dA &d@ Now create mark for end of dashes (mindful of virtual staff possibility) &dA if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" (or "full length") super-object ++mainyp tput [Y,mainyp] H ~n D ~x1 0 ~y1 ~a1 ~a2 end goto CL end &dA &dA &d@ Incomplete Long Trill &dA if htype = "R" tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) x2 = rmarg - sp tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(f12,k,2) * set broken super-object flag superdata(f12,k,5) = 1 * create mark for end of long trill (mindful of virtual staff possibility) if justflag < 2 if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n R ~a1 ~x1 0 ~y1 end goto CL end &dA &dA &d@ Incomplete Wedge &dA if htype = "W" tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = rmarg - sp tline = txt(line,[' '],lpt) y2 = int(tline) * compute second spread if c1 < c2 if c1 = 0 a1 = c2 - 1 / 2 c2 = c2 * 3 / 4 else a1 = c2 end else if c2 = 0 c2 = c1 / 2 a1 = c1 * 3 / 4 else a1 = c1 end end * set broken super-object flag if a1 = 0 a1 = 1 end superdata(f12,k,5) = a1 * create mark for end of wedge (mindful of virtual staff possibility) if justflag < 2 if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n W ~c1 ~c2 ~x1 ~y1 0 ~y2 end goto CL end end end repeat CL: repeat loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} xbyte(f12){c8} = "*" end repeat &dA &dA &d@ End of &dA12/27/05&d@ code change (to remove code that did nothing) &dA &dA goto CW /* this is the exit for the music line loop (for each part) end end goto CZ end if line{1} = "K" or line{1} = "k" &dA &dA &d@ S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA tget [Z,rec-1] line2 line2 = trm(line2) if justflag < 2 if conttie(f12) = 1 /* (somewhat tricky solution) line2{1} = "K" /* Code added &dA02/25/97&d@ end ++mainyp tput [Y,mainyp] ~line2 end goto CZ end if line{1} = "A" /* Added &dA11-11-93&d@ &dA &dA &d@ A T T R I B U T E S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA tget [Z,rec-1] line2 line2 = trm(line2) if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end goto CZ end if line{1} = "W" &dA &dA &d@ W O R D S &dA &d@ ÄÄÄÄÄÄÄÄÄ &dA line = trm(line) if justflag < 2 tget [Z,rec-2] line2 /* added &dA02-23-97&d@ if line2{1,3} = "J B" /* then this WORD is a centered number tget [Z,rec-1] line2 line2 = line2{3..} x = int(line2) line2 = line2{sub..} line2 = mrt(line2) x -= half_back line = "W " // chs(x) // " " // line2 end /* end of &dA02-23-97&d@ addition ++mainyp #if SCROLL_OUT line{1} = "w" #endif tput [Y,mainyp] ~line end goto CZ end if line{1} = "T" &dA &dA &d@ T E X T (This code re-organized &dA12/19/03&d@ to deal with optional sobx2) &dA &d@ ÄÄÄÄÄÄÄ &dA &dA &d@ Step 1: determine object record to which this text belongs &dA &dK &d@ dputc Text record as read = ~line from position ~(rec-1) trec = rec - 2 /* rec was advanced after getting "T" record TX1: tget [Z,trec] line2 if line2{1} <> "J" and trec > 1 --trec goto TX1 end &dA &dA &d@ Step 2: save current value of backtxobrec and set a new value for backtxobrec &dA &dA &dA &d@ Correcting a Bug found &dA11/12/06&d@ &dA &dK &d@ c15 = backtxobrec &dK &d@ backtxobrec = trec if c15 <> backtxobrec c15 = backtxobrec backtxobrec = trec end &dA &d@ End of &dA11/12/06&d@ Correction &dA &dA &d@ Step 3: gather information from current line &dA line = trm(line) * line structure = sobx (or optionally sobx|sobx2 ) soby ttext xbyte textlen lpt = 3 tline = txt(line,[' '],lpt) tline = tline // " " sobx = int(tline) if tline{sub} = "|" sobx2 = int(tline{sub+1..}) else sobx2 = 100 end tline = txt(line,[' '],lpt) soby = int(tline) tline = line{lpt..} /* this is the rest of line, beginning with a " " &dA &dA &d@ Step 4: Determine if the opportunity exists to improve the placement of text &dA &dA &d@ We now have the following information at this point: &dA &d@ point_adv = amount by which the x-pointer has advanced to &dA &d@ produce this "group" of objects &dA &d@ cdv_adv = amount by which the x-pointer in the source i-file &dA &d@ advanced to produce this note object &dA &dA &d@ If point_adv is significantly (?) bigger than cdv_adv (i.e., &dA &d@ there is now ample space to the left of this note), AND &dA &d@ sobx2 is smaller (i.e., more negative) than sobx (i.e., the &dA &d@ ideal position of the text is to the left of the practical &dA &d@ position), then we can use sobx2 in place of sobx in &dA &d@ positioning the text. &dA &dA &d@ Also, if point_adv is significantly (?) bigger than cdv_adv &dA &d@ (i.e., there is now ample space to the left of this note), &dA &d@ AND the sobx2 &dEfrom the previous note&d@ containing text &dEwas&d@ &dA &d@ &dElarger&d@ (i.e., less negative) &dEthan&d@ the sobx for that note &dA &d@ (i.e., the ideal position of the text is to the right of &dA &d@ the practical position for the previous note), then we &dA &d@ should try to go back to the previous text record(s) and &dA &d@ replace the sobx with a saved_sobx2. To do this, we will &dA &d@ need a valid back pointer to &dEnote object&d@ which generated &dA &d@ previous text records, and the saved_sobx2 value. &dA c10 = point_adv - cdv_adv if c10 > 0 &dK &d@ dputc c10 = ~c10 (extra distance between this and last note with text) &dA &dA &d@ Step 5: c10 > 0. Try to determine how best to use this "extra" space. &dA &dA &d@ Step 5a: determine value of sobx (c11) for previous note with text &dA if c15 > 0 trec = c15 + 1 TX2: tget [Z,trec] line2 .t3 c11 if line2{1} <> "T" &dK &d@ dputc bad line = ~line2 ++trec goto TX2 end else /* for corner case of no valid backtxobrec c11 = 10000 /* this guarentees that c12 will be 0 end &dA &dA &d@ Step 5b: determine benefit to moving previous text to the right (c12) --> &dA if saved_sobx2 <> 100 and saved_sobx2 > c11 /* benefit to moving text --> c12 = saved_sobx2 - c11 else c12 = 0 end &dA &dA &d@ Step 5c: determine benefit to moving current text to the left (c13) <-- &dA if sobx2 <> 100 and sobx2 < sobx c13 = sobx - sobx2 /* a positive number in this scheme else c13 = 0 end &dA &dA &d@ Step 5d: determine how to distribute extra distance. &dA c14 = c12 + c13 &dK &d@ dputc c14 = ~c14 (amount of extra distance we would like to have) if c14 > c10 if c13 = 0 c12 = c10 else if c12 = 0 c13 = c10 else c13 = c13 * c10 / c14 c12 = c10 - c13 end end end &dA &dA &d@ Step 6: Move the horizontal position of text as appropriate &dA &dA &d@ Step 6a: if c12 > 0, move previous text position(s) to the right --> &dA if c12 > 0 trec = c15 + 1 tget [Z,trec] line2 loop if line2{1} = "T" c14 = int(line2{3..}) if line2{sub} = "|" dputc Program Error: report immediately stop end c14 += c12 line2 = "T " // chs(c14) // line2{sub..} &dK &d@ dputc New (previous) text record = ~line2 end ++trec tget [Z,trec] line2 repeat while "KTk" con line2{1} end &dA &dA &d@ Step 6b: if c13 > 0, move current text position to the left <-- &dA if c13 > 0 sobx -= c13 &dK &d@ dputc position of current text moved from ~(sobx + c13) to ~sobx end end &dA &dA &d@ Step 7: Save current value of sobx2 &dA saved_sobx2 = sobx2 &dA &dA &d@ Step 8: Reconstitute this "T" text line without sobx2 and recompute lpt &dA line = "T " // chs(sobx) // " " // chs(soby) // tline &dK &d@ dputc return line = ~line to position ~(rec-1) tput [Z,rec-1] ~line &dA &dA &d@ Step 9: Recompute lpt &dA line = trm(line) * line structure = sobx (or optionally sobx|sobx2 ) soby ttext xbyte textlen lpt = 3 tline = txt(line,[' '],lpt) tline = tline // " " sobx = int(tline) tline = txt(line,[' '],lpt) soby = int(tline) &dA &dA &d@ Step 10: if justflag < 2, store line in Y table &dA if justflag < 2 ++mainyp tput [Y,mainyp] ~line end &dA &dA &d@ End of &dA12/19/03&d@ code re-write &dA &dK &d@ loop for c8 = 1 to f(f12,13) &dK &d@ if "_,.;:!?" con xbyte(f12){c8} &dK &d@ x = sp + obx + sobx - hpar(f12,4) &dK &d@ if mpt > 1 &dK &d@ x -= hpar(f12,4) &dK &d@ end &dK &d@ if uxstop(f12) > x &dK &d@ uxstop(f12) = x &dK &d@ end &dK &d@ y = sq(f12) + f(f12,9) &dK &d@ end &dK &d@ repeat * ttext = txt(line,[' '],lpt) xbyte(f12){soby} = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) textlen = int(tline) x = sp + obx + sobx y = sq(f12) + f(f12,9) backloc(f12) = x + textlen uxstart(f12) = x + textlen + hpar(f12,3) goto CZ end if line{1} = "H" &dA &dA &d@ S U P E R - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA superline = trm(line) lpt = 3 tline = txt(line,[' '],lpt) * line structure = supernum htype . . . supernum = int(tline) * get superdata for this superobject loop for k = 1 to N_SUPER /* N_SUPER is New &dA02/01/09&d@ if supermap(f12,k) = supernum goto WB end repeat putc Error: No refererce to superobject ~supernum in previous objects examine stop * k = index into superdata WB: htype = txt(line,[' '],lpt) if htype = "T" &dA &dA &d@ structure of &dDtie superobject&d@: 4. vertical position of tied note &dA &d@ 5. horiz. displacement from 1st note &dA &d@ 6. horiz. displacement from 2nd note &dA &d@ 7. vacent &dA &d@ 8. vacent &dA &d@ 9. vacent &dA &d@ 10. sitflag &dA &d@ 11. recalc flag &dA tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(f12,k,1) tline = txt(line,[' '],lpt) x2 = int(tline) line = line{lpt+1..} perform strip3 sitflag = int(line) &dA &dA &d@ determine first note location (x1,y1) and tspan &dA &dA &d@ 1. Normal case &dA if superpnt(f12,k) = 5 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end tspan = superdata(f12,k,3) + x2 - x1 end &dA &dA &d@ 2. Continued tie &dA if superpnt(f12,k) = 3 x1 = superdata(f12,k,1) + x2 - hpar(f12,1) tspan = hpar(f12,1) if justflag < 2 * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum * create "second half" of super-object ++mainyp tput [Y,mainyp] H ~supernum T ~y1 0 ~x2 0 0 0 ~sitflag 0 end end supermap(f12,k) = 0 conttie(f12) = 0 /* Code added &dA02/25/97&d@ goto CZ end if htype = "B" &dA &dA &d@ structure of &dDbeam superobject&d@: slope vertoff font# #obs bc(1) ... &dA tline = txt(line,[' '],lpt) @k = int(tline) tline = txt(line,[' '],lpt) @m = int(tline) temp2 = line{lpt..} temp2 = mrt(temp2) tline = txt(line,[' '],lpt) beamfont = int(tline) j = Mbeamfont(notesize) /* covers all 12 notesizes if beamfont = j stemchar = 59 beamh = vpar(f12,16) beamt = vpar(f12,32) else stemchar = 187 beamh = vpar(f12,16) * 4 / 5 beamt = vpar(f12,32) * 4 + 3 / 5 end tline = txt(line,[' '],lpt) bcount = int(tline) if bcount > MAX_BNOTES j = MAX_BNOTES putc At the present time, this program can only accommodate ~j notes putc under one beam. To increase this capacity, the parameters: MAX_BNOTES putc and SUPERSIZE will need to be increased. putc putc &dAProgram Halted&d@ putc stop end j = 1 loop for i = 1 to bcount beamdata(i,1) = superdata(f12,k,j) beamdata(i,2) = superdata(f12,k,j+1) temp = txt(line,[' '],lpt) temp = rev(temp) e = 6 - len(temp) beamcode(i) = temp // "00000"{1,e} j += 2 repeat * print beam perform setbeam supermap(f12,k) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] H ~supernum ~htype ~@k ~@m ~temp2 end goto CZ end if htype = "S" &dA &dA &d@ structure of &dDslur superobject&d@: 4. sitflag &dA &d@ 5. extra horiz. displ. from obj-1 &dA &d@ 6. extra vert. displ. from obj-1 &dA &d@ 7. extra horiz. displ. from obj-2 &dA &d@ 8. extra vert. displ. from obj-2 &dA &d@ 9. post horiz. displ. &dA &d@ 10. post vert. displ. &dA &d@ 11. stock slur number &dA tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) y1 = superdata(f12,k,5) if y1 = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end else tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) a3 = int(tline) x2 = a3 + superdata(f12,k,3) x1 = hxpar(8) - sp - notesize a1 = x2 - x1 if a1 < hpar(f12,14) a2 = hpar(f12,14) - a1 x1 -= a2 end tline = txt(line,[' '],lpt) y2 = int(tline) /* + superdata(f12,k,4) * create mark at beginning of line (mindful of virtual staff possibility) if justflag < 2 if y1 > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum y1 -= 1000 else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of super-object ++mainyp tput [Y,mainyp] H ~supernum S ~sitflag 0 ~y1 ~a3 ~y2 0 0 0 end end supermap(f12,k) = 0 goto CZ end if htype = "F" &dA &dA &d@ structure of &dDfigcon super-object&d@: 4. figure level &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) if justflag < 2 if superdata(f12,k,5) = 0 ++mainyp tput [Y,mainyp] ~superline x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum * create "second half" of super-object ++mainyp tput [Y,mainyp] H ~supernum F ~a3 0 ~x2 0 end end supermap(f12,k) = 0 goto CZ end if htype = "X" &dA &dA &d@ structure of &dDtuplet super-object&d@: 4. situation flag &dA &d@ 5. tuplet number &dA &d@ 6. horiz. disp. from obj1 &dA &d@ 7. vert. disp. from obj1 &dA &d@ 8. horiz. disp. from obj2 &dA &d@ 9. vert. disp. from obj2 &dA &d@ 10. associated beam super-number &dA if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end supermap(f12,k) = 0 goto CZ end &dA &dA &d@ For the rest of the superbjects, please see code at procedure save1 &dA perform save1 supermap(f12,k) = 0 goto CZ end CW: if barnum > newbarnum newbarnum = barnum end * mark end of line if justflag < 2 ++mainyp tput [Y,mainyp] E ~xbyte(f12) end repeat &dA &dA &d@ New &dA11/21/07&d@ &dA loop for c12 = 1 to new_dircnt save_direct(c12,1) = new_direct(c12,1) save_direct(c12,2) = new_direct(c12,2) repeat save_dircnt = new_dircnt new_dircnt = 0 &dA barnum = newbarnum &dA &dA &d@ Check to see that multiple rest flags are equal &dA *DB putc Multiple rest flags loop for f12 = 1 to f11 *DB putc .w6 ~f12 ~f(f12,10) ~f(f12,11) f(f12,7) = f(f12,11) repeat &dI@F26 &dI@F23 &dI@F21 &dI@S27 8. Typeset bar lines &dI@ &dA &dA &d@ Typeset bar lines &dA if gbarflag = 1 if justflag < 2 ++mainyp tput [Y,mainyp] B ~gbar(2) ~gbar(1) 0 end gbarflag = 0 end obx = pdist /* + sp loop for barcount = 1 to delta obx += barpar(barcount,1) a8 = barpar(barcount,3) if barcount = delta if a8 = 9 a8 = 5 end if a8 = 10 a8 = 6 end end if justflag < 2 ++mainyp tput [Y,mainyp] B ~a8 ~obx 0 end repeat &dI@F27 &dI@S28 9. At this point you have completed the typsetting &dI@ of a complete system. Now is the time to look for &dI@ optional staff lines (i.e., staff line that are &dI@ flagged to be taken out if they contain nothing &dI@ but rests. &dI@ &dA &dA &d@ Code added for running a "simple_test" &dA11/20/06&d@ &dA if simple_test = 1 goto NO_TAKEOUT end &dA &d@ End of &dA11/20/06&d@ addition &dA &dA &d@ At this point you have completed the typesetting of a complete system &dA &dA &d@ New code (&dA12/24/03&d@) added to implement optional staff lines &dA if justflag < 2 c16 = 0 tf11 = f11 /* number of lines in system; initially f11 loop for c8 = 1 to f11 tsq(c8) = sq(c8) tvst(c8) = vst(c8) tnotesize(c8) = f(c8,14) repeat TAKEOUT: y2p = mainyp &dK &d@ putc &dK &d@ putc I-code for next system &dK &d@ putc &dK &dK &d@ loop for y3p = y1p to y2p &dK &d@ tget [Y,y3p] line &dK &d@ putc .w5 ~y3p ~larr_gen(y3p) ~line &dK &d@ repeat &dK &d@ putc &dK &d@ getc c9 = 0 c10 = 0 c11 = 0 c12 = 0 c13 = 0 loop for y3p = y1p to y2p tget [Y,y3p] line if line{1} = "S" c10 = y3p end if line{1} = "L" or line{1} = "l" /* "l" added &dA12/18/05&d@ ++c9 c13 = 0 c11 = y3p &dA &dA &d@ &dA03/25/06&d@ Dealing with possible @ LINE record &dA if andata_flag > 0 tget [Y,y3p-1] temp temp = temp // pad(60) if temp{1,7} = "@ LINE:" --c11 end end &dA end if line{1} = "E" &dK &d@ dputc type1_dflag(~c9 ) = ~type1_dflag(c9) type2_dflag(~c9 ) = ~type2_dflag(c9) &dK &d@ getc c12 = y3p if c13 = 0 or type1_dflag(c9) = ON or type2_dflag(c9) = ON /* modified &dA01/06/04 &dK &d@ if c13 = 0 &dA &dA &d@ Step E-1: Modify System line &dA &dK &d@ dputc sysy = ~sysy &dK &d@ dputc c9 = ~c9 tsq(c9) = ~tsq(c9) tsq(c9+1) = ~tsq(c9+1) c15 = ~c15 tget [Y,c10] line2 &dK &d@ dputc line2 = ~line2 sub = 3 c8 = int(line2{sub..}) /* 0 c8 = int(line2{sub..}) /* system x c8 = int(line2{sub..}) /* system y c8 = int(line2{sub..}) /* system length c6 = sub c8 = int(line2{sub..}) /* system height if tf11 = 1 putc putc You have reached a point in this program where the code below will putc fail. While not all cases of this situation have been identified, putc it is known that this situation will arise the follow conditions hold: putc putc (1) You are typesetting a part (not a score) putc (2) You are using the C0:y<#> control flag to turn lines off putc putc In this situation, you must turn off the multiple measure feature, putc which is automatically (and silently) turned on when parts are being putc compiled by autoset. Use the print suggestion: P C0:m0 putc in all relevent stage2 files. I hope this works for you (and me). putc putc &dCProgram Halted&d@ putc end if c9 < tf11 c14 = tsq(c9+1) - tsq(c9) else c14 = tsq(tf11) - tsq(tf11-1) c14 += 4 * tnotesize(tf11) /* staff line thickness for tf11 c14 -= 4 * tnotesize(tf11-1) /* staff line thickness for tf11-1 if tvst(tf11) > 0 c14 += tvst(tf11) /* 2nd line for tf11 end if tvst(tf11-1) > 0 c14 -= tvst(tf11) /* 2nd line for tf11-1 end end c8 -= c14 /* takeout on this "pass" c16 += c14 /* cumulative total takeout c7 = int(line2{sub..}) /* number of parts --c7 line2 = line2{1,c6} // chs(c8) // " " // chs(c7) // line2{sub..} &dK &d@ dputc new line2 = ~line2 sub = 1 loop for c8 = 1 to c9 if line2{sub..} con "." ++sub else if line2{sub..} con "," ++sub else if line2{sub..} con ":" ++sub else if line2{sub..} con ";" ++sub end end end end repeat --sub temp = line2{sub-1,3} &dK &d@ dputc temp = ~temp line2 = line2 // " " MTK: if line2{sub-1} = "(" and line2{sub+1} = ")" line2 = line2{1,sub-2} // line2{sub} // line2{sub+2..} --sub goto MTK end if line2{sub-1} = "[" and line2{sub+1} = "]" line2 = line2{1,sub-2} // line2{sub} // line2{sub+2..} --sub goto MTK end if line2{sub-1} = "{" and line2{sub+1} = "}" line2 = line2{1,sub-2} // line2{sub} // line2{sub+2..} --sub goto MTK end line2 = line2{1,sub-1} // line2{sub+1..} if line2 con "[" if line2{mpt+1} = "]" if mpt = 1 dputc Program Error stop else line2 = line2{1,mpt-1} // line2{mpt+2..} end end end if line2 con "{" if line2{mpt+1} = "}" if mpt = 1 dputc Program Error stop else line2 = line2{1,mpt-1} // line2{mpt+2..} end end end &dK &d@ dputc new line2 = ~line2 &dK &d@ dputc tput [Y,c10] ~line2 &dA &dA &d@ Step E-2: Eliminate the records between c11 and c12; also adjust all Line records &dA &dK &d@ loop for c14 = c11 to c12 &dK &d@ tget [Y,c14] line &dK &d@ putc ~line &dK &d@ repeat c15 = c12 - c11 + 1 loop for c14 = c12 + 1 to y2p tget [Y,c14] line2 if line2{1} = "L" or line2{1} = "l" /* "l" added &dA12/18/05 c8 = int(line2{3..}) if c9 < tf11 c8 = c8 + tsq(c9) - tsq(c9+1) else dputc Program Error stop end &dK &d@ line2 = "L " // chs(c8) // line2{sub..} line2 = line2{1} // " " // chs(c8) // line2{sub..} /* Modified &dA12/18/05 end tput [Y,c14-c15] ~line2 repeat mainyp -= c15 &dA &dA &d@ Step E-4: If c9 = 1, turn on the measure numbers for the new top line &dA &d@ and turn on any "top line" directives that might &dA &d@ be present in the line &dA &d@ if c9 = 1 loop for c14 = c11 to mainyp tget [Y,c14] line2 line2 = line2 // pad(40) if line2{1,2} = "W " c8 = int(line2{2..}) /* x offset c8 = int(line2{sub..}) /* y offset c7 = sub /* c7 -> space before font number c8 = int(line2{sub..}) if c8 = 0 /* directive has been "turned off" c17 = sub /* c17 -> space after font number if line2{c17+1} = "(" c8 = int(line2{c17+2..}) /* proper font is in () if c8 <> 0 c17 = sub + 1 /* c17 -> space after ")" else c8 = M_NUM_FONT end else c8 = M_NUM_FONT end line2 = line2{1,c7} // chs(c8) // line2{c17..} tput [Y,c14] ~line2 end else if line2{1} = "E" /* Exit loop c14 = mainyp end end repeat end &dA &dA &d@ Step E-5: Adjust tsq(.), tvst(.), tnotesize(.), bottom_sq, tf11, &dA &d@ type1_dflag, type2_dflag, to match with system of 1 fewer lines. &dA &d@ if c9 < tf11 c10 = tsq(c9+1) - tsq(c9) loop for c8 = c9 + 1 to tf11 tsq(c8-1) = tsq(c8) - c10 tvst(c8-1) = tvst(c8) tnotesize(c8-1) = tnotesize(c8) type1_dflag(c8-1) = type1_dflag(c8) /* New &dA01/06/04 type2_dflag(c8-1) = type2_dflag(c8) /* " " repeat end --tf11 bottom_sq = tsq(tf11) &dA &dA &d@ Step E-5a: Adjust elements of larr_gen array for records beyond c12 &dA &d@ loop for c14 = c12 + 1 to y2p larr_gen(c14-c15) = larr_gen(c14) larr_gen(c14) = 0 repeat &dA &dA &d@ Step E-6: Circle back to top of process; look for more lines to take out &dA goto TAKEOUT end end &dA &dA &d@ This "J" section looks for legitimate musical notation in the line; &dA &d@ sets c13 = 1, if found. &dA if line{1} = "J" &dK &d@ if "GQNMR" con line{3} &dK &d@ if "GQNMRr" con line{3} /* New &dA10/15/07&d@ if "GQNRr" con line{3} /* New &dA10/28/07&d@ &dK &d@ if line{3} <> "R" if line{3} <> "R" and line{3} <> "r" /* New &dA10/15/07&d@ &dK &d@ if c13 = 0 &dK &d@ dputc setting c13 to 1 line = ~line &dK &d@ end c13 = 1 else &dK &d@ if line{3,3} <> "R 9" if line{3,3} <> "R 9" and line{3,3} <> "r 9" /* New &dA10/15/07 if line{3} <> "r" /* New &dA10/15/07 &dK &d@ if c13 = 0 &dK &d@ dputc setting c13 to 1 line = ~line &dK &d@ end c13 = 1 end else sub = 7 c8 = int(line{sub..}) /* obx c8 = int(line{sub..}) /* oby c8 = int(line{sub..}) /* pcode c8 = int(line{sub..}) /* "1" c8 = int(line{sub..}) /* inctype &dK &d@ dputc sub = ~sub line = ~line &dK &d@ if c8 <> 10001 if c8 <> 10001 and line{3} <> "r" /* New &dA10/15/07 &dK &d@ if c13 = 0 &dK &d@ dputc setting c13 to 1 line = ~line &dK &d@ end c13 = 1 end end end end end &dK &d@ putc ~line repeat &dK &d@ getc &dA &dA &d@ Cleanup Section: Fix all "stray" Q records and 10001 inctypes &dA loop for y3p = y1p to y2p tget [Y,y3p] line &dK &d@ if line{1,3} = "Q R" if line{1,3} = "Q R" or line{1,3} = "Q r" /* New &dA10/15/07&d@ &dK &d@ line = "J " // line{3..} line = "J R " // line{5..} /* New &dA10/15/07&d@ tput [Y,y3p] ~line end &dK &d@ if line{1,6} = "J R 9 " if line{1,6} = "J R 9 " or line{1,6} = "J r 9 " /* New &dA10/15/07&d@ sub = 7 c8 = int(line{sub..}) /* obx c9 = int(line{sub..}) /* oby c10 = int(line{sub..}) /* pcode c11 = int(line{sub..}) /* "1" c11 = int(line{sub..}) /* inctype if c11 = 10001 &dK &d@ dputc ~line line = "J R 9 " // chs(c8) // " " // chs(c9) // " " // chs(c10) // " 1 0" // line{sub..} &dK &d@ dputc ~line tput [Y,y3p] ~line end end &dA &dA &d@ /* New &dA10/15/07&d@ &dA if line{1,3} = "J r" line = "J R " // line{5..} /* New &dA10/15/07&d@ tput [Y,y3p] ~line end &dA repeat &dA &dA &d@ Cleanup, part II: Re-set bottom of system &dA if c16 > 0 sys_bottom -= c16 &dK &d@ sq(f11) -= c16 end end &dA &dA &d@ End of &dA12/24/03&d@ addition &dA NO_TAKEOUT: #if XVERSION &dA &dA &d@ At this point you have completed the typesetting of a complete system &dA &d@ Now is the time to look at that system and decide what, if any, horizontal &dA &d@ modifications need to be made. Note: This code can be executed here &dA &d@ irrespective of whether the system fits on this page or whether it &dA &d@ must be advanced to a new page. &dA if justflag < 2 y2p = mainyp &dK &d@ putc &dK &d@ putc I-code for next system &dK &d@ putc &dK &d@ loop for y3p = y1p to y2p &dK &d@ tget [Y,y3p] line &dK &d@ putc ~line &dK &d@ repeat &dK &d@ getc &dA &d@ &dA12/17/03&d@ &dA &dA &d@ At this point, the decision must be made whether to enter the &dA &d@ edit module. If psysnum = 0, and there is a format file &dA &d@ (formatflag = 1), and it contains larr data (forp < forpz), &dA &d@ we need to ask the user whether page generation should proceed &dA &d@ automatically or whether some re-editing is desired. This will &dA &d@ determine bit-0 of edflag. &dA if psysnum = 0 if formatflag = 1 and forp < forpz putc putc The Format file contains page specific data putc Enter "&dEy&d@" or "&dEY&d@" if re-edit is desired. getc line line = trm(line) if line = "y" or line = "Y" edflag = 1 end else edflag = 1 end end if edflag > 0 msknotesize = notesize perform eskpage notesize = msknotesize end &dA &d@ &dA12/17/03&d@ &dA &dA &d@ At this point, we can re-constitute the PRE_DIST values from &dA &d@ the cum_larr(.,.) array &dA &d@ j = 0 loop for i = 1 to larc larr(i,PRE_DIST) = cum_larr(i,1) - j j = cum_larr(i,1) if cum_larr(i,2) = 1 larr(i,PRE_DIST) = 0 end repeat &dA &dA &d@ &dA12/17/03&d@ &dA &dA &d@ The larr(larc,.) array is now in its final form (all editing &dA &d@ that is going to be done has been done). If formatflag = 1, &dA &d@ the values in larr(.,.) need to be copied back into the format &dA &d@ file (via bigline). If formatflag = 2, a new line entry for &dA &d@ the emerging format file needs to be generated from larr(.,.). &dA ++psysnum if formatflag > 0 bigline = "sys" if psysnum < 100 bigline = bigline // "0" end if psysnum < 10 bigline = bigline // "0" end bigline = bigline // chs(psysnum) // " " loop for j = 1 to larc bigline = bigline // chs(larr(j,PRE_DIST)) // " " // chs(larr(j,MNODE_TYPE)) // " " repeat bigline = bigline // "|" ++forp tput [F,forp] ~bigline end end #else if justflag < 2 ++psysnum end #endif &dI@F28 &dI@S29 10. Now we have the final sq(.)'s and we can check to &dI@ see of we have "overrun" the bottom of the page. &dI@ If so, we need to start a new page and reset the &dI@ height of the system to top of the page. If this &dI@ is the first system on the first page, and we have &dI@ overrun the bottom, the program needs to report &dI@ this condition and HALT. &dI@ &dA &dA &d@ Report on progress &dA #if MREPORT if justflag > 1 putc .t5 measure ~mnum end #endif &dA &dA &d@ New page control code &dA12/24/03&d@ &dA if justflag < 2 c16 = sys_bottom &dA &dA &d@ Step 0: Report on progress &dA if c16 > lowerlim putc .w3 ~(page+2) .w1 measure ~mnum else putc .w3 ~(page+1) .w1 measure ~mnum end if c16 > lowerlim if firstsys = TRUE putc Unable to print; too many lines on first page stop end &dA &dA &d@ Step 1: Setup new page and tranfer all but the last system &dA perform newpage #if SCORE_PARS perform process_and_transfer (sv_mainyp) #else perform output_page (sv_mainyp) #endif &dA &dA &d@ Step 2: Move last system to top of table; fix system line. &dA &d@ There will be a new value of mainyp &dA treset [T] c14 = 1 c15 = sv_mainyp + 1 tget [Y,c15] line if line{1} <> "S" dputc Logical error in program stop end c10 = int(line{3..}) /* 0 c11 = int(line{sub..}) /* x co-ordinate of system on page c12 = int(line{sub..}) /* y co-ordinate of system on page line = line{sub..} c13 = c12 - toplim /* amount by which system is moved "up" c12 = toplim line = "S " // chs(c10) // " " // chs(c11) // " " // chs(c12) // line tput [T,c14] ~line loop for c15 = sv_mainyp + 2 to mainyp tget [Y,c15] line ++c14 tput [T,c14] ~line repeat treset [Y] &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS tput [Y,1] X 31 100 3020 ~header1 tput [Y,2] X 31 100 3055 ~header2 tput [Y,3] X 31 1200 3055 ~header3 tput [Y,4] X 31 2120 3020 Page: ~(page + 1) mainyp = 4 sv_mainyp = 4 &dA &dA &d@ Step 3: Load last system into top of Y table. Increment mainyp &dA loop for c10 = 1 to c14 tget [T,c10] line ++mainyp tput [Y,mainyp] ~line repeat &dL &dL &d@ xmskpage code &dL &dL #else &dA &dA &d@ Step 3: Load last system into top of Y table. Increment mainyp &dA loop for mainyp = 1 to c14 tget [T,mainyp] line tput [Y,mainyp] ~line repeat &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif &dA &dA &d@ Step 4: Adjust value of bottom_sq (sq(f11)) &dA bottom_sq -= c13 sys_bottom -= c13 end end &dA &dI@F29 &dI@S30 11. If task is not complete, jump to top of general &dI@ music system loop &dI@ if endflag = 1 goto FINE end goto CHH * &dI@F30 &dI@ IV. End of program &dI@ &dI@S31 Normal exit &dI@ &dI@ FINE: if justflag < 2 if mainyp > 0 perform newpage #if SCORE_PARS perform process_and_transfer (mainyp) #else perform output_page (mainyp) #endif end end if justflag > 1 #if MREPORT #else putc #endif &dA &dA &d@ New code &dA05/28/05&d@ for mid-movement justification &dA t1 = 0 t2 = 1 start_sys = 0 start_look = 1 &dK &d@ dputc First: Look at the complete set of sysbarpar data &dK &d@ putc ========================================================== &dK &dK &d@ loop for i = 1 to syscnt &dK &dK &d@ putc For system ~i : &dK &d@ putc --------------------------------------------- &dK &d@ putc sysbarpar(~i ,1) = ~sysbarpar(i,1) &dK &d@ putc sysbarpar(~i ,2) = ~sysbarpar(i,2) &dK &d@ putc sysbarpar(~i ,3) = ~sysbarpar(i,3) &dK &d@ putc sysbarpar(~i ,4) = ~sysbarpar(i,4) &dK &d@ putc sysbarpar(~i ,5) = ~sysbarpar(i,5) &dK &d@ putc &dK &dK &d@ repeat &dK &dK &d@ putc Done &dK &d@ putc &dK &d@ getc &dK &d@ dputc Second: If sysbarpar(.,5) > sysbarpar(.1), fix it &dA &dA &d@ New code &dA10/15/07&d@ to fix a corner case. I actually think there may &dA &d@ be more to it than this, but this fix is a start. &dA loop for i = 1 to syscnt if sysbarpar(i,5) > sysbarpar(i,1) sysbarpar(i,5) = 0 end repeat &dK &d@ dputc Second: Look at the complete set of sysbarpar data again &dK &d@ putc =============================================================== &dK &dK &d@ loop for i = 1 to syscnt &dK &dK &d@ putc For system ~i : &dK &d@ putc --------------------------------------------- &dK &d@ putc sysbarpar(~i ,1) = ~sysbarpar(i,1) &dK &d@ putc sysbarpar(~i ,2) = ~sysbarpar(i,2) &dK &d@ putc sysbarpar(~i ,3) = ~sysbarpar(i,3) &dK &d@ putc sysbarpar(~i ,4) = ~sysbarpar(i,4) &dK &d@ putc sysbarpar(~i ,5) = ~sysbarpar(i,5) &dK &d@ putc &dK &dK &d@ repeat &dK &dK &d@ putc Done &dK &d@ putc &dK &d@ getc &dK &d@ new_start_look = 1 loop for i = 1 to syscnt &dK &d@ dputc sysbarpar(~i ,1) = ~sysbarpar(i,1) &dK &d@ dputc sysbarpar(~i ,5) = ~sysbarpar(i,5) &dK &d@ putc if sysbarpar(i,5) > 0 ++t1 if start_sys = 0 if sysbarpar(i,5) < sysbarpar(i,1) new_syscnt(t1) = i if new_maxsystems(t1) = 0 new_maxsystems(t1) = i end start_sys = t1 start_look = t2 else if i = syscnt start_sys = t1 start_look = t2 new_syscnt(t1) = syscnt if new_maxsystems(t1) = 0 new_maxsystems(t1) = syscnt end end end &dK &d@ dputc new_syscnt(~t1 ) = ~new_syscnt(t1) &dK &d@ dputc new_maxsystems(~t1 ) = ~new_maxsystems(t1) &dK &d@ dputc start_sys = ~start_sys &dK &d@ dputc start_look = ~start_look t2 = i + 1 end &dK &d@ getc end HERE: repeat if t1 < 2 goto OLD_JUST end section_cnt = t1 putc Execute New Just mspace(mcnt) += deadspace * 100000 j = 1 loop for i = 1 to mcnt if mspace(i) > 100000 k = mspace(i) / 100000 mspace(i) = rem mspace2(i) = rem loop for h = j to i mspace(h) -= k repeat loop for h = i to j + 1 step -1 mspace(h) -= mspace(h-1) repeat j = i + 1 else mspace2(i) = mspace(i) end repeat &dK &d@ putc 1... &dK &d@ loop for i = 1 to mcnt &dK &d@ putc .w6 ~mspace(i) ... &dK &d@ j = i / 10 &dK &d@ if rem = 0 &dK &d@ putc &dK &d@ putc .w6 ~i ... &dK &d@ end &dK &d@ repeat &dK &d@ putc &dK &d@ putc loop for t1 = start_sys to section_cnt &dK &d@ dputc .w6 ~t1 ~section_cnt ~new_syscnt(t1) if no_action = t1 no_action = 0 goto NEXT_JUST end j = 0 k = 0 loop for i = start_look to new_syscnt(t1) j += sysbarpar(i,2) ++k repeat if k > 0 average_extra = j / k else goto REALWORK /* New &dA11/23/07&d@ Another cluge. end if new_syscnt(t1) > new_maxsystems(t1) putc We have inadvertantly overstepped our target size for section ~t1 ++sysbarpar(lastk,3) new_start_look = lastk + 1 start_look = lastk + 1 if old_extra < 2 * average_extra or lastk >= new_syscnt(t1) - 1 putc We must go back to a previous solution for this section. no_action = t1 goto REALWORK &dK &d@ justflag = 1 &dK &d@ goto REALWORK end j = 1000000 k = 0 loop for i = start_look to new_syscnt(t1) if old_sysbarpar(i,2) < j k = i j = old_sysbarpar(i,2) end repeat if j = 1000000 putc No more situations can be found to improve the layout for putc this section. We must use the present configuration. goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK end putc We will try advancing a measure from system ~k justflag = 3 lastk = k sysbarpar(k,3) = old_sysbarpar(k,1) - 1 goto REALWORK end t2 = new_syscnt(t1) t4 = mcnts(t2) + 1 &dK &d@ dputc Statistics for section ~t1 &dK &d@ dputc 1) Last System in section is system ~t2 &dK &d@ dputc 2) Current number of bars on this system is ~sysbarpar(t2,1) &dK &d@ dputc 3) The bar that is supposed to end this system is bar ~sysbarpar(t2,5) &dK &d@ dputc 4) Locations of barlines on this system: &dK &d@ loop for t3 = 1 to sysbarpar(t2,1) &dK &d@ dputc .w4 Bar ~t3 at ~mspace2(t4) units &dK &d@ ++t4 &dK &d@ repeat t3 = sysbarpar(t2,5) + mcnts(t2) t3 = rmarg - mspace2(t3) &dK &d@ sysbarpar(t2,4) = t3 &dK &d@ dputc 5) Potential extra space on line = ~t3 &dK &d@ dputc 6) Actual extra space on line = ~sysbarpar(t2,2) &dK &d@ getc &dA &dA &d@ Step 1: if sysbarpar(t2,2) < 0, then automatically move measure to next system &dA if sysbarpar(t2,2) < 0 putc The current configuration has too many bars on the last line of putc of this section. We must move the final bar forward to the next section. k = t2 putc System ~k is the one affected. We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end putc Currently there are ~sysbarpar(t2,1) bars on the last system in putc section ~t1 , and ~sysbarpar(t2,2) units of extra space on the line. old_extra = sysbarpar(t2,2) &dA &dA &d@ Step 2: if number of bars is currect and distribution is average, then &dA &d@ this section is finished &dA if sysbarpar(t2,1) <= sysbarpar(t2,5) if sysbarpar(t2,2) < average_extra putc It turns out that this is &dAless than&d@ the average for all of the putc systems in this section. In this case, we should not try to putc reconfigure the systems, but should go with the present configuration. goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK end end &dA &dA &d@ Step 3: if number of bars is currect and this section has only one system, them &dA &d@ this section is finished &dA if sysbarpar(t2,1) <= sysbarpar(t2,5) if t1 = 1 j = new_syscnt(t1) else j = new_syscnt(t1) - new_syscnt(t1-1) end if j = 1 putc This section consists of only a single line. We will justify. putc goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK end end &dA &dA &d@ Step 4: Look at option of throwing a measure from the previous system onto &dA &d@ last system of this section. &dA j = 0 loop for t4 = 1 to t2 - 1 j += sysbarpar(t4,1) repeat if j > 0 putc Throwing a measure from the previous system onto the last line putc would add ~mspace(j) units to the line. end &dA &dA &d@ Step 4a: Do if only if the average can be improved &dA if (average_extra > sysbarpar(t2,2)) or (j = 0) putc Currently, the computed average_extra space = ~average_extra , and this putc is greater than the number of extra units ~sysbarpar(t2,2) on the putc last system, so moving forward a measure will not improve the situation. else &dA &dA &d@ Step 4b: Do if only if added space fits &dA if mspace(j) > t3 putc As it turns out, the amount of space ~mspace(j) added to the putc to the last system exceeds the available space ~t3 so putc no forward movement is possible at this time. else &dA &dA &d@ Step 4c: Look backward through systems for the one with the least extra space &dA &d@ (since we are going to be increasing this space) &dA h = mspace(j) j = 1000000 k = 0 g = start_look if new_start_look > g g = new_start_look end &dK &d@ loop for i = start_look to t2 - 1 loop for i = g to t2 - 1 if sysbarpar(i,4) < j a4 = abs(sysbarpar(i,2) - sysbarpar(t2,2)) a5 = abs(sysbarpar(i,4) - sysbarpar(t2,2) + h) if a4 > a5 k = i j = sysbarpar(i,4) end end repeat &dA &dA &d@ Step 4d: Only if j <> 1000000 has a prospect been found &dA if j <> 1000000 putc System ~k is the best system from which to advance a measure. putc We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end end end &dA &dA &d@ Step 5: If there are extra measures on the last system, then move one of these &dA &d@ into the next section. &dA if sysbarpar(t2,1) > sysbarpar(t2,5) t6 = sysbarpar(t2,1) - sysbarpar(t2,5) putc Section ~t1 has ~t6 extra bars in the last line. We need to throw one putc these to the next section. k = t2 putc System ~k is the one affected. We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end &dA &dA &d@ Step 6: Follow normal procedure &dA putc &dENormal procedure being followed&d@ putc Currently there are ~sysbarpar(t2,1) bars on the last system in putc section ~t1 , and ~t3 units of extra space on the line. old_extra = sysbarpar(t2,2) if sysbarpar(t2,2) < average_extra putc It turns out that this is &dAless than&d@ the average for all of the putc systems in this section. In this case, we should not try to putc reconfigure the systems, but should go with the present configuration. goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK end if t1 = 1 j = new_syscnt(t1) else j = new_syscnt(t1) - new_syscnt(t1-1) end if j = 1 putc This section consists of only a single line. We will justify. putc goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK end j = 0 loop for t4 = 1 to t2 - 1 j += sysbarpar(t4,1) repeat putc Throwing a measure from the previous system onto the last line putc would add ~mspace(j) units to the line. if mspace(j) > sysbarpar(syscnt,2) putc Since this is more than we can use, we must go with the present putc configuration for this section. We will justify the current last line. putc goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK else h = mspace(j) j = 1000000 k = 0 g = start_look if new_start_look > g g = new_start_look end &dK &d@ loop for i = start_look to t2 - 1 loop for i = g to t2 - 1 if sysbarpar(i,4) < j a4 = abs(sysbarpar(i,2) - sysbarpar(t2,2)) a5 = abs(sysbarpar(i,4) - sysbarpar(t2,2) + h) if a4 > a5 k = i j = sysbarpar(i,4) end end repeat if j = 1000000 putc No more situations can be found to improve the layout. We must use the putc present configuration for this section. We will justify the current putc last line. goto NEXT_JUST &dK &d@ justflag = 1 &dK &d@ goto REALWORK end putc System ~k is the best system from which to advance a measure. putc We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end NEXT_JUST: if new_maxsystems(t1+1) = 0 new_maxsystems(t1+1) = new_syscnt(t1+1) end repeat justflag = 1 goto REALWORK &dA End of 05/28/05 code for mid-movement justification OLD_JUST: j = 0 loop for i = 1 to syscnt j += sysbarpar(i,2) repeat average_extra = j / syscnt if justflag = 3 and syscnt > maxsystems putc We have inadvertantly overstepped our target size. ++sysbarpar(lastk,3) start_look = lastk + 1 if old_extra < 2 * average_extra or lastk >= syscnt - 1 putc We must go back to a previous solution. &dA &dA &d@ &dA11/20/06&d@ Restore sysbarpar parameters from a solution that worked &dA loop for i = 1 to maxsystems sysbarpar(i,1) = sav_sysbarpar(i,1) sysbarpar(i,2) = sav_sysbarpar(i,2) sysbarpar(i,3) = sav_sysbarpar(i,3) sysbarpar(i,4) = sav_sysbarpar(i,4) sysbarpar(i,5) = sav_sysbarpar(i,5) repeat &dA &d@ End of &dA11/20/06&d@ Addition justflag = 1 goto REALWORK end j = 1000000 k = 0 loop for i = start_look to maxsystems if old_sysbarpar(i,2) < j k = i j = old_sysbarpar(i,2) end repeat if j = 1000000 putc No more situations can be found to improve the layout. We must putc use the present configuration. We will justify the current last line. justflag = 1 goto REALWORK end putc We will try advancing a measure from system ~k justflag = 3 lastk = k sysbarpar(k,3) = old_sysbarpar(k,1) - 1 goto REALWORK end mspace(mcnt) += deadspace * 100000 j = 1 loop for i = 1 to mcnt if mspace(i) > 100000 k = mspace(i) / 100000 mspace(i) = rem loop for h = j to i mspace(h) -= k repeat loop for h = i to j + 1 step -1 mspace(h) -= mspace(h-1) repeat j = i + 1 end repeat #if REPORT2 loop for i = 1 to mcnt putc .w6 ~mspace(i) ... j = i / 10 if rem = 0 putc end repeat putc #endif if justflag = 2 maxsystems = syscnt end putc Currently there are ~sysbarpar(syscnt,1) bars on the last putc system and ~sysbarpar(syscnt,2) units of extra space on the line. old_extra = sysbarpar(syscnt,2) if sysbarpar(syscnt,2) < average_extra putc It turns out that this is &dAless than&d@ the average for all of the putc systems in this piece. In this case, we should not try to putc reconfigure the systems, but should go with the present configuration. justflag = 1 goto REALWORK end &dA &dA &d@ &dA11/20/06&d@ Saving sysbarpar parameters from a solution that worked &dA loop for i = 1 to maxsystems sav_sysbarpar(i,1) = sysbarpar(i,1) sav_sysbarpar(i,2) = sysbarpar(i,2) sav_sysbarpar(i,3) = sysbarpar(i,3) sav_sysbarpar(i,4) = sysbarpar(i,4) sav_sysbarpar(i,5) = sysbarpar(i,5) repeat &dA &d@ End of &dA11/20/06&d@ Addition j = mcnt - sysbarpar(syscnt,1) if j = 0 putc Single line. We will justify. justflag = 1 goto REALWORK end putc Throwing a measure from the previous system onto the last line putc would add ~mspace(j) units to the line. if mspace(j) > sysbarpar(syscnt,2) putc Since this is more than we can use, we must go with the present putc configuration. We will justify the current last line. justflag = 1 goto REALWORK else h = mspace(j) j = 1000000 k = 0 loop for i = start_look to syscnt - 1 if sysbarpar(i,4) < j a4 = abs(sysbarpar(i,2) - sysbarpar(syscnt,2)) a5 = abs(sysbarpar(i,4) - sysbarpar(syscnt,2) + h) if a4 > a5 k = i j = sysbarpar(i,4) end end repeat if j = 1000000 putc No more situations can be found to improve the layout. We must putc use the present configuration. We will justify the current last line. justflag = 1 goto REALWORK end putc System ~k is the best system from which to advance a measure. putc We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 end goto REALWORK end putc Total pages = ~page in ~outlib #if XVERSION &dA &d@ &dA12/17/03&d@ &dA &dA &d@ The program has now completed its task. If formatflag > 0, we &dA &d@ need to store the F-table in the (new or updated) format file. &dA if formatflag > 0 open [1,2] formatfile loop for i = 1 to forp tget [F,i] bigline bigline = trm(bigline) putf [1] ~bigline repeat close [1] end &dA &dA &d@ This code added &dA11/25/03&d@ to store changes in the Save Macro file &dA if macchange = 1 putc putc You have added or made changes to the Macro set. Type "Y" to store putc these changes in the MACFILE getc line line = line // pad(1) if line{1} <> "Y" putc stop end open [9,2] macfile putf [9] ESKPAGE MACRO DEFINITION FILE putf [9] ======================================= loop for a = 1 to 8 if macstrokes(a) > 0 putf [9] F~(a+4) .t5 = .t7 ... loop for b = 1 to macstrokes(a) putf [9] 0x0.x ~macros(a,b) ... if b < macstrokes(a) putf [9] ,... else putf [9] end repeat end repeat close [9] end &dA #endif stop &dA &dA &d@ End of processing music data &dA &dI@F31 &dI@ V. Procedures. &dI@ &dI@ &dAÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dAº º&d@ &dAº P R O C E D U R E S º&d@ &dAº º&d@ &dAÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ &dA &d@ &dA &dA &d@*P&dA 1. setbeam &dA &d@ &dA &dA &d@ &dA &d@ Purpose: Determine the first stem length and slope of &dA &d@ the beam. &dA &dA &d@ Inputs: bcount = number of notes under beam &dA &d@ beamdata(.,1) = x-position of note &dA &d@ beamdata(.,2) = y-position of note &dA &d@ beamcode(.) = beam code &dA &d@ f12 = staff number &dA &dA &d@ beam code = 6 digit number (string) &dA &dA &d@ 0 = no beam &dA &d@ 1 = continue beam &dA &d@ 2 = begin beam &dA &d@ 3 = end beam &dA &d@ 4 = forward hook &dA &d@ 5 = backward hook &dA &d@ 6 = repeater &dA &d@ 7 = begin repeated beam &dA &d@ 8 = end repeated beam &dA &dA &d@ 100000's digit = eighth level beams &dA &d@ 10000's digit = 16th level beams &dA &d@ 1000's digit = 32nd level beams &dA &d@ 100's digit = 64th level beams &dA &d@ 10's digit = 128th level beams &dA &d@ 1's digit = 256th level beams &dA &dA &dA &d@ @k = stem direction for first note under beam, plus possible modification &dA &d@ to first stem length. (New &dA05/14/03&d@) &dA &dA &d@ If @k < 100, no modifications present &dA &d@ If 100 < @k < 10000, @k = @k / 100. Lengthen stem length (up or down) &dA &d@ by @k/10 interline distance (vpar(2)) &dA &d@ If @k > 10000, @k = @k / 10000. Shorten stem length (up or down) &dA &d@ by @k/10 interline distance (vpar(2)) &dA &dA &dA &d@ @m = stem direction flags for notes under beam (or 0 or 1 = all same as @k) &dA &d@ beamfont = font for printing beam &dA &d@ stemchar = character number for stem &dA &d@ beamh = height parameter for beams &dA &d@ beamt = vertical space between beams (normally vpar(.,32)) &dA &dA &d@ Outputs: @k = length of first stem (positive = stem up) &dA &d@ @m = slope of beam &dA &dA &d@ Internal variables: @b = y-intercept of beam &dA &d@ @f = temporary variable &dA &d@ @g = temporary variable (related to @@g) &dA &d@ @h = temporary variable &dA &d@ @i = temporary variable &dA &d@ @j = temporary counter &dA &d@ @k = |@m| &dA &d@ @n = temporary variable &dA &d@ @q = temporary counter &dA &d@ @s = temporary variable &dA &d@ @t = temporary variable &dA &d@ @u = temporary variable &dA &d@ @@b = vertical range of note set &dA &d@ @@g = top of staff line &dA &d@ @@n = temporary variable &dA &d@ @@q = temporary variable &dA &d@ (x1,y1) = temporary coordinates &dA &d@ (x2,y2) = temporary coordinates &dA &d@ xbeam(6) = temporary flags concerning whether a secondary &dA &d@ beam is above or below the "backbone" &dA &d@ bstem(.,2) = stem flags for notes under a beam &dA &d@ 1 = stem direction &dA &d@ 2 = mimumum stem length to top of "backbone" &dA &d@ beam &dA &d@ max_pslope = maximum positive slope, based on length New &dA04/23/03 &dA &d@ max_nslope = maximum negative slope, based on length &dA &dA procedure setbeam int t1,t2,t3 int @b,@f,@g,@h,@i,@j,@n,@p,@q,@r,@s,@t,@u int @@b,@@g,@@n,@@q,@@t int old@k int m1,m2,tm,fm,sum,minsum,leng,minleng int xminsum,ffm int xbeam(6) int max_pslope,max_nslope int stem_mod t1 = beamdata(bcount,1) - beamdata(1,1) /* New code &dA04/23/03&d@ max_pslope = vpar(f12,3) * hxpar(1) / t1 + 1 max_nslope = 0 - max_pslope stem = @k & 0x01 /* New code &dA05/14/03&d@ stem_mod = @k / INT100 if stem_mod > 0 if stem_mod >= INT100 stem_mod /= INT100 stem_mod = stem_mod * vpar(f12,2) + 5 / 10 stem_mod = 0 - stem_mod else stem_mod = stem_mod * vpar(f12,2) + 5 / 10 end end &dA &dA &d@ Deal with situation where stems go up and down &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if @m > 1 &dA &dA &d@ Get stem directions &dA loop for @j = bcount - 1 to 0 step -1 @g = bit(@j,@m) if stem = 0 ++@g @g &= 0x01 end bstem(bcount - @j,1) = @g repeat &dA &dA &d@ Determine number of "backbone" beams &dA @b = 7 loop for @j = 1 to bcount if beamcode(@j) con "0" if mpt < @b @b = mpt end end repeat --@b /* @b = number of "backbone" beams &dA &dA &d@ Determine "thickness" of backbone &dA @t = 0 if @b > 1 if @b < 4 @t = @b - 1 * vpar(f12,32) else @t = @b - 1 * vpar(f12,33) end end @@t = @t + vpar(f12,31) /* @@t = thickness of backbone (for mixed stems) @t += vpar(f12,31) >> 1 /* @t = thickness of backbone &dA &dA &d@ Determine minimum length of stem (to top of backbone) &dA loop for @j = 1 to 6 if @j <= @b xbeam(@j) = 1 else xbeam(@j) = 0 end repeat @@b = @b @q = 0 @p = 0 loop for @j = 1 to bcount PT1: if @b < 6 if beamcode(@j){@b+1} = "2" or beamcode(@j){@b+1} = "7" ++@b if bstem(@j,1) = DOWN ++@p xbeam(@b) = 2 else ++@q xbeam(@b) = 3 end goto PT1 end if "456" con beamcode(@j){@b+1} ++@b if bstem(@j,1) = DOWN ++@p xbeam(@b) = 4 else ++@q xbeam(@b) = 5 end goto PT1 end end &dA &dA &d@ compute minimum "free" length &dA if @b < 4 bstem(@j,2) = vpar(f12,10 - @b) / 2 else bstem(@j,2) = vpar(f12,3) end &dA &dA &d@ add length running thought extra beams &dA if bstem(@j,1) = DOWN bstem(@j,2) += @p * vpar(f12,32) else bstem(@j,2) += @q * vpar(f12,32) bstem(@j,2) += vpar(f12,31) >> 1 + @t end #if REPORT putc ~@j ~bstem(@j,1) ~bstem(@j,2) #endif PT2: if xbeam(@b) = 4 xbeam(@b) = 0 --@b --@p goto PT2 end if xbeam(@b) = 5 xbeam(@b) = 0 --@b --@q goto PT2 end PT3: if @b > @@b if beamcode(@j){@b} = "3" or beamcode(@j){@b} = "8" if xbeam(@b) = 2 --@b --@p goto PT3 end if xbeam(@b) = 3 --@b --@q goto PT3 end end end repeat PT4: &dA &dA &d@ Determine number of staves involved &dA @j = 0 if f(f12,12) = 2 @g = beamdata(1,2) loop for @j = 2 to bcount if abs(beamdata(@j,2) - @g) > 500 @j = 10000 end repeat end if @j = 10000 &dA &dA &d@ Case 1: notes span two staves (grand staff) &dA @h = vst(f12) - 1000 /* correction to bottom staff y-coordinage @@g = 0 loop for @j = 1 to bcount if beamdata(@j,2) > 700 if bstem(@j,1) = DOWN if @@g = 0 or @@g = 2 @@g = 2 /* mixed stems on bottom staff else @@g = 3 end end else if bstem(@j,1) = UP if @@g = 0 or @@g = 1 @@g = 1 /* mixed stems on top staff else @@g = 3 end end end repeat if @@g = 0 goto TWO_STAFF_NORMAL end if @@g = 3 putc Mixed stem directions on two separate staves. This case is putc almost always impossible to draw and is therefore not handled putc by this program! putc putc &dAProgram Halted&d@ putc stop end putc &dAAbnormal case&d@ putc Mixed stem directions on a single staff for a beam with notes putc two staves. In this case, we will try to set a horizontal beam. &dA &d@ &dA &d@ Find "level" for backbone &dA @s = 100000 @u = -100000 loop for @j = 1 to bcount if @@g = 2 /* mixed on bottom staff if beamdata(@j,2) > 700 if bstem(@j,1) = DOWN if beamdata(@j,2) > @u @u = beamdata(@j,2) end else if beamdata(@j,2) < @s @s = beamdata(@j,2) end end end else /* mixed on top staff if beamdata(@j,2) < 700 if bstem(@j,1) = DOWN if beamdata(@j,2) > @u @u = beamdata(@j,2) end else if beamdata(@j,2) < @s @s = beamdata(@j,2) end end end end if beamdata(@j,2) > 700 beamdata(@j,2) = beamdata(@j,2) + @h end repeat if @@g = 2 @s = @s + @h @u = @u + @h end &dA &dA &d@ @s = "highest" note below the beam (stem up) &dA &d@ @u = "lowest" note above the beam (stem down) &dA @n = @u / vpar(f12,2) @n = rem @h = vpar(f12,31) >> 1 @i = vpar(f12,31) - vpar(f12,41) if @b = 1 @j = @s - @u if @j < vpar(f12,6) putc Notes on the staff with mixed stem directions are not sufficiently putc far apart to set a horizontal beam. putc putc &dAProgram Halted&d@ putc stop end if @j = vpar(f12,6) if @n = 0 @u += vpar(f12,2) + @i else @u += vpar(f12,3) + @h end else if @j = vpar(f12,7) if @n = 0 @u += vpar(f12,4) else @u += vpar(f12,3) + @i end else if @j = vpar(f12,8) and @n <> 0 @u += vpar(f12,5) else @j = @s - @u - @@t @u += @j >> 1 @u -= vpar(f12,2) + 3 >> 2 if @@g = 2 @u -= vst(f12) end @u = @u + vpar(f12,8) / vpar(f12,2) * vpar(f12,2) - vpar(f12,6) if @@g = 2 @u += vst(f12) end @u += @h end end end else if @b = 2 @j = @s - @u if @j < vpar(f12,7) putc Notes on the staff with mixed stem directions are not sufficiently putc far apart to set a horizontal beam. putc putc &dAProgram Halted&d@ putc stop end if @j = vpar(f12,7) if @n = 0 @u += vpar(f12,2) + @i else @u += vpar(f12,3) + @h end else if @j = vpar(f12,8) if @n = 0 @u += vpar(f12,2) + @i else @u += vpar(f12,3) + @i end else if @j = vpar(f12,9) and @n <> 0 @u += vpar(f12,3) + @i else @j = @s - @u - @@t @u += @j >> 1 @u -= vpar(f12,2) + 3 >> 2 if @@g = 2 @u -= vst(f12) end @u = @u + vpar(f12,8) / vpar(f12,2) * vpar(f12,2) - vpar(f12,6) if @@g = 2 @u += vst(f12) end @u += @h - vpar(f12,41) end end end @u += vpar(f12,32) else @j = @s - @u - @@t if @j < vpar(f12,4) putc Notes on the staff with mixed stem directions are not sufficiently putc far apart to set a horizontal beam. putc putc &dAProgram Halted&d@ putc stop end @u += @j >> 1 @u -= vpar(f12,1) if @@g = 2 @u -= vst(f12) end @u = @u + vpar(f12,8) / vpar(f12,2) * vpar(f12,2) - vpar(f12,6) if @@g = 2 @u += vst(f12) end @u += @@t - vpar(f12,41) end end leng = beamdata(1,2) - @u if leng > 0 leng += @@t - vpar(f12,41) end @k = leng if stem_mod <> 0 /* New code &dA05/14/03&d@ if @k > 0 @k += stem_mod else @k -= stem_mod end end @m = 0 #if REPORT putc ~@k ~@m #endif return TWO_STAFF_NORMAL: loop for @j = 1 to bcount if beamdata(@j,2) > 700 beamdata(@j,2) = beamdata(@j,2) + @h end repeat &dA &dA &d@ I am going to try a different technique for setting mixed beams. &dA &d@ They don't happen very often, so I am going to try "brute force", &dA &d@ which will take longer, but should yield more accurate results. &dA &d@ Basically, I will test every slope from -8 to +8 and all legal &dA &d@ levels. &dA &dA &d@ 1. Determine "highest" pivot point &dA @@g = -10000 loop for @j = 1 to bcount if beamdata(@j,2) > @@g and bstem(@j,1) = DOWN @@g = beamdata(@j,2) @g = @j end repeat @@g += bstem(@g,2) xminsum = 1000000000 @h = 10000 &dA &dA &d@ 2. For each "vertical" position, try all slopes; find the "best" one &dA ffm = LIM1 /* &dA04/23/03&d@ moved this line north of lable NEXT_VERT_POS: fm = LIM1 minsum = LIM1 &dA &d@ loop for tm = -8 to 8 t1 = max_nslope + 1 t2 = max_pslope - 1 if t1 < -4 t1 = -4 end if t2 > 4 t2 = 4 end if bstem(1,1) = bstem(bcount,1) t1 = 0 t2 = 0 end if t1 > t2 t1 = t2 end loop for tm = t1 to t2 /* limiting verticle travel &dA04/23/03 sum = 0 loop for @j = 1 to bcount leng = beamdata(@j,1) - beamdata(@g,1) * tm / hxpar(1) + @@g - beamdata(@j,2) leng = abs(leng) if leng < bstem(@j,2) @j = 10000 else if bstem(@j,1) = DOWN /* For down stems we are interested leng -= @t /* only in length to top of backbone end if @j = 1 or @j = bcount /* emphasize end points sum += leng * leng * 6 else sum += leng * leng end end repeat @r = bcount - 1 * tm sum = abs(@r) * abs(@r) * abs(tm) / 96 + 120 * sum sum /= 1600 #if REPORT putc slope = ~tm sum = ~sum #endif if sum < minsum and @j < 10000 fm = tm minsum = sum end repeat if minsum = LIM1 if ffm = LIM1 loop for @j = 1 to bcount bstem(@j,2) -= vpar(f12,1) if bstem(@j,2) < vpar(f12,2) putc Unable to find a slope to mixed stem beam putc Try setting more distance between staves of the grand staff examine stop end repeat goto PT4 else goto PARS_FOUND end end &dA &dA &d@ 3. Now evaluate the control function for the lengths in this "vertical" position &dA if minsum < xminsum xminsum = minsum @h = @@g ffm = fm end ++@@g goto NEXT_VERT_POS &dA &dA &d@ 4. Check to see of vertical position has been found &dA PARS_FOUND: if @h = 10000 putc Program error in finding position of beam with mixed stems examine stop end fm = ffm leng = beamdata(1,1) - beamdata(@g,1) * fm / hxpar(1) + @h - beamdata(1,2) if bstem(1,1) = DOWN leng += @t end leng = 0 - leng &dA &dA &d@ END OF New METHOD &dA @k = leng if stem_mod <> 0 /* New code &dA05/14/03&d@ if @k > 0 @k += stem_mod else @k -= stem_mod end end @m = fm #if REPORT putc ~@k ~@m #endif return else &dA &dA &d@ Case 2: notes are on one stave &dA if beamdata(1,2) > 700 loop for @j = 1 to bcount beamdata(@j,2) -= 1000 repeat end &dA &dA &d@ Check to see if "up-down" distribution of notes allows beam to be drawn &dA putc Beam with &dAmixed stem directions&d@ on a single staff. &dA &dA &d@ I am going to try including the situations: 1-up/many-down and &dA &d@ many-up/1-down in the case. &dA start_beam(1) = 100000 if bcount = 2 start_beam(1) = beamdata(1,1) start_beam(2) = beamdata(1,2) stop_beam(1) = beamdata(2,1) stop_beam(2) = beamdata(2,2) else if bstem(1,1) = DOWN t1 = 0 t2 = 0 t3 = 0 loop for @j = 2 to bcount if bstem(@j,1) = DOWN t2 = 1 if t1 = 1 t1 = 2 end else t1 += t2 if t1 = 0 t1 = 1 end end t3 += abs(beamdata(@j,2) - beamdata(@j-1,2)) repeat if t1 < 2 /* down-up-up... or ...down-down-up if t3 = vpar(f12,7) goto DUAL_MIXED_FLAT end goto NOT_DUAL_MIXED end end if bstem(1,1) = UP t1 = 0 t2 = 0 t3 = 0 loop for @j = 2 to bcount if bstem(@j,1) = UP t2 = 1 if t1 = 1 t1 = 2 end else t1 += t2 if t1 = 0 t1 = 1 end end t3 += abs(beamdata(@j,2) - beamdata(@j-1,2)) repeat if t1 < 2 /* up-down-down... or ...up-up-down if t3 = vpar(f12,7) goto DUAL_MIXED_FLAT end goto NOT_DUAL_MIXED end end goto DUAL_MIXED_FLAT NOT_DUAL_MIXED: start_beam(1) = beamdata(1,1) start_beam(2) = beamdata(1,2) stop_beam(1) = beamdata(bcount,1) stop_beam(2) = beamdata(bcount,2) end if start_beam(1) <> 100000 &dA &d@ examine if stem = UP if start_beam(2) < stop_beam(2) + vpar(f12,2) putc Unable to typeset this particular beam putc examine stop end else if start_beam(2) > stop_beam(2) - vpar(f12,2) putc Unable to typeset this particular beam putc examine stop end end @j = abs(start_beam(2) - stop_beam(2)) / vpar(f12,1) @h = @b - 1 << 1 if @b < 3 if stem = UP if @j + @h > 11 /* 9 goto DUAL_MIXED_FLAT end else if @j + @h > 13 /* 13 goto DUAL_MIXED_FLAT end end else if @j + @h > 14 /* 14 goto DUAL_MIXED_FLAT end end @n = stop_beam(1) - start_beam(1) if stem = UP @n -= hpar(f12,8) else @n += hpar(f12,8) end @s = vpar(f12,4) * 30 / @n if @s < 16 and @j + @h < 14 /* changing 15 to 16 &dA &d@ if @s < max_pslope and @j + @h < 14 /* NOT changed &dA04/23/03 @j += 2 @m = @s else @s = vpar(f12,2) * 30 / @n if @s < 20 @u = @s + 1 * @n / 30 if @b < 3 if @u <= vpar(f12,2) * 12 / 11 ++@s end else if @u <= vpar(f12,3) ++@s end end if @s > 15 @s = 15 end &dA &d@ if @s > max_pslope /* NOT changed &dA04/23/03 &dA &d@ @s = max_pslope &dA &d@ end @m = @s else goto DUAL_MIXED_FLAT end end @n = start_beam(2) / vpar(f12,2) @n = rem @p = vpar(f12,31) >> 1 @q = vpar(f12,31) - vpar(f12,41) if @b = 1 if @n <> 0 if @j < 4 @k = vpar(f12,3) else if @j < 6 @k = vpar(f12,3) + @p else if @j < 8 @k = vpar(f12,4) @m >>= 1 else if @j < 10 @k = vpar(f12,5) + @p else @k = vpar(f12,6) @m >>= 1 end end end end else if @j < 4 @k = vpar(f12,3) else if @j < 6 @m >>= 1 @k = vpar(f12,3) else if @j < 8 @k = vpar(f12,4) + @p else if @j < 10 @k = vpar(f12,5) @m >>= 1 else @k = vpar(f12,6) + @p end end end end end else if @b = 2 if @n <> 0 if @j < 4 @k = vpar(f12,3) + @p else if @j < 5 @k = vpar(f12,3) + @p + vpar(f12,41) @m >>= 1 else if @j < 6 @k = vpar(f12,5) else if @j < 8 @k = vpar(f12,5) + vpar(f12,41) else @k = vpar(f12,5) + @p @m = @m + 1 / 3 end end end end else if @j < 4 @k = vpar(f12,4) else if @j < 6 @k = vpar(f12,4) + @p else if @j < 8 @k = vpar(f12,4) + @p @m = @m + 1 / 3 else if @j < 10 @k = vpar(f12,6) + @p else @k = vpar(f12,6) + @p @m >>= 1 end end end end end else if @b = 3 if @n <> 0 if @j < 5 @k = vpar(f12,5) else if @j < 6 @k = vpar(f12,5) + @p else if @j < 7 @k = vpar(f12,6) else @k = vpar(f12,7) end end end else if @j < 5 @k = vpar(f12,5) else if @j < 6 @k = vpar(f12,5) + @p else if @j < 8 @k = vpar(f12,6) else @k = vpar(f12,6) + @p end end end end else @k = vpar(f12,7) end end end if stem = DOWN @m = 0 - @m @k = 0 - @k end if stem_mod <> 0 /* New code &dA05/14/03&d@ if @k > 0 @k += stem_mod else @k -= stem_mod end end return end DUAL_MIXED_FLAT: putc There are ~bcount notes on the beam; attempting to set a horizontal beam. &dA &dA &d@ Find "level" for backbone &dA @s = 100000 @u = -100000 loop for @j = 1 to bcount if bstem(@j,1) = DOWN if beamdata(@j,2) > @u @u = beamdata(@j,2) end else if beamdata(@j,2) < @s @s = beamdata(@j,2) end end repeat &dA &dA &d@ @s = "highest" note below the beam (stem up) &dA &d@ @u = "lowest" note above the beam (stem down) &dA @n = @u / vpar(f12,2) @n = rem @h = vpar(f12,31) >> 1 @i = vpar(f12,31) - vpar(f12,41) if @b = 1 @j = @s - @u if @j < vpar(f12,6) putc Stem up notes are not sufficiently higher that stem down notes putc to allow space for a horizontal beam. putc putc &dAProgram Halted&d@ putc stop end if @j = vpar(f12,6) if @n = 0 @u += vpar(f12,2) + @i else @u += vpar(f12,3) + @h end else if @j = vpar(f12,7) if @n = 0 @u += vpar(f12,4) else @u += vpar(f12,3) + @i end else if @j = vpar(f12,8) and @n <> 0 @u += vpar(f12,5) else @j = @s - @u - @@t @u += @j >> 1 @u -= vpar(f12,2) + 3 >> 2 @u = @u + vpar(f12,8) / vpar(f12,2) * vpar(f12,2) - vpar(f12,6) @u += @h end end end else if @b = 2 @j = @s - @u if @j < vpar(f12,7) putc Stem up notes are not sufficiently higher that stem down notes putc to allow space for a horizontal beam. putc putc &dAProgram Halted&d@ putc stop end if @j = vpar(f12,7) if @n = 0 @u += vpar(f12,2) + @i else @u += vpar(f12,3) + @h end else if @j = vpar(f12,8) if @n = 0 @u += vpar(f12,2) + @i else @u += vpar(f12,3) + @i end else if @j = vpar(f12,9) and @n <> 0 @u += vpar(f12,3) + @i else @j = @s - @u - @@t @u += @j >> 1 @u -= vpar(f12,2) + 3 >> 2 @u = @u + vpar(f12,8) / vpar(f12,2) * vpar(f12,2) - vpar(f12,6) @u += @h - vpar(f12,41) end end end @u += vpar(f12,32) else @j = @s - @u - @@t if @j < vpar(f12,4) putc Stem up notes are not sufficiently higher that stem down notes putc to allow space for a horizontal beam. putc putc &dAProgram Halted&d@ putc stop end @u += @j >> 1 @u -= vpar(f12,1) @u = @u + vpar(f12,8) / vpar(f12,2) * vpar(f12,2) - vpar(f12,6) @u += @@t - vpar(f12,41) end end leng = beamdata(1,2) - @u if leng > 0 leng += @@t - vpar(f12,41) end @k = leng if stem_mod <> 0 /* New code &dA05/14/03&d@ if @k > 0 @k += stem_mod else @k -= stem_mod end end @m = 0 #if REPORT putc ~@k ~@m #endif return end end &dA &dA &d@ End of situation where stems go up and down &dA &dA &dA &d@ Check for situation where notes span two staves (grand staff) &dA if f(f12,12) = 2 @g = beamdata(1,2) loop for @j = 2 to bcount if abs(beamdata(@j,2) - @g) > 500 @j = 10000 end repeat &dA &dA &d@ If @j = 10000 and stem = 0 (up), then beam will be relative to top staff &dA &d@ if stem = 1 (down), then beam will be relative to bottom staff &dA &dA &d@ Otherwise, beam will be relative to staff that notes are on &dA if @j = 10000 if stem = 0 /* make no adjustments loop for @j = 1 to bcount if beamdata(@j,2) > 700 beamdata(@j,2) -= 1000 beamdata(@j,2) += vst(f12) end repeat else loop for @j = 1 to bcount if beamdata(@j,2) < 700 beamdata(@j,2) -= vst(f12) else beamdata(@j,2) -= 1000 end repeat end else if beamdata(1,2) > 700 loop for @j = 1 to bcount beamdata(@j,2) -= 1000 repeat end end end &dA &dA &d@ Reverse if stem down &dA @g = 0 if stem = 1 @g = vpar(f12,2) * 500 - vpar(f12,8) loop for @j = 1 to bcount beamdata(@j,2) = vpar(f12,2) * 500 - beamdata(@j,2) repeat end @@g = @g * determine slope and pivot of beam @q = 0 x1 = 50000 y1 = 50000 @t = 6 @b = 0 @h = 0 /* changes in absolute height @f = 0 @i = beamdata(1,2) &dA &dA &d@ identify: @q = 6 - smallest note type under beam &dA &d@ (x1,y1) = position of note closest to beam &dA &d@ (x2,y2) = position of note next closest to beam &dA &d@ @b = y coordinate of note furthest from beam &dA loop for @j = 1 to bcount * also compute sum of absolute changes in vertical height @n = @i - beamdata(@j,2) testfor @n < 0 if @f = 0 @f = -1 end if @f = 1 @f = 2 end @n = 0 - @n else (>) if @f = 0 @f = 1 end if @f = -1 @f = 2 end end @i = beamdata(@j,2) @h += @n * @n = 5 if beamcode(@j) con "0" @n = mpt - 2 /* number of additional beams on this note end if @n > @q @q = @n /* max number of additional beams end if @n < @t @t = @n /* min number of additional beams end @n = beamdata(@j,2) if @n > @b @b = @n /* lowest y co-ord of notes in beam set end if @n < y1 y2 = y1 x2 = x1 y1 = @n /* nearest y co-ord x1 = beamdata(@j,1) else if @n < y2 y2 = @n x2 = beamdata(@j,1) end end repeat &dA &dA &d@ Check point one: (x1,y1); (x2,y2); @b set &dA @@b = @b - y1 &dA &dA &d@ Formula for initial stem length &dA &dA &d@ note @q y1-@n &dA &d@ ÄÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄÄ &dA &d@ 8th: 0 beamh &dA &d@ 16th: 1 beamh + (1 * notesize / 4) &dA &d@ 32th: 2 beamh + (4 * notesize / 4) &dA &d@ 64th: 3 beamh + (7 * notesize / 4) &dA &d@ 128th: 4 beamh + (10 * notesize / 4) &dA &d@ 256th: 5 beamh + (13 * notesize / 4) &dA if @q = 0 @n = y1 - beamh else @n = @q * 3 - 2 @n = 0 - notesize * @n / 4 - beamh + y1 end @b = x1 * deal with case of severe up-down pattern if @f = 2 @h /= bcount if @h > vpar(f12,18) @m = 0 goto SB1 end end * @m = y1 - y2 * 2 * hxpar(1) @k = x1 - x2 @m /= @k &dA &dA &d@ Comment: @m is (2*hxpar(1)) times slope between two notes &dA &d@ nearest the beam &dA @k = beamdata(bcount,2) - beamdata(1,2) * 2 * hxpar(1) @j = beamdata(bcount,1) - beamdata(1,1) if @j < vpar(f12,5) @j = vpar(f12,5) end @k /= @j &dA &dA &d@ Comment: @k is (2*hxpar(1)) times slope between outside notes &dA &dA &d@ Formula: slope = (@m + @k) / 6 provided &dA &dA &d@ |@m| must be equal to or less than |@k| &dA @j = abs(@m) - abs(@k) if @j > 0 if @m > 0 @m -= @j else @m += @j end end * @m = @m + @k / 6 @j = abs(@m) - max_pslope /* code added &dA04/23/03&d@ if @j > 0 if @m > 0 @m -= @j else @m += @j end end SB1: @k = abs(@m) if @k > vpar(f12,19) @k = vpar(f12,19) end * Soften slant for thirty-seconds and smaller if @q > 2 and @k > 5 @k = 0 - @q / 2 + @k end if @k < 0 @k = 0 end &dA &dA &d@ set reduce slant if end note are closer than vpar(f12,6) &dA @h = beamdata(bcount,1) - beamdata(1,1) if @h <= vpar(f12,6) and @k > vpar(f12,35) @k = vpar(f12,35) end &dA &dA &d@ shorten shortest stem, if gradual slope and large vertical range &dA &d@ and relatively high note &dA &dA &d@ @h = bcount + 1 &dA &d@ if @h > 5 &dA &d@ @h = 5 &dA &d@ end @h = 3 if @@b > vpar(f12,@h) @h = @q * beamt + @n - @@g @h = 0 - @h if @h > vpar(f12,3) if @k < 6 if x1 > beamdata(1,1) and x1 < beamdata(bcount,1) @n += vpar(f12,17) end if bcount = 2 @n += vpar(f12,17) end end end end * if @m < 0 @m = 0 - @k else @m = @k end &dA &dA &d@ @m = hxpar(1) * slope of beam &dA &d@ @n = y coordinate of pivot point (on highest note) of first beam &dA &d@ @k = absolute value of @m &dA &d@ @g = y coordinate of top of staff line &dA &d@ (x1,y1) = coordinate of note closest to beam (highest note) &dA &d@ (x2,y2) = coordinate of second closest note to beam (2nd highest note) &dA &d@ @q = 6 - smallest note type number (number of beams - 1) &dA &d@ @t = 6 - largest note type number &dA @@n = @n ++@q @@q = @q &dA &dA &d@ Check point two: @q = number of beams, current slope = @m &dA &dA &d@ Adjust @m and @n so that beams will fall properly on staff lines &dA &dA &d@ Case I: @m = 0 &dA CSI: if @m = 0 @f = @q - 1 * notesize + @n if @f >= @g &dA &dA &d@ Adjust flat beam height &dA @i = @f - @g / notesize if @q = 1 and rem <= vpar(f12,20) rem += vpar(f12,20) end if @q = 2 if rem <= vpar(f12,20) rem += vpar(f12,34) else rem = rem - notesize + vpar(f12,20) end end if @q = 3 rem += vpar(f12,34) end if @q = 4 if @i = 3 beamt = vpar(f12,33) end if @i < 3 @i = rem @i -= vpar(f12,1) / 2 rem = @i end end @n -= rem * (*) extremely low notes if @q = 1 @f = vpar(f12,4) + @@g else @f = 4 - @q * vpar(f12,2) + @@g end if @n > @f @n = @f if @q > 3 and stemchar = 59 beamt = vpar(f12,33) end end end else &dA &dA &d@ Case II: @m <> 0 &dA old@k = @k CSII: @j = beamdata(1,1) - x1 * @m / hxpar(1) + @n @i = beamdata(bcount,1) - beamdata(1,1) * @m / hxpar(1) + @j @f = @i + @j / 2 if @q > 1 if @t > 0 @f += beamt if @q = 2 @f += 2 end end @s = vpar(f12,22) else @s = vpar(f12,23) end &dA &d@ @j = starting point of top beam &dA &d@ @i = stopping point of top beam &dA &d@ @f = average height of beam (second beam if always 2 or more) &dA &d@ @s = fudge factor @g = @@g @h = @g @g -= notesize if @q > 2 @g -= notesize end if @f > @g &dA &dA &d@ Adjust slanted beam height &dA if @q > 2 if @f > @h beamt = vpar(f12,33) else @f -= 2 end end @h = abs(@i - @j) @i = @f - @g / notesize @i = rem &dA &d@ @h = rise/fall of beam &dA &d@ @i = amount by which the average beam height lies below a line if @h < vpar(f12,24) if @i >= @s @i -= notesize if @q = 1 ++@i end else if @q = 1 --@i end end @n -= @i goto CV end if @h < beamt and old@k <> 10000 if @k > 1 goto CSJJ end ++@k if @k = old@k old@k = 10000 /* to prevent looping end if @m < 0 @m = 0 - @k else @m = @k end goto CSII end if @h < vpar(f12,25) @i += vpar(f12,1) if @i > @s @i -= notesize end @n -= @i goto CV end if @h > vpar(f12,26) if @i > @s @i -= notesize end @n -= @i goto CV end if @k = 2 @i += vpar(f12,1) if @i > @s @i -= notesize end @n -= @i goto CV end CSJJ: --@k if @k = old@k old@k = 10000 /* to prevent looping end if @m < 0 @m = 0 - @k else @m = @k end goto CSII else if @q < 4 @n = notesize / 3 + @n end end * Check for extra low notes CV: @h = beamdata(1,1) - x1 * @m / hxpar(1) + @n @j = beamdata(bcount,1) - x1 * @m / hxpar(1) + @n @i = 0 if @q = 1 @f = vpar(f12,4) + @@g - 2 else @f = 4 - @q * notesize + @@g - 2 end if @m > 0 if @h > @f @i = 1 @h = @f + 1 end else if @j > @f @i = 1 @j = @f + 1 end end @f = @f + vpar(f12,20) + 2 if @m > 0 if @j > @f @i = 1 @j = @f end else if @h > @f @i = 1 @h = @f end end if @i = 1 * Correction necessary @k = beamdata(bcount,1) - beamdata(1,1) @m = @j - @h * hxpar(1) / @k @n = x1 - beamdata(1,1) * @m / hxpar(1) + @h @k = abs(@m) end &dA &dA &d@ Deal with special case of two note beam &dA &dA &d@ compute sum of stem lengths and increase if too short &dA &d@ if bcount = 2 &dA &d@ @f = @q - 1 * beamt + y1 - @n + y2 - @n - @h &dA &d@ if @f < vpar(f12,27) &dA &d@ @n -= vpar(f12,28) &dA &d@ end &dA &d@ end &dA &dA &d@ Adjust so that middle of beam falls on/between staff lines &dA @n = 100 - beamfont / 2 + @n end * CSIII: dv3 = @m * @b dv3 = @n * hxpar(1) - dv3 &dA &dA &d@ Check point three: beam slope = @m; &dA &d@ y intercept (times hxpar(1)) = dv3 &dA &dA &d@ Post adjustment: sometimes the stems of sixteenths are too &dA &d@ short. This will be the case when (y2-@n) - ((@q-1)*beamt) < xxx &dA &d@ where xxx is some number. In this case, we should raise the &dA &d@ beam by some small amount, yyy. &dA --@q @j = 0 - @q * beamt + y2 - @n if @j < vpar(f12,29) dv3 -= vpar(f12,30) * hxpar(1) end &dA &dA &d@ In the case where bcount = 4, compare sum of the first two notes &dA &d@ verses the last two notes. If the direction is different from &dA &d@ the slope, then the slope should be zero. &dA if bcount = 4 @f = beamdata(1,2) + beamdata(2,2) @g = beamdata(3,2) + beamdata(4,2) if @f > @g if @m > 0 goto SB2 end end @f = @f - @g * @m if @f > 0 goto SB2 end goto SB3 SB2: @m = 0 @q = @@q @g = @@g @n = @@n goto CSI end SB3: &dA &dA &d@ @m = hxpar(1) * slope of beam &dA &d@ dv3 = y-intercept of top of beam (times hxpar(1)) &dA y1 = @m * beamdata(1,1) + dv3 / hxpar(1) y2 = beamdata(1,2) @k = abs(y2 - y1) &dA &dA &d@ Now check for beam with excessive "vertical" travel &dA04/23/03&d@ &dA if @m > max_pslope or @m < max_nslope if @m > max_pslope t2 = 10000 t3 = 10000 loop for t1 = 1 to bcount y1 = @m * beamdata(t1,1) + dv3 / hxpar(1) y2 = beamdata(t1,2) @k = abs(y2 - y1) /* stem length if @k < t2 t2 = @k t3 = t1 end repeat y1 = @m * beamdata(t3,1) + dv3 /* pivit on this point @m = max_pslope /* new slope dv3 = y1 - (@m * beamdata(t3,1)) end if @m < max_nslope t2 = 10000 t3 = 10000 loop for t1 = 1 to bcount y1 = @m * beamdata(t1,1) + dv3 / hxpar(1) y2 = beamdata(t1,2) @k = abs(y2 - y1) /* stem length if @k < t2 t2 = @k t3 = t1 end repeat y1 = @m * beamdata(t3,1) + dv3 /* pivit on this point @m = max_nslope /* new slope dv3 = y1 - (@m * beamdata(t3,1)) end y1 = @m * beamdata(1,1) + dv3 / hxpar(1) y2 = beamdata(1,2) @k = abs(y2 - y1) end &dA &dA &d@ End of code added &dA04/23/03&d@ &dA if stem = 1 @m = 0 - @m /* reverse slope if stem down @k = 0 - @k end if stem_mod <> 0 /* New code &dA05/14/03&d@ if @k > 0 @k += stem_mod else @k -= stem_mod end end return &dA &d@ &dA &dA &d@*P&dA 2. newpage &dA &d@ &dA &dA &d@ &dA &d@ Purpose: Increment page number; construct outfile string &dA &dA &d@ Input: page = old page number &dA procedure newpage page = page + 1 if page < 10 outfile = outlib // "/0" // chs(page) else outfile = outlib // "/" // chs(page) end return &dA &d@ &dA &dA &d@*P&dA 12a. clefkeyspace &dA &d@ &dA &dA &d@ &dA &d@ Purpose: Compute space for new clef and key &dA &dA &d@ Operation: Create entry for global double bar, if f5 is set. &dA &dA &d@ Inputs: Staff locations: (sp,sq(.)) &dA &d@ Clef code: clef(.,.) &dA &d@ Key code: key(.) &dA &d@ Time code: tcode(.) &dA &d@ f5: double bar flag &dA &dA &d@ Outputs: ldist,gbarflag,gbar(if f5 is set),tcode,savtcode &dA &d@ tplace &dA &d@ &dA &d@ Internal variables: a1,a2,a3,a4,a5 &dA procedure clefkeyspace gbarflag = 0 ldist = sp + hxpar(10) &dA &dA &d@ 1) clef &dA ldist = ldist + hxpar(15) &dA &dA &d@ 2) key signature &dA a9 = ldist a5 = ldist loop for f12 = 1 to f11 notesize = f(f12,14) x = ldist &dA &d@ sharps if key(f12) > 0 x = hpar(f12,6) * key(f12) + x end &dA &d@ flats if key(f12) < 0 x = 0 - key(f12) * hpar(f12,7) + x end if key(f12) = 0 a4 = x else a4 = x + hxpar(2) end if a4 > a5 a5 = a4 end repeat if a5 > ldist ldist = a5 end tplace = ldist - sp &dA &d@ &dA &d@ 3) time change &dA a5 = ldist loop for f12 = 1 to f11 notesize = f(f12,14) savtcode(f12) = tcode(f12) if tcode(f12) < 10000 a1 = tcode(f12) / 100 a2 = rem a3 = 0 if a1 = 1 and a2 = 1 a3 = 1 end if a1 = 0 and a2 = 0 a3 = 2 end &dA if a3 > 0 a5 = ldist + hxpar(12) else c = ldist + hxpar(21) + hxpar(19) if a2 < 10 and a1 < 10 c = ldist + hxpar(22) + hxpar(20) end a5 = c - hxpar(13) end if bit(1,f5) = 1 a5 += hxpar(11) /* &dA05-27-94&d@ I'm not sure why this is necessary, but it is. end end tcode(f12) = 10000 repeat if ldist < a5 ldist = a5 end &dA &dA &d@ 4) store info for double bar if left over from last line &dA if bit(1,f5) = 1 gbarflag = 1 gbar(1) = ldist + hxpar(11) - sp gbar(2) = 9 ldist = ldist + hxpar(11) + hxpar(16) + hxpar(17) if bit(0,f5) = 1 gbar(2) += 16 ldist += hxpar(18) end else ldist += hxpar(5) end return &dA &d@ &dA &dA &d@*P&dA 12b. clefkey &dA &d@ &dA &dA &d@ &dA &d@ Purpose: Create object entries for clef, key and time signature &dA &dA &d@ Operation: Also typeset measure number. &dA &d@ Also typeset a mark object object for an ending superobject, if the ending &dA &d@ starts at the beginning of the line. The flag for this is the &dA &d@ variable supernum. If this is positive, then this is the superobject &dA &d@ number of the ending superobject. New &dA05/06/08&d@ &dA &dA &d@ Inputs: Staff locations: (sp,sq(.)) &dA &d@ Clef code: clef(.,.) &dA &d@ Key code: key(.) &dA &d@ Time code: savtcode(.) &dA &dA &d@ Internal variables: a1,a2,a3,a4,a5 &dA &d@ &dA &d@ Clef is defined as a two dimensional array, &dA &d@ and if f(f12,12) = 2 then the clef, key, and &dA &d@ maybe the time signature need to be duplicated &dA &d@ on the auxiliary staff. &dA &d@ procedure clefkey str line2.80 int t1,t2,t3 int tenor int clef_obx /* New &dA10/08/08&d@ obx = hxpar(10) &dA &dA &d@ 1) clef &dA if lbyte = "l" /* New condition &dA12/18/05&d@ goto NO_CLEF end t1 = 0 loop for t2 = 1 to 2 /* &dLmax 2 staves at this time&d@ a1 = clef(f12,t2) / 10 a2 = rem a3 = a1 / 3 a4 = rem if a4 = 0 z = 33 else z = 34 + a4 end oby = a2 - 1 * notesize + t1 clef_obx = obx /* New &dA10/08/08&d@ if a4 = 0 a5 = 2 if a3 = 1 a5 = 3 end if justflag < 2 ++mainyp tput [Y,mainyp] J C ~clef(f12,t2) ~obx ~oby ~a5 6913 0 0 ++mainyp tput [Y,mainyp] K 0 0 33 ++mainyp tput [Y,mainyp] K 0 0 34 if a3 = 1 ++mainyp tput [Y,mainyp] K ~hpar(f12,5) ~vpar(f12,15) 234 end end else if justflag < 2 ++mainyp tput [Y,mainyp] J C ~clef(f12,t2) ~obx ~oby ~z 6913 0 0 end end if f(f12,12) <> 2 t2 = 100 else #if SCORE_PARS t1 = 1000 /* was vst(f12) #else t1 = vst(f12) #endif end repeat NO_CLEF: obx = obx + hpar(f12,15) &dA &dA &d@ 2) key signature &dA a9 = obx a3 = abs(key(f12)) t1 = 0 loop for t2 = 1 to 2 /* &dLmax 2 staves at this time&d@ tenor = 0 if clef(f12,t2) = 12 tenor = 1 end if justflag < 2 ++mainyp tput [Y,mainyp] J K ~key(f12) ~obx ~t1 ~a3 6913 0 0 end if a3 > 0 a1 = clef(f12,t2) / 10 t3 = rem - 1 * 2 /* t3 (vertical position) measured in line numbers a1 /= 3 a2 = 2 - rem * 3 t3 -= a2 x = 0 &dA &d@ sharps if key(f12) > 0 loop for j = 1 to a3 if tenor = 0 or t3 >= 0 y = t3 + 20 * notesize / 2 - vpar20(f12) else y = t3 + 27 * notesize / 2 - vpar20(f12) /* exception for tenor clef end if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y 63 end t3 += zak(1,j) x += hpar(f12,6) repeat end &dA &d@ flats if key(f12) < 0 t3 += 4 loop for j = 1 to a3 y = t3 + 20 * notesize / 2 - vpar20(f12) if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y 65 end t3 += zak(2,j) x += hpar(f12,7) repeat end end if f(f12,12) <> 2 t2 = 100 else #if SCORE_PARS t1 = 1000 /* was vst(f12) #else t1 = vst(f12) #endif end repeat &dA &d@ &dA &d@ 3) write time change &dA obx = tplace a5 = obx &dA &dA &d@ deal with time directive or segno thrown to new line &dA if dxoff(f12) < 10000 rec = drec(f12) * perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line if jtype <> "D" putc Error: Unexplained object thrown to next line examine stop end if z < 33 if f12 = 1 if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~obx 0 1 6913 0 0 end ++rec tget [Z,rec] line lpt = 3 tline = txt(line,[' '],lpt) x = int(tline) + dxoff(f12) tline = txt(line,[' '],lpt) y = int(tline) + dyoff(f12) line = line{lpt+1..} if justflag < 2 ++mainyp #if SCROLL_OUT tput [Y,mainyp] w ~x ~y ~line #else tput [Y,mainyp] W ~x ~y ~line #endif end end else if justflag < 2 if bit(2,ntype) = 1 and f12 = 1 x = a9 + dxoff(f12) y = dyoff(f12) ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~z 6913 0 0 end if bit(3,ntype) = 1 and f12 = f11 x = a9 + dxoff(f12) y = dyoff(f12) ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~z 6913 0 0 end end end dxoff(f12) = 10000 end &dA &dA &d@ write time change, if present &dA if savtcode(f12) < 10000 a1 = savtcode(f12) / 100 a2 = rem a3 = 0 if a1 = 1 and a2 = 1 a3 = 1 end if a1 = 0 and a2 = 0 a3 = 2 end * if a3 > 0 obx = obx + hpar(f12,13) y = vpar(f12,6) z = 36 + a3 if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx ~y ~z 6913 0 0 end if f(f12,12) = 2 #if SCORE_PARS y += 1000 /* was vst(f12) #else y += vst(f12) #endif if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx ~y ~z 6913 0 0 end end else obx = a5 + hpar(f12,21) a3 = 4 if a2 < 10 a3 = 3 if a1 < 10 obx = a5 + hpar(f12,22) end end if a1 < 10 --a3 end if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx 0 ~a3 6913 0 0 end y = vpar(f12,4) a = a1 perform number y = vpar(f12,8) a = a2 perform number if f(f12,12) = 2 if justflag < 2 ++mainyp #if SCORE_PARS tput [Y,mainyp] J T ~savtcode(f12) ~obx 1000 ~a3 6913 0 0 #else tput [Y,mainyp] J T ~savtcode(f12) ~obx ~vst(f12) ~a3 6913 0 0 #endif end y = vpar(f12,4) a = a1 perform number y = vpar(f12,8) a = a2 perform number end end obx = obx + hpar(f12,19) end &dA &dA &d@ 4) write measure number &dA &d@ if f12 = 1 or f12 > 0 /* f12 > 0 added &dA01/06/04&d@ (dummy boolean TRUE) t2 = M_NUM_FONT /* font number moved to #define &dA01/06/04 perform spacepar (t2) if f12 > 1 /* this also added &dA01/06/04&d@; creates dummy t2 = 0 /* measure numbers, which "come to life" only end /* when top staff line(s) is/are removed. ++sys_count mnum = oldbarnum /* measure number for first measure in this system line = chs(oldbarnum) line2 = "" loop for i = 1 to len(line) line2 = line2 // "\0" // line{i} repeat t1 = spc(48+128) /* space for small numbers t1 = len(line) - 1 * t1 &dK &d@ x = a5 - t1 x = clef_obx - t1 /* New &dA10/08/08&d@ y = 0 - vpar(f12,2) if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~t2 ~line2 end end &dA &dA &d@ 5) put down mark for ending superobject, if supernum > 0 New &dA05/06/08&d@ &dA a5 = hxpar(8) - sp - vpar(f12,3) if supernum > 0 if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~a5 0 0 6913 0 1 ~supernum end end supernum = 0 return &dA &d@ &dA &dA &d@*P&dA 13. getsmall &dA &d@ &dA &dA &d@ Purpose: Identify and count the smallest duration in line &dA &dA &d@ Inputs: a1 = number of nodes in larr to look at &dA &d@ a9 = purpose flag (0 = condensation, 1 = expansion) &dA &d@ &dA &d@ Outputs: k = code for smallest note/rest on line (not including &dA &d@ syncopated nodes) &dA &d@ e = smallest internote distance (not including &dA &d@ syncopated distances) &dA &d@ delta_e = difference between e and next smallest &dA &d@ distance New &dA10/14/07 &dA &d@ df = proper duration flag for shortest note &dA &d@ scnt = number of nodes preceded by distance e &dA &d@ small(.) = node numbers of duration df, where &dA &d@ distance adjustment can take place &dA &dA &d@ scnt2 = number of nodes for which adj_space = YES New &dA05/25/03 &dA &d@ small2(.) = node numbers of duration df, where " " &dA &d@ distance adjustment can take place " " &dA &d@ and adj_space = YES " " &dA &dA &d@ Internal variables: a2,a3,a4,a5,a6,a7,a8,a10 &dA procedure getsmall int df2,first k = 11 e = 1000 df2 = 100000 scnt = 0 scnt2 = 0 /* New &dA05/25/03&d@ delta_e = 0 /* New &dA10/14/07&d@ loop for a8 = 2 to a1 a4 = larr(a8,TIME_NUM) /* New &dA05/25/03&d@ if a4 > 0 if larr(a8,MNODE_TYPE) <> 18 or e = 1000 /* New &dA05/25/03&d@ a5 = larr(a8-1,MNODE_TYPE) /* " " if a5 > 0 &dA &dA &d@ Case: node is preceded by variable distance (a4 > 0); node is not a bar &dA &d@ line (larr(a8,MNODE_TYPE) <> 18); previous node type is a5; we New &dA05/25/03 &dA &d@ are not including syncopated nodes in our preliminary search &dA &d@ for the smallest node type on the line. &dA if a5 <= k if a5 < k a6 = 0 end k = a5 &dA &dA &d@ df2 = 64, a6 = 0 --> previous duration is quarter note, etc. &dA &d@ df2 = 64, a6 = 1 --> previous duration is a quarter note triplet, etc. &dA df = a4 / 9 if rem = 0 if df < df2 df2 = df end else df = a4 / 6 if rem = 0 a6 = 1 if df < df2 df2 = df end end end &dA &dK &d@ if bit(a5-1,df2) = 1 /* i.e. not including syncopations &dK &d@ a2 = larr(a8,PRE_DIST) /* New &dA05/25/03&d@ &dK &d@ if a2 < e &dK &d@ e = a2 &dK &d@ end &dK &d@ end &dA &dA &d@ We need to change the code here (&dA01/24/04&d@) to deal with the situation &dA &d@ that occurs in Baroque music, where (for example) the quarter/eighth &dA &d@ combination in triplet is represented by a dotted eighth and sixteenth. &dA &d@ The problem is that in this situation, the MNODE_TYPE type "under-represents" &dA &d@ what is really there. In this example, the dotted eighth (MNODE_TYPE = 6) &dA &d@ is really a triplet quarter (MNODE_TYPE = 7); and the sixteenth (MNODE_TYPE = 5) &dA &d@ is really a triplet eighth (MNODE_TYPE = 6). Because of this, the code &dA &d@ above thinks these intervals are syncopations. The trick here will be &dA &d@ to write some code that will capture this situation, without letting &dA &d@ through the syncopated case. By increasing the value of MNODE_TYPE by &dA &d@ one, we are increasing the value of a5 by one, which means we are &dA &d@ looking at the next larger bit of df2. The value of df2 is valid; &dA &d@ we don't propose to change that. We need to consider the effect of &dA &d@ looking at the next larger bit. Let us suppose that df2 has the &dA &d@ following value: xxy&dE0&d@xx..., where the &dE0&d@ corresponds to the bit read &dA &d@ above. If the value of y is 0, then either this node is very short &dA &d@ relative to the note-type represented and is definitely syncopated, &dA &d@ or the node is at least four times longer than the note-type &dA &d@ represented, which is a logical error. If the value of y is 1, the &dA &d@ node is at least twice as long as the note-type represented, which &dA &d@ is also a logical error. &dA &dA &d@ Based on this analysis, I think the fix is actually very simple. &dA &d@ The basic rule is that the node type should NEVER exceed the value &dA &d@ of the note-type represented. If the note-type represented is &dA &d@ too small, as happens in the triplet case, the above code fails &dA &d@ for the wrong reason. What we really should be asking is: &dA &dA &d@ if df2 >= (0x01 << (a5-1)) /* i.e. not including syncopations &dA &dA &d@ The "=" part of this statement encompasses the normal situation; i.e., &dA &d@ the node type is identical to the note-type represented. The "less than" &dA &d@ condition is where this statement fails, and this is the syncopated case. &dA &d@ The "greater than" condition is logically impossible, but now accepts &dA &d@ the case where the size of the note-type was under-represented, as &dA &d@ happens in the triplet case. &dA if df2 >= (0x01 << (a5-1)) /* i.e. not including syncopations a2 = larr(a8,PRE_DIST) /* New &dA05/25/03&d@ if a2 < e delta_e = e - a2 /* New &dA10/14/07&d@ e = a2 end if e + delta_e > a2 delta_e = a2 - e /* New &dA10/14/07&d@ end end &dA end end end end repeat if df2 = 100000 /* no valid "smallest" notes return end df = df2 if a6 = 0 df *= 9 else df *= 6 end &dA &dA &d@ k = code for smallest note/rest on line &dA &d@ e = smallest internote distance &dA &d@ df = proper duration flag for shortest note in search set &dA &dA &d@ Determine quantity and location of smallest distances &dA first = 0 GSM2: a3 = 0 a5 = 0 a7 = 0 a6 = e + hxpar(14) /* fudge factor for "shortest distance" loop for a8 = 2 to a1 if larr(a8,TIME_NUM) > 0 /* New &dA05/25/03&d@ a3 += larr(a8,TIME_NUM) /* " " if larr(a8,MNODE_TYPE) = 18 /* " " if a9 = 0 a5 = a3 / df goto GSM1 end if first = 0 a5 = a3 / df goto GSM1 end end a4 = a3 / df if rem = 0 &dA &dA &d@ Case: node is preceded by variable distance (larr(a8,TIME_NUM) > 0); (&dA05/25/03&d@) &dA &d@ node is not a bar line (larr(a8,MNODE_TYPE) <> 18); &dA &d@ node aligns with a multiple of the minimum duration; &dA &d@ a4 = cumulative number of minimum durations to this node; &dA &d@ a5 = previous cumulative number of minimum durations. &dA a2 = a4 - a5 if a2 = 1 a7 += larr(a8,PRE_DIST) /* New &dA05/25/03&d@ &dA &dA &d@ Condensation: a7 (effective distance) must be within hxpar(14) of e &dA if a9 = 0 if a7 < a6 ++scnt small(scnt) = a8 if larr(a8,M_ADJ) = YES /* New Code &dA05/25/03&d@ ++scnt2 small2(scnt2) = a8 end end else ++scnt small(scnt) = a8 if larr(a8,M_ADJ) = YES /* New Code &dA05/25/03&d@ ++scnt2 small2(scnt2) = a8 end end end a5 = a4 a7 = 0 else a7 = larr(a8,PRE_DIST) /* New &dA05/25/03&d@ end end GSM1: repeat if scnt <= 4 and first = 0 first = 1 scnt = 0 scnt2 = 0 /* New &dA05/25/03&d@ goto GSM2 end return &dA &d@ &dA &dA &d@*P&dA 25. endcheck &dA &d@ &dA &dA &d@ Purpose: Check status of end of part flags. &dA &dA &d@ Inputs: f(.,8) &dA procedure endcheck endflag = f(1,8) loop for f12 = 2 to f11 if f(f12,8) <> endflag putc Error: Parts of different length putc Suggestion: Check the &dAends&d@ of each of the i-files. putc Compare the last measure number in each file. If one putc of the i-files ends early, this could be caused by a putc slur that was started but not terminated. putc putc Another possibility is that an error was made when track putc numbers were added to multiple rests. Use qed to check putc the sequential order of measure numbers. putc putc Look also for the misspelling of &dCmeasure&d@, &dCmdouble&d@, &dCmheavy&d@, etc. putc in one of the files. putc examine stop end repeat #if REPORT if endflag = 1 putc ENDFLAG = 1 end #endif return &dA &d@ &dA &dA &d@*P&dA 27. setckt &dA &d@ &dA &dA &d@ Purpose: Generate entries in marr for possible clef, key, time and clef &dA &d@ signatures in that order (snode = 6913) &dA &dA &d@ Input: marc = index into marr array &dA &d@ f(.,6) = record pointer in part (.) &dA &d@ f(.,10) = active measure flag for part (.) &dA &d@ olddist(.) = value of x-coordinate for previous object &dA &dA &d@ Outputs: Entries in marc for clef, key and time signature &dA &d@ when any of these are present &dA &d@ Updated marc and f(.,6) pointers &dA &d@ Updated olddist(.) &dA &d@ Updated ldist &dA &d@ rmarg changed (this will be changed back to hxpar(4) &dA &d@ at CF: if signatures are not at end of line) &dA &d@ &dA &d@ Internal variables: tarr(.) &dA &dA procedure setckt int g,h,i,j,k,q int firstclef &dA &d@ check for presence of clef, key, time and clef (again) loop for f12 = 1 to f11 loop for g = 1 to 4 tarr4(f12,g) = 0 repeat repeat loop for g = 1 to 4 tarr(g) = 0 repeat i = 0 j = 0 loop for f12 = 1 to f11 firstclef = 0 notesize = f(f12,14) if f(f12,10) = 0 rec = f(f12,6) CKT1: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if snode <> 6913 h = dvar1 - olddist(f12) if h > i i = h /* constructing maximum distance end goto CKT2 end if "CKT" con jtype if mpt > 1 firstclef = 1 /* K or T encountered else if firstclef = 1 mpt = 4 /* Clef after K or T end end ++tarr4(f12,mpt) /* here is where we count end end goto CKT1 end CKT2: loop for g = 1 to 4 if tarr4(f12,g) > tarr(g) tarr(g) = tarr4(f12,g) /* we want maximum of count for each sign end repeat repeat &dA &dA &d@ i = maximum distance from bar line to first object beyond signatures &dA loop for g = 1 to 4 if tarr(g) > 0 j = 1 ++marc marr(marc,PRE_DIST) = 0 if g < 4 marr(marc,MNODE_TYPE) = 13 + g else marr(marc,MNODE_TYPE) = 14 /* Clef following Key or Time end marr(marc,TIME_NUM) = 0 marr(marc,SNODE) = 6913 marr(marc,ACT_FLAG) = 0 marr(marc,M_ADJ) = adj_space marr(marc,MARR_TEMP) = 0 k = 0 q = 1 /* for constructing marr(marc,ACT_FLAG) loop for f12 = 1 to f11 if tarr4(f12,g) > 0 --tarr4(f12,g) notesize = f(f12,14) if f(f12,10) = 0 rec = f(f12,6) CKT3: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc &dAStopping Here&d@ stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" and jtype = "CKTC"{g} marr(marc,ACT_FLAG) |= q h = dvar1 - olddist(f12) if h > marr(marc,PRE_DIST) marr(marc,PRE_DIST) = h end ++k tdist(k,1) = f12 tdist(k,2) = dvar1 f(f12,6) = rec goto CKT4 end if rec < f(f12,2) goto CKT3 end end end CKT4: q <<= 1 repeat perform adjolddist ldist += marr(marc,PRE_DIST) i -= marr(marc,PRE_DIST) * perform showmarr * getc end --tarr(g) if tarr(g) > 0 /* if more than one of a sign, --g /* go though loop again end repeat &dA &dA &d@ If j = 1, i = maximum distance from last signature to the first &dA &d@ object beyond signatures. &dA #if SCROLL_OUT #else if j = 1 false_rmarg = hxpar(4) - i end #endif return &dA &d@ &dA &dA &d@*P&dA 28. adjolddist &dA &d@ &dA &dA &d@ Purpose: Adjust olddist(.) for parts where f(f12,10) = 0 &dA procedure adjolddist k = 1 loop for f12 = 1 to f11 if f(f12,10) = 0 if tdist(k,1) = f12 olddist(f12) = tdist(k,2) ++k else olddist(f12) += marr(marc,PRE_DIST) end end repeat return &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS &dA &d@ &dA &dA &d@*P&dA 29(a). wholerest (t1) &dA &d@ &dA &dA &d@ Purpose: Typeset whole measure rest &dA &dA &d@ Inputs: f12 = part number &dA &d@ a = x-coord of left bar (from beginning of staff) &dA &d@ b = x-coord of right bar " " " " &dA &d@ t1 = staff flag: 0 = normal &dA &d@ 1 = don't print rests &dA &d@ 2 = also print rest on auxiliary stave &dA &d@ mrest_data(f12) = "| P7=x.yyyy" (P7 parameter data) &dA &dA &d@ Internal variables: x &dA &d@ y &dA &d@ z &dA procedure wholerest (t1) str temp.80 int t1 getvalue t1 if justflag < 2 if t1 < 2 temp = "| FLOAT P2=1.1 P4=0 P5=-2 P6=" if t1 = 1 temp = temp // "-1 " else temp = temp // "0 " end mrest_data(f12) = trm(mrest_data(f12)) temp = temp // mrest_data(f12){3..} // " P8=0" x = a + b / 2 - notesize y = vpar(f12,4) &dK &d@ putf [3] J R 9 ~x ~y 46 1 0 0 ~temp ++mainyp if rest7 = 1 /* added &dA12/24/03&d@ "Q" is an internal flag tput [Y,mainyp] Q R 9 ~x ~y 1 1 0 0 ~temp else tput [Y,mainyp] J R 9 ~x ~y 1 1 0 0 ~temp end ++mainyp tput [Y,mainyp] K 0 0 46 else putc Possible (non-fatal) program error. Compound (multiple) rests putc are not supposed to be possible on the grand staff in this putc implementation of MUSDATA. putc No action taken, &dAbut you'd better check the results&d@! putc &dK &d@ putf [3] J R 9 ~x ~y 2 1 0 0 &dK &d@ putf [3] K 0 0 46 &dK &d@ putf [3] K 0 ~vst(f12) 46 end end return &dL &dL &d@ xmskpage code &dL &dL #else &dA &d@ &dA &dA &d@*P&dA 29(b). wholerest (t1) &dA &d@ &dA &dA &d@ Purpose: Typeset whole measure rest &dA &dA &d@ Inputs: f12 = part number &dA &d@ a = x-coord of left bar (from beginning of staff) &dA &d@ b = x-coord of right bar " " " " &dA &d@ t1 = staff flag: 0 = normal &dA &d@ 1 = don't print rests &dA &d@ 2 = also print rest on auxiliary stave &dA &d@ rest7 = set "optional line rest" &dA &dA &d@ Internal variables: x &dA &d@ y &dA &d@ z &dA procedure wholerest (t1) int t1 getvalue t1 if t1 = 1 return end x = a + b / 2 - notesize y = vpar(f12,4) if t1 = 0 if justflag < 2 ++mainyp if rest7 = 1 /* added &dA12/24/03&d@ "Q" is an internal flag tput [Y,mainyp] Q R 9 ~x ~y 46 1 0 0 else tput [Y,mainyp] J R 9 ~x ~y 46 1 0 0 end end return end if justflag < 2 ++mainyp if rest7 = 1 /* added &dA12/24/03&d@ "Q" is an internal flag tput [Y,mainyp] Q R 9 ~x ~y 2 1 0 0 else tput [Y,mainyp] J R 9 ~x ~y 2 1 0 0 end ++mainyp tput [Y,mainyp] K 0 0 46 ++mainyp tput [Y,mainyp] K 0 ~vst(f12) 46 end return &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif &dA &d@ &dA &dA &d@*P&dA 30. getcontrol &dA &d@ &dA &dA &d@ Purpose: Find the object that generates a proper-node for the &dA &d@ current object being looked at at rec. &dA &dA &d@ Inputs: rec = record number for current object &dA &d@ f12 = part to search &dA &d@ cjtype = object type from last call to getcontrol &dA &d@ csnode = node number from last call to getcontrol &dA &dA &d@ Outputs: crec = record number which generates proper-node &dA &d@ cjtype = object type &dA &d@ cntype = node type &dA &d@ cdv = x coordinate &dA &d@ coby = y coordinate &dA &d@ cz = value of z &dA &d@ csnode = snode number &dA &d@ line2 = record which is proper node &dA &dA &d@ Operation: if csnode < 6913 and &dA &d@ if csnode = snode and &dA &d@ if cjtype = B and &dA &d@ if jtype = N,R,Q,F,I, current object generates node &dA &d@ otherwise next N,R,Q,F,I object generates node &dA &d@ otherwise current proper node is still valid &dA &d@ if csnode < snode and &dA &d@ if jtype = N,R,Q,F,I,B, current object generates node &dA &d@ otherwise next N,R,Q,F,I,B object generates node &dA &d@ if csnode > snode, I think you have a problem &dA &d@ if csnode = 6913 &dA &d@ if snode = 6913 and &dA &d@ if jtype = B,C,K,T, current object generates node &dA &d@ otherwise next C,K,T generates node &dA &d@ otherwise next N,R,Q,F,I,B object generates node &dA procedure getcontrol str local_last_jtype.1 /* added &dA11/25/06&d@ local_last_jtype = last_jtype /* added &dA11/25/06&d@ last_jtype = jtype /* added &dA11/25/06&d@ if csnode < 6913 if csnode = snode if cjtype = "B" crec = rec GC1: perform save4 &dK &d@ if "NRQFI" con cjtype if "NRrQFI" con cjtype /* New &dA10/15/07&d@ return end ++crec goto GC1 end return else if csnode < snode crec = rec GC2: perform save4 &dK &d@ if "NRQFIB" con cjtype if "NRrQFIB" con cjtype /* New &dA10/15/07&d@ if mpt < 7 return end if csnode = 6913 return end end ++crec goto GC2 else putc Error: csnode > snode in part ~f12 at ~barnum putc This could be caused by durations that don't properly add up. examine stop end end else &dA &dA &d@ Code added &dA11/25/06&d@ to try to fix an End-of-measure Bug &dA #if ADD112506 if csnode = snode and local_last_jtype = "M" and jtype <> "B" crec = rec GC2A: perform save4 if "B" con cjtype return end if csnode < 6913 putc A new bug was introduced on &dA11/25/06&d@. Please report. putc To restore this program to its earlier, set the #define ADD112506 to 0 putc putc Operation &dAHalted&d@ putc stop end ++crec goto GC2A end #endif &dA &d@ End of &dA11/26/06&d@ Addition crec = rec GC3: perform save4 if snode = 6913 if "BCKT" con cjtype return end else &dK &d@ if "NRQFIB" con cjtype if "NRrQFIB" con cjtype /* New &dA10/15/07&d@ return end end ++crec goto GC3 end * return &dA &d@ &dA &dA &d@*P&dA 33. number &dA &d@ &dA &dA &d@ Purpose: Typeset a number &dA &dA &d@ Inputs: a = number &dA &d@ b = center position for number (not used here &dA11/05/05&d@) &dA &d@ y = vertical location of number &dA procedure number x = 0 - hpar(f12,20) if a > 99 x = 0 + hpar(f12,20) else if a > 9 x = 0 /* Fixing bug &dA11/05/05&d@ (was x = b) end end NU1: a = a / 10 z = rem + 71 if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y ~z end if a = 0 return end x -= hpar(f12,19) goto NU1 * return &dA &dA &d@PEND &dA &dA &d@ ************************************************** &dA procedure strip if line con " " line = line{mpt+1..} else line = "" end return * procedure strip2 if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure strip3 if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure strip4 if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure strip6 if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure strip8 if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure save1 if htype = "V" &dA &dA &d@ structure of transp super-object: 4. situation: 0=8av up, 1=8av down &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from obj1 &dA &d@ 8. length of right vertical hook &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(f12,k,2) tline = txt(line,[' '],lpt) a1 = int(tline) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp - notesize if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum y1 -= 1000 else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum V ~a3 0 ~x2 ~y1 ~a1 end end return end if htype = "E" &dA &dA &d@ structure of ending super-object: 4. ending number (0 = none) &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from staff lines &dA &d@ 8. length of left vertical hook &dA &d@ 9. length of right vertical hook &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp - vpar(f12,3) &dK &d@ if superdata(f12,k,6) = 0 if superdata(f12,k,6) = 0 or superdata(f12,k,5) = 3 /* New &dA05/06/08 a1 = 0 if superdata(f12,k,5) <> 3 a3 = 0 end end if justflag < 2 * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum E ~a3 0 ~x2 ~y1 ~a1 ~a2 end end superdata(f12,k,5) = 0 /* New &dA05/06/08&d@ Clear these to make superdata(f12,k,6) = 0 /* sure they are not used elsewhere. superdata(f12,k,7) = 0 return end if htype = "D" &dA &dA &d@ structure of dashes super-object: 4. horiz. disp. from obj1 &dA &d@ 5. horiz. disp. from obj2 &dA &d@ 6. vert. disp. from staff lines &dA &d@ 7. spacing parameter &dA &d@ 8. font designator &dA tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum D 0 ~x2 ~y1 ~a1 ~a2 end end return end if htype = "R" &dA &dA &d@ structure of trill super-object: 4. situation: 1 = no trill, only ~~~~ &dA &d@ 2 = trill with ~~~~ &dA &d@ 3 = tr ~~~~ with sharp above &dA &d@ 4 = tr ~~~~ with natural above &dA &d@ 5 = tr ~~~~ with flat above &dA &d@ 5. horiz. disp. from object 1 &dA &d@ 6. horiz. disp. from object 2 &dA &d@ 7. vert. disp. from object 1 &dA tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) + superdata(f12,k,2) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 = int(tline) + superdata(f12,k,1) else a1 = 1 x1 = hxpar(8) - sp - notesize if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum y1 -= 1000 else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum R ~a1 0 ~x2 ~y1 end end return end if htype = "W" &dA &dA &d@ structure of wedge super-object: 4. left spread &dA &d@ 5. right spread &dA &d@ 6. horiz. disp. from obj1 &dA &d@ 7. beg. vert. disp. from staff &dA &d@ 8. horiz. disp. from obj2 &dA &d@ 9. end. vert. disp. from staff &dA tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y2 = int(tline) a1 = superdata(f12,k,5) if a1 = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end else x1 = hxpar(8) - sp c1 = a1 if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum W ~c1 ~c2 0 ~y1 ~x2 ~y2 end end return end return * procedure save3 cflag = 0 tget [Z,rec] line .t3 jtype ntype dvar1 oby z snode dincf * dinct will be 10000 when there is a centered rest if dincf = 10000 dincf = 0 cflag = 1 end &dA &dA &d@ This code added &dA12/24/03&d@ for optional rests &dA if dincf = 10001 cflag = 1 end &dA &dA &d@ if f(f12,12) = 2 and oby >= 1000 &dA &d@ oby -= 1000 &dA &d@ if jtype <> "B" &dA &d@ oby += vst(f12) &dA &d@ end &dA &d@ end return * procedure save4 S4: tget [Z,crec] line2 .t3 cjtype cntype cdv coby cz csnode if line2{1} <> "J" ++crec goto S4 end if "CKTDBSFIM" con cjtype if mpt < 6 cntype = 13 + mpt else cntype = 17 end end return * procedure save5 int c,x loop a = point b = oldmpoint + barpar(barcount+1,1) c = f(f12,12) perform wholerest (c) #if SCORE_PARS if justflag < 2 and f(f12,11) > 1 x = oldmpoint + barpar(barcount+1,1) c = barnum + 1 ++mainyp tput [Y,mainyp] J B ~c ~x 1 82 6913 1 0 | EXPERIMENTAL BAR AFTER FLOATING REST end #endif ++barnum --f(f12,11) if f(f12,11) > 0 ++barcount point = oldmpoint + barpar(barcount,1) oldmpoint = point oldmp2 = point if barcount = delta f(f12,6) = rec return end #if SCORE_PARS else mrest_data(f12) = "" #endif end repeat while f(f12,11) > 0 return *PX showmarr procedure showmarr putc marr(~marc ,*) .t12 ... loop for j = 1 to MARR_PARS putc .w6 ~marr(marc,j) ... repeat putc return *PX showlarr procedure showlarr putc larr(~a1 ,*) .t12 ... loop for a2 = 1 to MARR_PARS putc .w6 ~larr(a1,a2) ... repeat putc return * &dA &d@ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ &dA &d@³P xx. spacepar (t5) ³ &dA &d@³ ³ &dA &d@³ Purpose: Be sure that proper space paramters are loaded ³ &dA &d@³ ³ &dA &d@³ Inputs: t5 = font number ³ &dA &d@³ ³ &dA &d@³ Outputs: valid spc(.) array for this font ³ &dA &d@³ updated value of curfont ³ &dA &d@³ ³ &dA &d@³ ³ &dA &d@³ Internal Variables: ³ &dA &d@³ ³ &dA &d@³ int bfont(4,4) Spacepar keeps a record of past calls ³ &dA &d@³ together with the number of times ³ &dA &d@³ a particular font has been asked for. ³ &dA &d@³ If the number of fonts exceeds 4, ³ &dA &d@³ spacepar will replace the space data ³ &dA &d@³ from the memory block [bspc(.,.)] ³ &dA &d@³ least current. ³ &dA &d@³ int bspc(4,255) Four memory blocks for space data ³ &dA &d@³ int time pseudo timer ³ &dA &d@³ ³ &dA &d@³ ³ &dA &d@ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ procedure spacepar (t5) int bfont(4,4),bspc(4,255),time int t1,t2,t3,t4,t5,t6 str file.200,line.280 getvalue t5 if t5 <> curfont t2 = 1000000 loop for t1 = 1 to 4 if t5 = bfont(t1,1) /* font found in reserve ++time bfont(t1,2) = time loop for t3 = 1 to 255 spc(t3) = bspc(t1,t3) repeat curfont = t5 return end if bfont(t1,2) < t2 t2 = bfont(t1,2) t4 = t1 /* t4 is the oldest block end repeat &dA &dA &d@ New code &dA03/19/04&d@ &dA line = DISP_DISK // ":/musprint/new/xfonts/tms/fontspac" open [4,1] line t6 = revsizes(notesize) t1 = t5 - 29 /* 1 <= t1 <= 19 t2 = XFonts(t6,t1) - 50 /* 1 <= t2 <= 90 (text font) t2 = Fspacex(t2) - 1 /* t2 = offset in fontspac &dA loop for t1 = 1 to t2 getf [4] repeat t3 = 61 loop for t2 = 1 to 31 spc(t2) = 0 repeat loop for t2 = 32 to 127 if t3 = 61 t3 = 1 getf [4] line end spc(t2) = int(line{t3,2}) t3 += 3 repeat loop for t2 = 128 to 159 spc(t2) = 0 repeat t3 = 61 loop for t2 = 160 to 255 if t3 = 61 t3 = 1 getf [4] line end spc(t2) = int(line{t3,2}) t3 += 3 repeat close [4] loop for t1 = 1 to 255 bspc(t4,t1) = spc(t1) repeat bfont(t4,1) = t5 ++time bfont(t4,2) = time curfont = t5 end return &dA &dA &d@ &dA &d@*P XXII. procedure newfont_init &dA &d@ &dA &d@ Initializing arrays for NEWFONTS &dA procedure newfont_init nsizes(1) = 4 nsizes(2) = 5 nsizes(3) = 6 nsizes(4) = 7 nsizes(5) = 8 nsizes(6) = 10 nsizes(7) = 12 nsizes(8) = 14 nsizes(9) = 16 nsizes(10) = 18 nsizes(11) = 21 nsizes(12) = 24 wedgefont(1) = 38 wedgefont(2) = 38 wedgefont(3) = 38 wedgefont(4) = 38 wedgefont(5) = 38 wedgefont(6) = 38 wedgefont(7) = 38 wedgefont(8) = 38 wedgefont(9) = 39 wedgefont(10) = 39 wedgefont(11) = 39 wedgefont(12) = 39 wedgefont(13) = 39 wedgefont(14) = 39 wedgefont(15) = 40 wedgefont(16) = 40 wedgefont(17) = 40 wedgefont(18) = 40 wedgefont(19) = 40 wedgefont(20) = 41 wedgefont(21) = 41 wedgefont(22) = 41 wedgefont(23) = 41 wedgefont(24) = 41 scfont(1) = 44 /* sc08 scfont(2) = 44 scfont(3) = 44 scfont(4) = 44 scfont(5) = 45 /* sc12 scfont(6) = 45 scfont(7) = 45 scfont(8) = 45 scfont(9) = 46 /* sc16 scfont(10) = 46 scfont(11) = 46 scfont(12) = 46 scfont(13) = 47 /* sc24 scfont(14) = 47 scfont(15) = 47 scfont(16) = 47 scfont(17) = 47 scfont(18) = 47 scfont(19) = 47 scfont(20) = 47 scfont(21) = 47 scfont(22) = 47 scfont(23) = 47 scfont(24) = 47 revsizes(1) = 1 revsizes(2) = 1 revsizes(3) = 1 revsizes(4) = 1 revsizes(5) = 2 revsizes(6) = 3 revsizes(7) = 4 revsizes(8) = 5 revsizes(9) = 6 revsizes(10) = 6 revsizes(11) = 7 revsizes(12) = 7 revsizes(13) = 8 revsizes(14) = 8 revsizes(15) = 9 revsizes(16) = 9 revsizes(17) = 10 revsizes(18) = 10 revsizes(19) = 10 revsizes(20) = 11 revsizes(21) = 11 revsizes(22) = 11 revsizes(23) = 12 revsizes(24) = 12 &dA &dA &d@ start with notesize, and a number 30 to 48 (19 possibilities) &dA &d@ want a font number, that's all &dA XFontstr(1) = " 51 51 81 111 51 81 111 52 82 112 53 83 113 54 84 114 56 86 116" XFontstr(2) = " 51 52 82 112 53 83 113 54 84 114 55 85 115 56 86 116 58 88 118" XFontstr(3) = " 51 54 84 114 55 85 115 56 86 116 57 87 117 58 88 118 60 90 120" XFontstr(4) = " 52 55 85 115 57 87 117 58 88 118 59 89 119 60 90 120 63 93 123" XFontstr(5) = " 53 57 87 117 58 88 118 59 89 119 61 91 121 62 92 122 64 94 124" XFontstr(6) = " 55 59 89 119 61 91 121 63 93 123 64 94 124 65 95 125 68 98 128" XFontstr(7) = " 57 62 92 122 64 94 124 65 95 125 67 97 127 69 99 129 72 102 132" XFontstr(8) = " 58 64 94 124 66 96 126 68 98 128 70 100 130 72 102 132 74 104 134" XFontstr(9) = " 60 67 97 127 69 99 129 71 101 131 73 103 133 74 104 134 76 106 136" XFontstr(10) = " 61 69 99 129 71 101 131 73 103 133 74 104 134 75 105 135 78 108 138" XFontstr(11) = " 64 72 102 132 74 104 134 75 105 135 77 107 137 78 108 138 79 109 139" XFontstr(12) = " 65 74 104 134 75 105 135 77 107 137 78 108 138 79 109 139 80 110 140" loop for i = 1 to 12 sub = 1 loop for j = 1 to 19 XFonts(i,j) = int(XFontstr(i){sub..}) repeat repeat loop for a1 = 1 to 30 Fspacex(a1) = (a1 - 1) * 10 + 1 Fspacex(a1+30) = Fspacex(a1) + 400 Fspacex(a1+60) = Fspacex(a1) + 800 repeat Mbeamfont(1) = 102 Mbeamfont(2) = 102 Mbeamfont(3) = 102 Mbeamfont(4) = 102 Mbeamfont(5) = 103 Mbeamfont(6) = 103 Mbeamfont(7) = 104 Mbeamfont(8) = 105 Mbeamfont(9) = 105 Mbeamfont(10) = 106 Mbeamfont(11) = 106 Mbeamfont(12) = 107 Mbeamfont(12) = 107 Mbeamfont(14) = 108 Mbeamfont(15) = 108 Mbeamfont(16) = 109 Mbeamfont(17) = 109 Mbeamfont(18) = 110 Mbeamfont(19) = 111 Mbeamfont(20) = 111 Mbeamfont(21) = 112 Mbeamfont(22) = 112 Mbeamfont(23) = 114 Mbeamfont(24) = 114 loop for a1 = 1 to 24 revmap(a1) = revsizes(a1) repeat loop for a1 = 1 to 12 revmap(100+a1) = a1 + BEAM_OFFSET repeat revmap(114) = 13 + BEAM_OFFSET revmap(98) = 48 revmap(99) = 49 revmap(100) = 50 dummy(1) = 48 dummy(2) = 48 dummy(3) = 48 dummy(4) = 48 dummy(5) = 49 dummy(6) = 49 dummy(7) = 49 dummy(8) = 49 dummy(9) = 50 dummy(10) = 50 dummy(11) = 50 dummy(12) = 50 extendoff(1) = 32 extendoff(2) = 80 extendoff(3) = 160 extendoff(4) = 208 extendoff(5) = 32 extendoff(6) = 80 extendoff(7) = 160 extendoff(8) = 208 extendoff(9) = 32 extendoff(10) = 80 extendoff(11) = 160 extendoff(12) = 208 return &dA &d@ &dA &dA &dA &d@ &dA &d@*P XXIII. procedure parameter_init &dA &d@ &dA &d@ Initializing parameters &dA procedure parameter_init a = 0 b = 0 &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS loop for f12 = 1 to f11 if f(f12,14) <> a if a <> 0 and f(f12,14) <> 0 b = 1 end if f(f12,14) > a a = f(f12,14) end end repeat if a = 0 a = NOTEZ end loop for f12 = 1 to f11 if f(f12,14) = 0 f(f12,14) = a end repeat &dL &dL &d@ xmskpage code &dL &dL #else loop for f12 = 1 to f11 if f(f12,14) = 0 putc This i-file was typeset by an old version of autoset that is no longer putc supported. Please run autoset again on the stage2 files. putc putc &dAProgram Halted&d@ putc stop end if f(f12,14) <> a if a <> 0 and f(f12,14) <> 0 b = 1 end if f(f12,14) > a a = f(f12,14) end end repeat &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif maxnotesize = a &dA &dA &d@ Initializing horizontal parameters &dA &d@ &dA &d@ 1. Fixed horizontal parameters &dA hxpar(1) = 30 hxpar(2) = 0 if maxnotesize = 14 hxpar(3) = 200 hxpar(4) = 2250 hxpar(6) = 175 hxpar(9) = 300 hxpar(16) = 6 hxpar(17) = 7 hxpar(19) = 21 hxpar(20) = 10 end if maxnotesize = 21 hxpar(3) = 200 hxpar(4) = 2250 hxpar(6) = 250 hxpar(9) = 300 hxpar(16) = 9 hxpar(17) = 11 hxpar(19) = 32 hxpar(20) = 16 end if maxnotesize = 6 hxpar(3) = 85 hxpar(4) = 970 /* &dA12-04-00&d@ changed from 1050 hxpar(6) = 75 hxpar(9) = 130 hxpar(16) = 3 hxpar(17) = 4 hxpar(19) = 9 hxpar(20) = 4 end if maxnotesize = 18 /* New size-18 &dA12/18/04&d@ hxpar(3) = 200 hxpar(4) = 2250 hxpar(6) = 225 /* 75 175 250 hxpar(9) = 300 /* 130 300 300 hxpar(16) = 7 /* 3 6 9 hxpar(17) = 9 /* 4 7 11 hxpar(19) = 28 /* 9 21 32 hxpar(20) = 14 /* 4 10 16 end if maxnotesize = 16 /* New size-16 &dA01/01/09&d@ hxpar(3) = 200 hxpar(4) = 2250 hxpar(6) = 200 /* 75 175 &dC200&d@ 225 250 hxpar(9) = 300 /* 130 300 &dC300&d@ 300 300 hxpar(16) = 7 /* 3 6 &dC 7&d@ 7 9 hxpar(17) = 9 /* 4 7 &dC 9&d@ 9 11 hxpar(19) = 26 /* 9 21 &dC 26&d@ 28 32 hxpar(20) = 13 /* 4 10 &dC 13&d@ 14 16 end hxpar(5) = 26 * maxnotesize / 16 hxpar(7) = 24 * maxnotesize / 16 hxpar(10) = 6 * maxnotesize / 16 hxpar(11) = 20 * maxnotesize / 16 hxpar(12) = 4 * maxnotesize / 16 hxpar(13) = 18 * maxnotesize / 16 hxpar(14) = 5 * maxnotesize / 16 hxpar(15) = 60 * maxnotesize / 16 hxpar(18) = 14 * maxnotesize / 16 hxpar(21) = 31 * maxnotesize / 16 hxpar(22) = 19 * maxnotesize / 16 if f11 = 1 /* for parts hxpar(9) /= 3 end &dA &dA &d@ 2. Variable Horizontal parameters &dA loop for f12 = 1 to f11 hpar(f12,1) = 60 * f(f12,14) / 16 hpar(f12,2) = 4 * f(f12,14) hpar(f12,5) = 7 * f(f12,14) + 2 / 7 hpar(f12,7) = 15 * f(f12,14) / 16 hpar(f12,9) = 24 * f(f12,14) / 16 hpar(f12,10) = 44 * f(f12,14) / 16 hpar(f12,11) = 20 * f(f12,14) / 16 hpar(f12,12) = 13 * f(f12,14) + 2 / 16 hpar(f12,13) = 6 * f(f12,14) / 16 hpar(f12,14) = 40 * f(f12,14) / 16 hpar(f12,15) = 60 * f(f12,14) / 16 hpar(f12,18) = 14 * f(f12,14) / 16 hpar(f12,21) = 31 * f(f12,14) / 16 hpar(f12,22) = 19 * f(f12,14) / 16 if f(f12,14) = 14 hpar(f12,3) = 4 hpar(f12,4) = 20 hpar(f12,6) = 15 hpar(f12,8) = 17 hpar(f12,16) = 6 hpar(f12,17) = 7 hpar(f12,19) = 21 hpar(f12,20) = 10 hpar(f12,23) = 2 end if f(f12,14) = 21 hpar(f12,3) = 6 hpar(f12,4) = 30 hpar(f12,6) = 21 hpar(f12,8) = 25 hpar(f12,16) = 8 /* changing from 6 to 8 &dA12/18/04 hpar(f12,17) = 11 hpar(f12,19) = 32 hpar(f12,20) = 16 hpar(f12,23) = 3 end if f(f12,14) = 6 hpar(f12,3) = 2 hpar(f12,4) = 9 hpar(f12,6) = 7 hpar(f12,8) = 7 hpar(f12,16) = 3 hpar(f12,17) = 4 hpar(f12,19) = 9 hpar(f12,20) = 4 hpar(f12,23) = 1 end if f(f12,14) = 16 /* New size-16 &dA01/01/09&d@ hpar(f12,3) = 4 /* 2 4 &dC 4&d@ 5 6 hpar(f12,4) = 23 /* 9 20 &dC23&d@ 26 30 hpar(f12,6) = 17 /* 7 15 &dC17&d@ 18 21 hpar(f12,8) = 20 /* 7 17 &dC20&d@ 23 25 hpar(f12,16) = 7 /* 3 6 &dC 7&d@ 7 8 hpar(f12,17) = 8 /* 4 7 &dC 8&d@ 9 11 hpar(f12,19) = 26 /* 9 21 &dC26&d@ 28 32 hpar(f12,20) = 13 /* 4 10 &dC13&d@ 14 16 hpar(f12,23) = 2 /* 1 2 &dC 2&d@ 2 3 #if BIG16 ++hpar(f12,8) #endif end if f(f12,14) = 18 /* New size-18 &dA12/18/04&d@ hpar(f12,3) = 5 /* 2 4 6 hpar(f12,4) = 26 /* 9 20 30 hpar(f12,6) = 18 /* 7 15 21 hpar(f12,8) = 23 /* 7 17 25 hpar(f12,16) = 7 /* 3 6 8 hpar(f12,17) = 9 /* 4 7 11 hpar(f12,19) = 28 /* 9 21 32 hpar(f12,20) = 14 /* 4 10 16 hpar(f12,23) = 2 /* 1 2 3 end repeat &dA &dA &d@ Variable Vertical parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA loop for f12 = 1 to f11 notesize = f(f12,14) loop for i = 1 to 10 vpar(f12,i) = notesize * i / 2 repeat vpar(f12,11) = 200 * notesize / 16 vpar(f12,12) = 4 * notesize / 16 vpar(f12,13) = 0 /* not used, formerly 8 vpar(f12,14) = 160 * notesize / 16 vpar(f12,15) = 64 * notesize / 16 vpar(f12,16) = 3 * notesize vpar(f12,17) = notesize / 2 vpar(f12,18) = 30 * notesize / 16 vpar(f12,19) = 15 /* fixed for all values of notesize vpar(f12,20) = notesize + 3 / 4 vpar(f12,21) = notesize - vpar(f12,20) vpar(f12,22) = 6 * notesize / 16 vpar(f12,23) = 9 * notesize / 16 vpar(f12,24) = 7 * notesize / 16 vpar(f12,25) = 22 * notesize / 16 vpar(f12,26) = 27 * notesize / 16 vpar(f12,27) = 72 * notesize / 16 vpar(f12,28) = 15 * notesize / 16 vpar(f12,29) = 38 * notesize / 16 vpar(f12,30) = 3 * notesize - 8 / 16 vpar(f12,31) = notesize + 1 / 2 + 1 vpar(f12,32) = notesize * 8 + 4 / 10 vpar(f12,33) = notesize * 12 + 10 / 14 vpar(f12,34) = notesize - 3 / 9 vpar(f12,35) = notesize / 3 vpar(f12,36) = 7 * notesize vpar(f12,37) = 5 * notesize / 4 vpar(f12,38) = 4 * notesize / 3 vpar(f12,39) = notesize vpar(f12,40) = 3 * notesize / 5 if notesize < 18 vpar(f12,41) = 1 end if notesize = 18 /* New size-18 &dA12/18/04&d@ vpar(f12,41) = 2 end if notesize = 21 vpar(f12,41) = 3 /* changing from 2 to 3 &dA12/18/04 end vpar20(f12) = 10 * notesize repeat &dA &dA &d@ Other parameters and variables &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA a = 4 b = 3 zak(1,1) = b zak(1,2) = 0 - a zak(1,3) = b zak(1,4) = b zak(1,5) = 0 - a zak(1,6) = b zak(2,1) = 0 - b zak(2,2) = a zak(2,3) = 0 - b zak(2,4) = a zak(2,5) = 0 - b zak(2,6) = a ttext = "" curfont = 0 &dA &dA &d@ &dE &dA &d@ &dE End of Initialization of parameters &dA &d@ &dE &dA return &dA &dA &d@ &dA &d@*P XXIV. procedure pageform_init &dA &d@ &dA &d@ Get parameters for page layout, either from FORMATS file or &dA &d@ directly from the screen. &dA procedure pageform_init if formatflag = 0 and formatfile <> "" putc Do you want to create a format file? (return = no) getc line line = trm(line) if line <> "" formatflag = 2 treset [F] forp = 0 end end if formatflag = 1 open [1,1] formatfile treset [F] forp = 0 loop getf [1] bigline bigline = trm(bigline) if bigline <> "" ++forp tput [F,forp] ~bigline end repeat eof1: close [1] forpz = forp end if formatflag = 1 forp = 1 tget [F,forp] line line = trm(line) if line = "" or line con "no" or line con "No" putc Reduced size = No line = "" else putc Reduced size = Yes end else /* formatflag = 0 or 2 line = "" /* reduced size no longer a choice if formatflag = 2 ++forp tput [F,forp] Reduced size = no end end if line <> "" hxpar(3) = 520 hxpar(4) = 2270 lowerlim = 2400 toplim = 100 else if maxnotesize = 6 lowerlim = 1250 toplim = 60 else lowerlim = 2900 toplim = 140 end end simple_test = 0 if formatflag <> 1 putc Enter a non-blank line if this is a simple test getc line line = trm(line) if line <> "" simple_test = 1 end end if formatflag = 1 ++forp tget [F,forp] line .t1 i line = trm(line) if line = "" or line con "default" or i = 0 psq(1) = toplim - 20 putc Height of new typesetting = top of page else psq(1) = i putc Height of new typesetting = ~i end else /* formatflag = 0 or 2 putc Height of new typesetting (return = top) getc line .t1 i line = trm(line) if line <> "" psq(1) = i else psq(1) = toplim - 20 end if formatflag = 2 if line = "" line = "Use default height for new typesetting" end ++forp tput [F,forp] ~line end end if formatflag = 1 ++forp tget [F,forp] line line = trm(line) if line = "" or line con "No tacit instructions" line = "" putc No line of tacit instructions else putc Line of tacit instructions = ~line end else /* formatflag = 0 or 2 putc Line of tacit instructions? (return = none) getc line line = trm(line) if formatflag = 2 ++forp if line = "" tput [F,forp] No tacit instructions else tput [F,forp] ~line end end end tacetline = line justflag = 0 if formatflag = 1 ++forp tget [F,forp] line line = trm(line) if line con "yes" or line con "Yes" putc Production copy; right justify last line. justflag = 2 else putc Proof copy only; do not try to justify last line. end #if SCROLL_OUT justflag = 0 #endif &dA &dA &d@ Variable "wide" feature added &dA01/01/09&d@ &dA #if WIDE hxpar(3) = 100 hxpar(4) = 2350 #else if line con "wide" line = line // " " line = line{mpt..} if line con " " line = line{mpt..} end tput [GN,1] ~line a = 1000 b = 1000 tget [GN,1] a b if a = 1000 a = 100 end if b = 1000 b = 100 end hxpar(3) -= a hxpar(4) += b end #endif &dA else /* formatflag = 0 or 2 #if SCROLL_OUT justflag = 0 if formatflag = 2 ++forp tput [F,forp] Justify = no end #else putc Right justify last line? (return = no) Also, enter "wide" command here. getc line &dA &dA &d@ &dA03/06/09&d@ Adding code here to allow margins to be set by the "wide" command &dA a = 0 b = 0 if line con "wide" line = line{mpt..} line = line // " " if line con " " line = line{mpt..} end line = trm(line) if line = "" a = 100 b = 100 line = "y" else tput [GN,1] ~line a = 1000 b = 1000 tget [GN,1] a b if a = 1000 a = 100 end if b = 1000 b = 100 end end hxpar(3) -= a hxpar(4) += b &dA else line = trm(line) end if formatflag = 2 ++forp if line = "" tput [F,forp] Justify = no else if a <> 0 or b <> 0 /* This condition new &dA03/06/09 tput [F,forp] Justify = yes wide ~a ~b else tput [F,forp] Justify = yes end end end if line <> "" justflag = 2 end #endif end if formatflag = 1 ++forp tget [F,forp] line line = trm(line) if line = "" or line con "No movement title" putc No movement title line = "" else putc Movement title = ~line end else /* formatflag = 0 or 2 putc Movement title? getc line line = trm(line) if formatflag = 2 ++forp if line = "" tput [F,forp] No movement title else tput [F,forp] ~line end end end mvtline = line &dA &dA &d@ &dA &dA &d@ &dA 1. ask for brace/bracket/bar structure &dA &d@ &dA &dA if formatflag = 1 ++forp tget [F,forp] syscode putc Syscode = ~syscode a = 0 b = 0 loop for i = 1 to len(syscode) if "[](){}" con syscode{i} c = mpt + 1 >> 1 ++tarr(c) ++a if bit(0,tarr(c)) <> bit(0,mpt) putc Incompatable syscode; please enter by hand goto SQ end end if "x:" con syscode{i} f(b+1,12) = mpt syscode{i} = "." else f(b+1,12) = 0 end if syscode{i} = "." ++b loop for c = 1 to 3 if bit(0,tarr(c)) <> 0 goto SQ11 end repeat putc Incompatable syscode; please enter by hand goto SQ end SQ11: repeat if b <> f11 putc Incompatable syscode; please enter by hand goto SQ end if bit(0,a) = 1 putc Incompatable syscode; please enter by hand goto SQ end goto WWW end SQ: putc Enter brace/bracket/bar structure putc [] = bracket and bar () = bar only {} = brace dot = part colon = grandstaff getc syscode savesyscode = syscode a = 0 b = 0 loop for i = 1 to len(syscode) if "[](){}" con syscode{i} c = mpt + 1 >> 1 ++tarr(c) ++a if bit(0,tarr(c)) <> bit(0,mpt) goto SQ end end if "x:" con syscode{i} f(b+1,12) = mpt syscode{i} = "." else f(b+1,12) = 0 end if syscode{i} = "." ++b loop for c = 1 to 3 if bit(0,tarr(c)) <> 0 goto SQ1 end repeat goto SQ end SQ1: repeat if b <> f11 goto SQ end if bit(0,a) = 1 goto SQ end if formatflag = 2 ++forp tput [F,forp] ~savesyscode end &dA &dA &d@ 2. set spacing for lines &dA WWW: loop for i = 1 to 30 w(i) = 0 repeat if formatflag = 1 ++forp tget [F,forp] bigline bigline = bigline // " |" sub = 1 loop for i = 1 to 30 a = int(bigline{sub..}) if a = 0 i = 30 else w(i) = a end repeat putc Spacings = ... if w(1) = 0 putc default: Music with text = ~vpar(1,11) With no text = ~vpar(1,14) else loop for i = 1 to f11 if w(i) = 0 putc Not enough spaces; you need ~f11 putc Please fix the format file: ~formatfile putc and try again. putc putc &dAProgram Halted&d@ putc stop end repeat if w(f11+1) <> 0 putc Too many spaces; you need ~f11 putc Please fix the format file: ~formatfile putc and try again. putc putc &dAProgram Halted&d@ putc stop end loop for j = 1 to 30 if w(j) > 0 putc ~w(j) ... else putc j = 30 end repeat end else /* formatflag = 0 or 2 putc Line spacing: text, no text (return = no change) putc Otherwise, enter all spacings (max of 15 per line) putc ~vpar(1,11) ~vpar(1,14) temp1 = "" temp2 = "" getc w(1) w(2) w(3) w(4) w(5) w(6) w(7) w(8) w(9) w(10) w(11) w(12) w(13) w(14) w(15) .t1 temp1 if w(15) <> 0 getc w(16) w(17) w(18) w(19) w(20) w(21) w(22) w(23) w(24) w(25) w(26) w(27) w(28) w(29) w(30) .t1 temp2 loop for i = 1 to f11 if w(i) = 0 putc Not enough spaces; you need ~f11 goto WWW end repeat if w(f11+1) <> 0 putc Too many spaces; you need ~f11 goto WWW end end temp1 = trm(temp1) temp2 = trm(temp2) if formatflag = 2 if temp1 = "" bigline = "Spacings = default" else bigline = temp1 // " " // temp2 bigline = trm(bigline) end ++forp tput [F,forp] ~bigline end end putc loop for i = 2 to f11 if w(1) = 0 if f(i-1,9) = 0 psq(i) = psq(i-1) + vpar(i-1,14) else psq(i) = psq(i-1) + vpar(i-1,11) end else psq(i) = psq(i-1) + w(i-1) end if f(i-1,12) = 2 if vst(i-1) = 0 vst(i-1) = vpar(i-1,14) end psq(i) += vst(i-1) else vst(i-1) = 0 end repeat if f(f11,12) = 2 if vst(f11) = 0 vst(f11) = vpar(f11,14) end end #if XVERSION #else if formatflag = 2 open [1,2] formatfile loop for i = 1 to forp tget [F,i] bigline bigline = trm(bigline) putf [1] ~bigline repeat close [1] end #endif no_action = 0 psysnum = 0 edflag = 0 start_look = 1 pn_left = 0 &dA &dA &d@ This code added &dA12/24/03&d@ to set new variables intersys and firstsys &dA if w(1) = 0 intersys = vpar(f11,14) * 3 / 2 else intersys = w(f11) end firstsys = TRUE return &dA &dA &d@ &dA &d@*P XXIV. procedure show_Ytable &dA &d@ &dA &d@ For debug purposes, show us what has been put into the Y table &dA procedure show_Ytable int i putc Current contents of Y table. Size = ~mainyp putc loop for i = 1 to mainyp tget [Y,i] line putc ~line repeat putc return &dF &dF &d@ spaging code &dF &dF #if SCORE_PARS &dA &dA &d@ &dA &d@*P XXV(a). process_and_transfer (size) &dA &d@ &dA &d@ Transfer Y-table to output file &dA &dA &d@ Input: size = last record to transfer &dA procedure process_and_transfer (size) str line.200 int size int i getvalue size open [3,2] outfile if f11 > 1 &dA &dA &d@ &dA03/25/06&d@ Data to support analysis &dA if andata_flag = 1 loop for i = 1 to tq_size tget [Q,i] line line = trm(line) putf [3] ~line repeat loop for f12 = 1 to f11 putf [3] @ SOURCE: ~@sources(f12) repeat andata_flag = 2 end loop for i = 1 to size tget [Y,i] line line = trm(line) if line{1} = "S" and andata_flag > 0 putf [3] ~@system end putf [3] ~line repeat close [3] return end loop for i = 1 to size tget [Y,i] line line = trm(line) putf [3] ~line repeat close [3] return &dL &dL &d@ xmskpage code &dL &dL #else &dA &dA &d@ &dA &d@*P XXV(b). procedure output_page (size) &dA &d@ &dA &d@ Transfer Y-table to output file &dA procedure output_page (size) str line2.200 int size int h,i,j,k int a,b,c,d,e int next_obx,prior_obx,current_obx int next_i int gap,minspace,gap2,length,shift int flag getvalue size open [3,2] outfile if f11 > 1 &dA &dA &d@ &dA03/25/06&d@ Data to support analysis &dA if andata_flag = 1 loop for i = 1 to tq_size tget [Q,i] line line = trm(line) putf [3] ~line repeat loop for f12 = 1 to f11 putf [3] @ SOURCE: ~@sources(f12) repeat andata_flag = 2 end loop for i = 1 to size tget [Y,i] line line = trm(line) if line{1} = "S" and andata_flag > 0 putf [3] ~@system end putf [3] ~line repeat close [3] return end gap = maxnotesize * 2 minspace = gap * 2 + 90 loop for i = 1 to size tget [Y,i] line line = line // pad(6) if line{1,5} = "J S 4" current_obx = int(line{7..}) line = line{sub..} line = mrt(line) loop for j = i + 1 to size tget [Y,j] line2 if line2{1} = "J" b = int(line2{5..}) next_obx = int(line2{sub..}) /* next obx next_i = j - 1 j = size end repeat loop for j = i - 1 to 1 step -1 tget [Y,j] line2 if line2{1} = "J" and line2{3} <> "D" and line2{3} <> "M" /* New &dA02/13/09 b = int(line2{5..}) prior_obx = int(line2{sub..}) /* prior obx &dA &dA &d@ New &dA02/13/09&d@ &dA if line2{3} = "K" k = int(line2{5..}) if k > 0 prior_obx += (k * hpar(f12,6)) end if k < 0 prior_obx -= (k * hpar(f12,7)) end end &dA j = 1 end repeat k = next_obx - prior_obx if k > minspace flag = 0 h = k / minspace gap2 = gap * h h = prior_obx + gap2 length = next_obx - h - gap2 shift = length - 90 / 2 line = "J S 4 " // chs(h) // " " // line putf [3] ~line loop for j = i + 1 to next_i tget [Y,j] line2 if line2{1} = "K" a = int(line2{3..}) b = int(line2{sub..}) c = int(line2{sub..}) if c > 70 and c < 81 a += shift putf [3] K ~a ~b ~c end if c = 62 if a = 0 putf [3] K 0 ~b 62 else putf [3] K ~length ~b 62 end end if c = 92 and flag = 0 flag = 1 a = length loop while a > 30 d = a - 30 putf [3] K ~d ~b 92 a -= 30 repeat putf [3] K 0 ~b 92 end end repeat i = next_i end else line = trm(line) putf [3] ~line end repeat close [3] return &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dL &d@ End of split &dL &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL &dF &dL #endif &dA &dA &d@ &dA &d@*P XXX. procedure look_dir (name) &dA &d@ &dA &d@ look inside directory (name) &dA procedure look_dir (name) str name.200 str line.200 int i getvalue name open [7,1] name loop for i = 1 to 2000 getf [7] line line = line{33..} line = line // pad(20) line = line{1,20} dir_contents(i) = trm(line) repeat eof7: close [7] dir_size = i - 1 return &dA &dA #if XVERSION &dA This is a GIANT #if section -- extending to the End of the Program &dA &dA &d@ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ &dA &d@ ³ Below this point, the code derives from the ESKPAGE program. The ³ &dA &d@ ³ main program is cast as a procedure, with all of its own variables. ³ &dA &d@ ³ The exception is those variables which are "inter-procedural" in ³ &dA &d@ ³ ESKPAGE and therefore must be declared globally. To avoid "clashes" ³ &dA &d@ ³ with MSKPAGE variables of the same name, these variables have been ³ &dA &d@ ³ given the prefix "esk" ³ &dA &d@ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ &dA &dA &d@ ESKPAGE program. Rewritten as a procedure &dA procedure eskpage notesize = 14 sizenum = 8 &dA &dA &d@ Initialize display strings &dA setup curstr,5,32,1,0,0,160,904 setup msgstr,160,60,1 setup redmsgstr,160,60,1 msgstr{8341,160} = gline{1,160} /* line 3 + 50 50 x 160 = 100 x 80 = 8000 msgstr{8501,160} = gline{1,160} /* line 4 + 50 msgstr{8661,160} = gline{1,160} /* line 5 + 50 msgstr{8821,160} = gline{1,160} /* line 6 + 50 perform setupmsg activate msgstr,0,MSGVLOC,1 activate redmsgstr,0,MSGVLOC,4 setup gstr,300,3100,3,0,0,160,904 setup tstr2,160,1600,1,0,0,160,904 setup tstr3,160,1040,1,0,0,160,904 setup tstr4,160,910,1,0,0,160,904 setup red_gstr,300,3100,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 setup red_tstr3,160,1040,1,0,0,160,904 setup red_tstr4,160,910,1,0,0,160,904 bitmode 2, xze, yze xze >>= 3 &dA &dA &d@ Transfer source file to Z table &dA oldk = 0 object_count = 0 super_count = 0 savecurnode = 0 loop for i = 1 to 2000 loop for k = 1 to 10 pointers(i,k) = 0 repeat repeat loop for i = 1 to 500 loop for k = 1 to 4 super_pointers(i,k) = 0 repeat repeat loop for i = 1 to 200 temp_store_ob(i,1) = 0 temp_store_ob(i,2) = 0 repeat loop for i = 1 to 1000 nodelist(i,1) = 0 nodelist(i,2) = 0 repeat loop for i = 1 to 30 system_rec(i) = 0 repeat &dA &dA &d@ New code added &dA12/06/03&d@ implementing pointers from bar objects to bar records &dA loop for i = 1 to 1000 barlinks(i) = 0 repeat barlink_cnt = 0 &dA system_cnt = 0 nodelistcnt = 0 relob_cnt = 0 current_line = "" current_def = "" treset [X] treset [X2] k = 0 loop for y3p = y1p to y2p ++k tget [Y,y3p] line &dK &d@ getf [1] line &dE CHANGE THIS APPARATUS line = line // " " list_order(k,1) = k - 1 list_order(k,2) = k + 1 list_order(k,3) = 0 list_order(k,4) = 0 list_order(k,5) = 0 if line{1} = "J" ++object_count tput [X,k] J ~object_count .t8 ~line{3..} tget [X,k] .t8 jtype ntype obx oby z nodenum i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) if supcnt > 0 i = 1 loop for j = 1 to supcnt loop while temp_store_ob(i,1) <> 0 ++i repeat temp_store_ob(i,1) = k temp_store_ob(i,2) = o(j) repeat end pointers(object_count,1) = k pointers(object_count,7) = linepoint pointers(object_count,8) = syspoint pointers(object_count,10) = larr_gen(y3p) if trigger > 0 if nodenum < 6913 if trigger = 1 ++measnum trigger = 0 end if trigger = 2 &dK &d@ if jtype = "R" and ntype = 9 and nodenum = 1 and oldrestx <> obx if "Rr" con jtype and ntype = 9 and nodenum = 1 and oldrestx <> obx /* New &dA10/15/07 ++measnum else trigger = 0 end end end end curnode = 10000 * measnum + nodenum if jtype = "M" and curnode <> savecurnode and nodenum = 6913 i = savecurnode / 10000 if rem <> 6913 curnode = savecurnode end end pointers(object_count,9) = curnode if curnode <> savecurnode if savecurnode <> 0 i = object_count - 1 loop while pointers(i,9) = savecurnode pointers(i,3) = object_count /* forward pointer --i repeat while i > 0 xbacknode = xsavecurnode else xbacknode = object_count end savecurnode = curnode xsavecurnode = object_count &dA &dA &d@ Look for this node in the node list &dA xupnode = object_count loop for i = 1 to nodelistcnt if nodelist(i,1) = curnode /* this node has occured before xupnode = nodelist(i,2) nodelist(i,2) = object_count j = xupnode loop while pointers(j,9) = pointers(xupnode,9) pointers(j,6) = object_count /* adjust pointers from line above ++j /* to this line repeat goto NODEFOUND end repeat ++nodelistcnt /* add new node to list nodelist(nodelistcnt,1) = curnode nodelist(nodelistcnt,2) = object_count NODEFOUND: end pointers(object_count,4) = xbacknode /* backward pointer pointers(object_count,5) = xupnode /* pointer to line above pointers(object_count,6) = xsavecurnode /* pointer to line below if jtype = "B" and nodenum = 6913 trigger = 1 &dA &dA &d@ New code added &dA12/06/03&d@ implementing pointers from bar objects to bar records &dA ++barlink_cnt barlinks(barlink_cnt) = k &dA end &dK &d@ if jtype = "R" and ntype = 9 and nodenum = 1 if "Rr" con jtype and ntype = 9 and nodenum = 1 /* New &dA10/15/07 trigger = 2 oldrestx = obx end else if line{1} = "H" ++super_count supernum = int(line{3..}) tput [X,k] H ~super_count .t8 ~line{3..} super_pointers(super_count,1) = k super_pointers(super_count,3) = relob_cnt + 1 j = 0 loop for i = 1 to 200 if temp_store_ob(i,2) = supernum ++relob_cnt ++j related_objects(relob_cnt) = temp_store_ob(i,1) temp_store_ob(i,1) = 0 temp_store_ob(i,2) = 0 end repeat super_pointers(super_count,4) = j else tput [X,k] ~line if line{1} = "S" tget [X,k] line a = int(line{5..}) b = int(line{sub..}) line = "S 0 " // chs(a) // " 120" // line{sub..} tput [X,k] ~line syspoint = k loop for i = 1 to nodelistcnt nodelist(i,1) = 0 nodelist(i,2) = 0 repeat nodelistcnt = 0 ++system_cnt system_rec(system_cnt) = k list_order(k,3) = -1 list_order(k,5) = -1 barlink_cnt = 0 /* added &dA12/06/03&d@ end if line{1} = "L" or line{1} = "l" linepoint = k measnum = 0 trigger = 1 list_order(k,3) = -1 list_order(k,5) = -1 end &dA &dA &d@ New code added &dA12/06/03&d@ implementing pointers from bar objects to bar records &dA if line{1} = "B" loop for i = 1 to barlink_cnt a = barlinks(i) /* pointer to a bar object tget [X,a] .t3 b .t10 c obx d = int(line{3..}) d = int(line{sub..}) /* x-pos of bar if obx = d pointers(b,2) = k /* build link from bar object to this record end repeat end &dA end end repeat list_order(1,1) = TOP_FLAG /* top of list indicator list_order(k,2) = BOTTOM_FLAG /* bottom of list indicator table_size = k obcursor = 1 if super_count = 0 supercursor = 0 else supercursor = 1 end perform setcurloc (obcursor,X_point) /* Start at first object #if REPORT3 putc Done! #endif f04 = k con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct i = 0 perform pan (i) /* i is a return flag trap: if trp = 1 putc You have pushed to stop the program. putc putc &dA P R O G R A M H A L T E D putc stop end if trp = 10 putc putc &dE TERMINATION NOTICE !!! putc putc The ESKPAGE module is confused about something you did. It putc is most probably &dEnot&d@ your fault, but rather a shortcoming in putc the ESKPAGE program. Unfortunately, you have no option at putc this point other that to try running mskpage again. Hopefully putc this problem will not re-occur. putc putc &dA P R O G R A M H A L T E D putc stop end h = 1 TR1: g = list_order(h,1) if g <> TOP_FLAG h = g goto TR1 end &dA &d@ &dE &dA &d@ &dE TRANSFER APPARATUS &dA &d@ &dE y3p = sv_mainyp /* putting back the records for this system TR2: a = list_order(h,4) if a = 0 tget [X,h] line else tget [X2,a] line end if "JH" con line{1} line = line{1,2} // line{8..} end ++y3p if y3p > y1p /* don't put back system record tput [Y,y3p] ~line end &dK &d@ putf [8] ~line g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto TR2 end mainyp = y3p /* I think this does it if trp = 1 or trp = 10 putc .b27 Y.b27 F... putc putc putc &dA P R O G R A M H A L T E D putc stop end return &dAÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dAº º&d@ &dAº P R O C E D U R E S º&d@ &dAº º&d@ &dAÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ &dA &d@ &dA &dA &d@*P&dA 1. esksetbeam &dA &d@ &dA &dA &d@ Purpose: Typeset beams and accompanying notes and &dA &d@ stems. Also typeset accompanying tuplet, if present &dA &dA &d@ Inputs: bcount = number of notes under beam &dA &d@ beamdata(.,1) = x-position of note &dA &d@ beamdata(.,2) = y-position of note &dA &d@ beamcode(.) = beam code &dA &dA &d@ beam code = 6 digit number (string) &dA &dA &d@ 0 = no beam &dA &d@ 1 = continue beam &dA &d@ 2 = begin beam &dA &d@ 3 = end beam &dA &d@ 4 = forward hook &dA &d@ 5 = backward hook &dA &d@ 6 = single stem repeater &dA &d@ 7 = begin repeated beam &dA &d@ 8 = end repeated beam &dA &dA &d@ 100000's digit = eighth level beams &dA &d@ 10000's digit = 16th level beams &dA &d@ 1000's digit = 32nd level beams &dA &d@ 100's digit = 64th level beams &dA &d@ 10's digit = 128th level beams &dA &d@ 1's digit = 256th level beams &dA &dA &dA &d@ @k = distance from first object (oby of &dA &d@ note group) to top of top beam (for &dA &d@ stems up) or bottom of bottom beam &dA &d@ (for stems down). @k > 0 means &dA &d@ stem up. &dA &d@ @m = number of dots the beam falls &dA &d@ (rises = negative) in a distance &dA &d@ of 30 horizontal dots. (i.e. &dA &d@ slope * 30) &dA &d@ beamfont = font for printing beam &dA &d@ stemchar = character number for stem &dA &d@ beamh = height parameter for beams &dA &d@ beamt = vertical space between beams (normally eskvpar(32)) &dA &d@ qwid = width of quarter note (normally eskhpar(3)) &dA &d@ tupldata(1) = tuplet situation flag &dA &d@ tupldata(2) = tuplet number &dA &d@ tupldata(3) = x1 offset &dA &d@ tupldata(4) = x2 offset &dA &d@ tupldata(6) = y1 offset / For case where tuple goes over &dA &d@ tupldata(7) = y2 offset \ note heads &dAand&d@ there are chords. &dA &d@ tbflag = print tuplet flag &dA &dA &d@ Outputs: prints out beams, stems and notes by means of &dA &d@ procedures, printbeam, hook and revset. &dA &dA &d@ Internal variables: &dA &d@ beamfy = y coordinate of first note under beam &dA &d@ @b = y-intercept of beam &dA &d@ @f = temporary variable &dA &d@ @g = temporary variable (related to @@g) &dA &d@ @h = temporary variable &dA &d@ @i = temporary variable &dA &d@ @j = temporary counter &dA &d@ @k = |@m| &dA &d@ @n = temporary variable &dA &d@ @q = temporary counter &dA &d@ @s = temporary variable &dA &d@ @t = temporary variable &dA &d@ @@b = vertical range of note set &dA &d@ @@g = top of staff line &dA &d@ @@n = temporary variable &dA &d@ @@q = temporary variable &dA &d@ bthick = thickness of beam - 1 &dA &d@ (x1,y1) = temporary coordinates &dA &d@ (x2,y2) = temporary coordinates &dA &d@ z1,z2,z3 = temporary character numbers &dA &d@ stemdir(80) = stem directions for mixed direction case &dA &d@ stemends(80) = stem endpoints for mixed direction case &dA &d@ beampos(8) = position of beam (mixed stem dir) &dA &d@ beamlevel = index into beampos(one for each note belonging to beam) &dA &d@ procedure esksetbeam int @b,@f,@g,@h,@i,@j,@n,@q,@s,@t int @@b,@@g,@@n,@@q int z2,mixflag int stemends(80),stemdir(80),beampos(8),beamlevel(MAX_BNOTES) int savex1 int staff_height int t1,t2 /* NEW int bshflg &dA &dA &d@ check for errors in beam repeaters &dA loop for @j = 1 to bcount if beamcode(@j) con "7" or beamcode(@j) con "8" if bcount <> 2 putc Improper use of beam repeaters goto BERR end loop for @j = 1 to 6 if "270" con beamcode(1){@j} if beamcode(1){@j} = "2" if beamcode(2){@j} <> "3" putc Mismatching beamcodes goto BERR end end if beamcode(1){@j} = "7" if beamcode(2){@j} <> "8" putc Mismatching beamcodes goto BERR end end if beamcode(1){@j} = "0" if beamcode(2){@j} <> "0" putc Mismatching beamcodes goto BERR end end else putc Improper use of beam repeaters goto BERR end repeat @j = 10000 end repeat &dA &dA &d@ Determine direction of first stem &dA if @k = 0 or @k = 1 putc Old format for beams. This code has been disabled. putc Please run mskpage on data to get current format. putc putc &dAProgram Halted&d@ putc stop end if @k > 0 stem = UP else stem = DOWN end &dA &dA &d@ Check for situation where notes span two staves (grand staff) &dA staff_height = 0 if eskvst(eskf12) > 0 @g = beamdata(1,2) loop for @j = 2 to bcount if abs(beamdata(@j,2) - @g) > 500 staff_height = 10000 @j = 10000 end repeat end &dA &dA &d@ Adjust all y coordinates be relative to the top staff &dA loop for @j = 1 to bcount if beamdata(@j,2) - esksq(eskf12) > 700 beamdata(@j,2) -= 1000 beamdata(@j,2) += eskvst(eskf12) if staff_height <> 10000 staff_height = eskvst(eskf12) end end repeat &dA &dA &d@ Check for mixed stem directions &dA mixflag = 0 loop for @j = 2 to bcount @h = beamdata(@j,1) - beamdata(1,1) * @m / 30 @h = @h + beamdata(1,2) - @k - beamdata(@j,2) if @h < 0 if stem = DOWN mixflag = 1 @j = 10000 end else if stem = UP mixflag = 1 @j = 10000 end end repeat &dA &dA &d@ Deal with tuplets attached to &dAnote heads&d@ &dA if tbflag = 1 @f = beamdata(bcount,1) - beamdata(1,1) @g = beamdata(bcount,2) - beamdata(1,2) * 30 @t = @g / @f @s = 0 @n = bcount - 1 loop for @i = 2 to @n @h = beamdata(@i,1) - beamdata(1,1) * @t / 30 + beamdata(1,2) @q = beamdata(@i,2) - @h if stem = DOWN @q = 0 - @q end if @q > @s @s = @q end repeat if stem = DOWN @j = eskvpar(39) + @s + esksq(eskf12) y1 = beamdata(1,2) - @j y2 = beamdata(bcount,2) - @j else @j = eskvpar(39) + eskvpar(38) + @s - esksq(eskf12) y1 = beamdata(1,2) + @j y2 = beamdata(bcount,2) + @j end &dA &dA &d@ Adding code &dA05/09/03&d@ to make space for numbers inside brackets &dA sitflag = tupldata(1) @s = eskvpar(1) if bit(0,sitflag) = 1 /* number present if bit(1,sitflag) = 1 /* bracket present if bit(4,sitflag) = 0 /* number near note head if bit(5,sitflag) = 1 /* continuous bracket if bit(6,sitflag) = 1 /* number inside if bit(2,sitflag) = 0 /* tips down y1 -= eskvpar(2) /* raise bracket y2 -= eskvpar(2) @s = eskvpar(3) else /* tips up y1 += eskvpar(2) /* lower bracket y2 += eskvpar(2) @s = eskvpar(2) end end end end end end if stem = DOWN if staff_height <> 10000 &dA &dA &d@ Code fix &dA11/30/07&d@ trying a new algorithm for avoiding clash &dA &d@ with staff line. &dA &dK &d@ @h = 0 - notesize * 2 / 3 + staff_height - @s &dK &d@ if y1 > @h &dK &d@ y1 = @h &dK &d@ end &dK &d@ if y2 > @h &dK &d@ y2 = @h &dK &d@ end @h = 0 - notesize * 2 / 3 + staff_height if (y1 + tupldata(6)) > @h y1 = @h - tupldata(6) end if (y2 + tupldata(6)) > @h y2 = @h - tupldata(6) end &dA end else if staff_height <> 10000 &dA &dA &d@ Same code fix as above &dA11/30/07&d@ &dA &dK &d@ @h = 11 * notesize / 2 + staff_height + @s &dK &d@ if y1 < @h &dK &d@ y1 = @h &dK &d@ end &dK &d@ if y2 < @h &dK &d@ y2 = @h &dK &d@ end @h = 11 * notesize / 2 + staff_height if (y1 + tupldata(6)) < @h y1 = @h - tupldata(6) end if (y2 + tupldata(6)) < @h y2 = @h - tupldata(6) end &dA end end a1 = tupldata(2) x1 = tupldata(3) + beamdata(1,1) - esksp x2 = tupldata(4) + beamdata(bcount,1) - esksp y1 += tupldata(6) y2 += tupldata(7) perform puttuplet end bthick = beamfont - 101 beamfy = beamdata(1,2) &dA &dA &d@ Reverse all y co-ordinates if first stem is down &dA @g = esksq(eskf12) if stem = DOWN @g = eskvpar(2) * 500 - eskvpar(8) - @g loop for @j = 1 to bcount beamdata(@j,2) = eskvpar(2) * 500 - beamdata(@j,2) repeat end @@g = @g if stem = 1 @m = 0 - @m @k = 0 - @k end dv3 = @m * beamdata(1,1) dv3 = beamdata(1,2) - @k * eskhpar(1) - dv3 @k = abs(@m) @@q = 0 loop for @j = 1 to bcount @n = 5 if beamcode(@j) con "0" @n = mpt - 2 /* number of additional beams on this note end if @n > @@q @@q = @n /* max number of additional beams end repeat ++@@q if @@q > 3 beamt = eskvpar(33) end &dA &dA &d@ &dA &dA &d@ This is the printout portion of the procedure &dA &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ @m = eskhpar(1) * slope of beam &dA &dA &d@ @k = |@m| &dA &dA &d@ dv3 = y-intercept of top of beam (times eskhpar(1)) &dA &dA &d@ &dA &dA &dA &dA &d@ identify beam characters &dA z1 = @k + 33 if @m > 0 z1 += 128 end z2 = @k + 49 if @m > 0 z2 += 128 end &dA &dA &d@ check for tuplet over beam &dA if tbflag = 2 sitflag = tupldata(1) if bit(7,sitflag) = 1 /* curved bracket &dA03/15/97&d@ a4 = 0 - 2 * qwid / 3 if stem = UP a4 = qwid / 3 end else a4 = 0 - qwid / 3 if stem = UP a4 = 2 * qwid / 3 end end a1 = tupldata(2) x1 = beamdata(1,1) + a4 - esksp + tupldata(3) x2 = beamdata(bcount,1) + a4 - esksp + tupldata(4) y1 = @m * beamdata(1,1) + dv3 / eskhpar(1) y2 = @m * beamdata(bcount,1) + dv3 / eskhpar(1) if stem = DOWN y1 = eskvpar(2) * 500 - y1 - bthick - esksq(eskf12) + eskvpar(39) + eskvpar(38) y2 = eskvpar(2) * 500 - y2 - bthick - esksq(eskf12) + eskvpar(39) + eskvpar(38) else y1 = y1 - eskvpar(39) - esksq(eskf12) y2 = y2 - eskvpar(39) - esksq(eskf12) end y1 += tupldata(6) y2 += tupldata(7) perform puttuplet end &dA &dA &d@ Here the situation diverges &dA &dA &d@ Case I: all stems go in the same direction &dA &d@ Case II: stem directions are mixed &dA &dA &dA &d@ Case I: all stems go in the same direction &dA if mixflag = 0 &dA &dA &d@ put in first beam &dA x1 = beamdata(1,1) x2 = beamdata(bcount,1) if beamcode(1){1} = "7" x1 += eskhpar(59) x2 -= eskhpar(59) end perform printbeam &dA &dA &d@ put in vertical stems &dA loop for @j = 1 to bcount x1 = beamdata(@j,1) y1 = @m * x1 + dv3 / eskhpar(1) + eskvpar(42) y1 += eskvpar(4) y2 = beamdata(@j,2) z3 = stemchar if y1 >= y2 z3 += 2 y1 -= eskvpar(2) loop while y1 < y2 perform revset y1 += eskvpar(2) repeat else loop while y1 < y2 perform revset y1 += eskvpar(4) repeat end y1 = y2 perform revset repeat &dA &d@ &dA &d@ put in other beams &dA loop for @q = 2 to @@q if beamcode(1){@q} = "7" dv3 = (eskvpar(2) + beamt) * eskhpar(1) / 2 + dv3 else if beamcode(1){@q} = "6" dv3 = eskvpar(2) * eskhpar(1) + dv3 else dv3 = beamt * eskhpar(1) + dv3 end end bshflg = 0 loop for @j = 1 to bcount if "123456780" con beamcode(@j){@q} if mpt = 2 @i = @j BB1: ++@j if @j > bcount putc @j (~@j ) exceeds bcount (~bcount ) goto BERR end if "1234560" con beamcode(@j){@q} if mpt = 1 goto BB1 else if mpt = 3 * // print beam if @i > 1 and bshflg = 0 dv3 += (3 * eskhpar(1) / 8) bshflg = 1 end x1 = beamdata(@i,1) x2 = beamdata(@j,1) perform printbeam goto BBR * \\ else putc expecting a "1" or a "3" here (got a ~beamcode(@j){@q} ) putc beamcode(~@j ) = ~beamcode(@j) goto BERR end end end end if mpt = 7 * // print beam x1 = beamdata(1,1) + eskhpar(59) x2 = beamdata(2,1) - eskhpar(59) perform printbeam goto BBR * \\ end if mpt = 1 putc "1" not allowed in this position goto BERR end if mpt = 3 putc "3" not allowed in this position goto BERR end t1 = eskhpar(1) >> 1 if mpt = 4 * // print forward hook x1 = beamdata(@j,1) + eskhpar(29) y = @m * x1 + dv3 + t1 / eskhpar(1) z = z2 + 16 perform hook * \\ end if mpt = 5 * // print backward hook x1 = beamdata(@j,1) y = @m * x1 + dv3 + t1 / eskhpar(1) x1 -= eskhpar(30) z = z2 perform hook * \\ end if mpt = 6 * // print forward and backward hooks to make cross piece x1 = beamdata(@j,1) y1 = @m * x1 + dv3 + t1 / eskhpar(1) x1 -= 5 y = y1 if @m > 0 y -= int("111111222222233"{@m}) end if @m < 0 y += int("111111222222233"{0-@m}) end z = z2 + 16 perform hook x1 -= eskhpar(30) - eskhpar(29) - 10 /* = 7 y = y1 if @m > 0 y += int("000111111222222"{@m}) end if @m < 0 y -= int("000111111222222"{0-@m}) end z = z2 perform hook * \\ end end BBR: repeat repeat else &dA &dA &d@ Case II: stem directions are mixed &dA &dA &d@ 1. Determine definitive stem directions and end points &dA &d@ on main staff. &dA loop for @j = 1 to bcount x1 = beamdata(@j,1) y1 = @m * x1 + dv3 / eskhpar(1) + 4 /* middle of main beam y2 = beamdata(@j,2) /* oby of note if y1 < y2 stemdir(@j) = UP else stemdir(@j) = DOWN /* different x intersection if stem = UP /* direction of &dAfirst&d@ stem x1 -= qwid - eskhpar(29) else x1 += qwid - eskhpar(29) end y1 = @m * x1 + dv3 / eskhpar(1) + 4 end stemends(@j) = y1 repeat &dA &dA &d@ 2. Put in first beam &dA x1 = beamdata(1,1) /* stemdir(1) is always UP x2 = beamdata(bcount,1) if stemdir(bcount) = DOWN if stem = UP x2 -= qwid - eskhpar(29) else x2 += qwid - eskhpar(29) end end perform printbeam beampos(1) = dv3 &dA &dA &d@ 2a. Set beamlevel = 1 for all notes. beamlevel for notes will change &dA &d@ as we move through the beam. Basically, if notes A and B start &dA &d@ and end a beam respectively, then beamlevel will be given the &dA &d@ same value for all of these notes and any that might be in between. &dA &d@ If another beam extends between notes C and B, then beamlevel &dA &d@ for these notes will be increased. In the end, beamlevel for each &dA &d@ note will be the number of beams connecting or going through the &dA &d@ stem for that note. &dA loop for @j = 1 to bcount beamlevel(@j) = 1 repeat &dA &dA &d@ NEW &dA05/19/03&d@ I am going to attempt a rewrite of this section. The problem &dA &d@ with the old code was that it sometimes didn't give asthetically pleasing &dA &d@ solutions. In particular, the problem arises when a secondary beam is &dA &d@ to be drawn between endpoints whose stems are in different directions. &dA &d@ The old code made the arbitrary decision to draw the secondary beam according &dA &d@ to the direction of the stem of the initial note. This had the additional &dA &d@ advantage that stems could be drawn as notes were processed, i.e., we would &dA &d@ not have to go back and "lengthen" a stem because a secondary beam was &dA &d@ drawn on the other side of the primary. &dA &dA &d@ With this rewrite, I must change this, i.e., stems cannot be drawn until &dA &d@ all beams are set. Secondly, I need to come up with a set of rules as to &dA &d@ how to deal with the situation where the endpoints of a secondary connect &dA &d@ to stems of different directions. I propose to generate these rules from &dA &d@ experience, and by trial and error. As we encounter situations where the &dA &d@ result seems to violate common sense, then we can consider adding a new &dA &d@ rule. It should be pointed out that at the moment &dEthere is no provision &dA &d@ &dEmade for editing the decision made by this program&d@ as regards the placing &dA &d@ of secondary beams. To add this feature, we would need to expand the &dA &d@ contents of the beam super-object record. &dA &dA &d@ As of this data &dA05/19/03&d@, I have only one rule to propose for cases where &dA &d@ the endpoints have stems that go in different directions. &dA &d@ &dA &d@ 1. If there is a stem that follows the terminating stem, then use &dA &d@ use this stem direction to "arbitrate" between the directions of &dA &d@ the endpoint stems. If no stem follows, then the stem direction &dA &d@ of the initial note wins. &dA &dA &dA &d@ 3. Loop through notes, one at a time &dA loop for @j = 1 to bcount x1 = beamdata(@j,1) if stemdir(@j) = DOWN if stem = UP x1 -= qwid - eskhpar(29) else x1 += qwid - eskhpar(29) end end savex1 = x1 &dA &dA &d@ a. add &dAall&d@ extra beams starting at this note (and increase beamlevel accordingly) &dA loop for @h = beamlevel(@j) + 1 to 6 if beamcode(@j){@h} = "2" /* begin beam ++beamlevel(@j) /* increment beamlevel for starting point loop for @g = @j + 1 to bcount if beamcode(@g){@h} = "3" /* end beam x1 = savex1 /* x1 needs to be reset for each beam x2 = beamdata(@g,1) /* if stemdir(bcount) = DOWN if stemdir(@g) = DOWN /* Correction &dA9-21-96&d@ if stem = UP x2 -= qwid - eskhpar(29) else x2 += qwid - eskhpar(29) end end dv3 = beampos(1) &dA &dA &d@ Here is where the rules take effect. &dA &dA &d@ Case I: Use stem direction of first note to determine secondary beam position &dA &dA &d@ cases: 1) Normal: stemdir(@g) = stemdir(@j) &dA &dA &d@ 2) stemdir(@g) <> stemdir(@j) but &dA &d@ either @g = bcount &dA &d@ or stemdir(@g+1) = stemdir(@j) &dA t2 = 0 if stemdir(@g) <> stemdir(@j) if @g < bcount if stemdir(@g+1) <> stemdir(@j) t2 = 1 end end end if t2 = 0 loop for @f = 1 to beamlevel(@g) if stemdir(@j) = UP if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat ++beamlevel(@g) /* increment beamlevel for endpoint if stemdir(@j) = UP dv3 += (beamt * eskhpar(1)) else dv3 -= (beamt * eskhpar(1)) end beampos(beamlevel(@g)) = dv3 perform printbeam &dA &dA &d@ b. adjust stem ends for notes under (over) this beam &dA loop for @f = @j + 1 to @g if stemdir(@j) = UP if stemdir(@f) = DOWN stemends(@f) += beamt end else if stemdir(@f) = UP stemends(@f) -= beamt end end repeat else &dA &dA &d@ Case II: Use stem direction of last note to determine secondary beam position &dA &dA &d@ cases: 1) stemdir(@g) <> stemdir(@j), and &dA &d@ @g < bcount, and &dA &d@ stemdir(@g+1) = stemdir(@g) &dA loop for @f = 1 to beamlevel(@g) if stemdir(@g) = UP /* changing @j to @g if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat ++beamlevel(@g) /* increment beamlevel for endpoint if stemdir(@g) = UP /* changing @j to @g dv3 += (beamt * eskhpar(1)) else dv3 -= (beamt * eskhpar(1)) end beampos(beamlevel(@g)) = dv3 perform printbeam &dA &dA &d@ c. adjust stem ends for notes under (over) this beam &dA loop for @f = @j to @g if stemdir(@g) = UP /* changing @j to @g if stemdir(@f) = DOWN stemends(@f) += beamt end else if stemdir(@f) = UP stemends(@f) -= beamt end end repeat end @g = 10000 else &dA &dA &d@ Increment beamlevel for all notes between endpoints of this beam &dA ++beamlevel(@g) end repeat if @g <> 10000 putc No termination found for beam goto BERR end else @h = 6 end repeat &dA &dA &d@ d. put in any hooks that might go with this note &dA loop for @h = beamlevel(@j) + 1 to 6 if "456" con beamcode(@j){@h} /* begin beam @g = mpt loop for @f = 1 to beamlevel(@j) if stemdir(@j) = UP if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat if @g = 3 t1 = eskvpar(2) * eskhpar(1) else t1 = beamt * eskhpar(1) end if stemdir(@j) = UP dv3 += t1 else dv3 -= t1 end t1 = eskhpar(1) >> 1 if @g = 1 * // print forward hook x1 = savex1 + eskhpar(29) y = @m * x1 + dv3 + t1 / eskhpar(1) z = z2 + 16 perform hook end if @g = 2 * // print backward hook x1 = savex1 y = @m * x1 + dv3 + t1 / eskhpar(1) x1 -= eskhpar(30) z = z2 perform hook end if @g = 3 * // print forward and backward hooks to make cross piece x1 = savex1 y1 = @m * x1 + dv3 + t1 / eskhpar(1) x1 -= 5 y = y1 if @m > 0 y -= int("111111222222233"{@m}) end if @m < 0 y += int("111111222222233"{0-@m}) end z = z2 + 16 perform hook x1 -= eskhpar(30) - eskhpar(29) - 10 /* = 7 y = y1 if @m > 0 y += int("000111111222222"{@m}) end if @m < 0 y -= int("000111111222222"{0-@m}) end z = z2 perform hook end else @h = 6 end repeat repeat &dA &dA &d@ 4. Loop again through notes, one at a time, and now draw the stems (&dA05/19/03&d@) &dA loop for @j = 1 to bcount &dA &dA &d@ a. put in stem &dA x1 = beamdata(@j,1) if stemdir(@j) = DOWN if stem = UP x1 -= qwid - eskhpar(29) else x1 += qwid - eskhpar(29) end end savex1 = x1 if stemdir(@j) = UP y1 = stemends(@j) y2 = beamdata(@j,2) else y2 = stemends(@j) y1 = beamdata(@j,2) + 2 /* I think this is needed end y1 += eskvpar(4) z3 = stemchar if y1 >= y2 z3 += 2 y1 -= eskvpar(2) loop while y1 < y2 perform revset y1 += eskvpar(2) repeat else loop while y1 < y2 perform revset y1 += eskvpar(4) repeat end y1 = y2 perform revset repeat &dA &dA &d@ End of &dA05/19/03&d@ rewrite &dA end return BERR: putc Beam format error, printbeam aborted return &dA &d@ &dA &dA &d@*P&dA 2. hook &dA &d@ &dA &dA &d@ Purpose: Typeset hook beam &dA &dA &d@ Inputs: @m = slope * eskhpar(1) &dA &d@ x1 = horizontal position of note &dA &d@ y = vertical position of hook attachment &dA &d@ stem = stem direction &dA &d@ z = hook character &dA &d@ beamfont = type of font for beam &dA procedure hook x = x1 if stem = 1 y = eskvpar(2) * 500 - y - bthick z += 128 z &= 0xff else x += qwid - eskhpar(29) end scf = beamfont scx = x scy = y scb = z perform charout scf = notesize return &dA &d@ &dA &dA &d@*P&dA 3. printbeam &dA &d@ &dA &dA &d@ Purpose: Typeset beam &dA &dA &d@ Inputs: @m = slope * eskhpar(1) &dA &d@ x1 = starting point of beam &dA &d@ x2 = end point of beam &dA &d@ dv3 = y intercept of beam (times eskhpar(1)) &dA &d@ stem = stem direction &dA &d@ z1 = beam character number for this slop &dA &dA procedure printbeam int x3 x = x1 if stem = UP x += qwid - eskhpar(29) end scf = beamfont scx = x x2 = x2 + eskhpar(29) - eskhpar(1) y1 = @m * x1 + dv3 / eskhpar(1) if x2 < x1 and @k = 0 x2 = eskhpar(1) - eskhpar(2) + x2 /* no beam shorter than a "hook" y = y1 /* put out "overlapping" hooks if stem = DOWN y = eskvpar(2) * 500 - y - bthick else x2 += qwid - eskhpar(29) end PBEAM01: scy = y scb = 65 perform charout x += eskhpar(2) if x < x2 goto PBEAM01 end scx = x2 scb = 65 perform charout scf = notesize return end z = z1 if stem = DOWN z += 128 z &= 0xff end loop while x1 <= x2 y = y1 if stem = DOWN y = eskvpar(2) * 500 - y - bthick end scy = y scb = z perform charout x1 += eskhpar(1) y1 += @m repeat y2 = x2 + eskhpar(1) - x1 &dA &dA &d@ print fraction of beam &dA &d@ y2 = extra length needed to complete beam &dA if y2 = 0 scf = notesize return end y = y1 if stem = DOWN y = eskvpar(2) * 500 - y - bthick end &dA &d@ y = starting point if @k = 0 x = x1 - 30 + y2 if stem = UP x += qwid - eskhpar(29) end scx = x scy = y scb = 33 perform charout scf = notesize return end scy = y x3 = @k - 1 * 29 + y2 x2 = beamext(x3,1) y1 = 2 loop for y2 = 1 to x2 z = beamext(x3,y1) if @m > 0 z += 128 z &= 0xff end if stem = 1 z += 128 z &= 0xff end scb = z perform charout if y2 < x2 ++y1 x1 = beamext(x3,y1) if stem = 1 x1 = 0 - x1 end if @m > 0 x1 = 0 - x1 end y -= x1 scy = y ++y1 end repeat scf = notesize return &dA &d@ &dA &dA &d@*P&dA 4. revset &dA &d@ &dA &dA &d@ Purpose: Check for reversal of page and correct x y and z &dA &dA &d@ Inputs: x1 = horizontal position of note &dA &d@ y1 = vertical position of note &dA &d@ z3 = character to typeset &dA &d@ stem = stem direction &dA procedure revset x = x1 y = y1 z = z3 if stem = DOWN if z = 59 or z = 61 or z = 187 or z = 189 ++z end y = eskvpar(2) * 500 - y end perform setmus return &dA &d@ &dA &dA &d@*P&dA 5. setmus &dA &d@ &dA &dA &d@ Purpose: Typeset character &dA &dA &d@ Inputs: x = horizontal position of note &dA &d@ y = vertical position of note &dA &d@ z = character to typeset &dA &d@ sizenum = current scale size (1 to 12) &dA procedure setmus int sy,pz if z = 0 return end &dA &dA &d@ Implementing extended music font &dA02/19/06&d@ &dA if z > 999 pz = dummy(sizenum) sy = y z = extendoff(sizenum) + z - 1001 scx = x scy = sy scb = z scf = pz + 50 /* scf is intex into revmap producing fonts 48,49,50 perform charout scf = notesize return end &dA &dA &d@ End of &dA02/19/06&d@ addition sy = y - pos(z-32) scx = x scy = sy scb = z perform charout return &dA &dA &dA &d@ &dA04/22/04&d@ Setwords now occurs in one version: NEWFONTS &dA &dA &d@ &dA &dA &d@*P&dA 6. setwords &dA &d@ &dA &dA &d@ Purpose: Typeset words &dA &dA &d@ Inputs: x = horizontal position of words &dA &d@ y = vertical position of words &dA &d@ z = font number for words &dA &d@ line = words to set &dA &dA procedure setwords (a1) str textline.300 int t1 &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA &d@ 1 = setwords called from TEXT sub-obj &dA int a1 getvalue a1 &dA &dA &d@ &dA04/22/04&d@ This code taken from settext (&dA08/31/03&d@ &dIOK&d@) &dA if a1 = 1 and line = "&" return end &dA scx = x scy = y if z = 1 /* added &dA03/15/04&d@ scf = notesize else scf = z end textline = line // " " A11: if textline con "\" if mpt > 1 t1 = mpt line2 = textline{1,mpt-1} perform lineout textline = textline{t1..} goto A11 end if textline{2} = "\" line2 = "\" perform lineout textline = textline{3..} goto A11 end &dA &dA &d@ This coded added &dA03/05/04&d@ to implement "in-line" space commands &dA if "!@#$%^&*(-=" con textline{2} textline = chr(130+mpt) // textline{3..} goto A11 end &dA if textline{2} = "0" t1 = ors(textline{3}) + 128 if chr(t1) in [160,206,212,224] else line2 = chr(t1) perform lineout end textline = textline{4..} goto A11 end if textline{2} in ['a'..'z','A'..'Z'] d1 = ors(textline{2}) if textline{3} = "1" if "ANOano" con textline{2} t1 = d1 + 140 /* 140 = wak(1) else if textline{2} in ['A'..'Z'] t1 = 205 else t1 = 237 end end line2 = chr(t1) // textline{2} else if textline{3} = "5" if textline{2} in ['A'..'Z'] t1 = 211 /* 211 = wak(5)(=128) + 83(S) else t1 = 243 end line2 = chr(t1) // textline{2} else if textline{3} = "2" if "CcOos" con textline{2} if mpt < 3 line2 = chr(d1+156) // textline{2} /* 156 = wak(2) else if mpt < 5 line2 = chr(d1+143) // textline{2} /* 79(O) + 143 = 222 etc. else line2 = chr(244) /* German ss end end else line2 = textline{2} end else if textline{3} = "4" if "Aa" con textline{2} line2 = chr(d1+156) // textline{2} /* 156 = wak(4) else line2 = textline{2} end else if "7893" con textline{3} t1 = mpt + 127 /* wak(3,7,8,9) if ("73" con textline{3} and "Yy" con textline{2}) or "AEIOUaeiou" con textline{2} if textline{2} = "i" line2 = chr(d1+t1) // chr(238) /* 238 = dotless i else line2 = chr(d1+t1) // textline{2} end else line2 = textline{2} end else line2 = "\" perform lineout textline = textline{2..} goto A11 end end end end end perform lineout textline = textline{4..} goto A11 else line2 = "\" perform lineout textline = textline{2..} goto A11 end else t1 = len(textline) - 2 if t1 > 0 line2 = textline{1,t1} perform lineout end end scf = notesize return &dA &d@ &dA &d@ End of setwords with NEWFONTS &dA &dA &dA &d@ &dA &dA &d@*P&dA 6a. lineout &dA &d@ &dA &dA &d@ Purpose: Send a line of text to output device &dA &dA &d@ Inputs: line2 &dA &d@ z = font number for words &dA &dA &d@ Side effects: value of z may be changed &dA &d@ value of scf may be changed &dA procedure lineout int t1, t2, t3 str textline.300 AAA111: if line2 con "!" t1 = mpt if t1 > 1 if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ textline = line2{1,t1-1} else textline = "" loop for t2 = 1 to t1 - 1 t3 = ors(line2{t2}) t3 = music_con(t3) textline = textline // chr(t3) repeat end perform stringout (textline) line2 = line2{t1..} end if len(line2) > 1 if "0123456789" con line2{2} z = int(line2{2..}) if z = 1 /* added &dA03/15/04&d@ scf = notesize else scf = z end if sub <= len(line2) line2 = line2{sub..} &dA &dA &d@ Code added &dA01/17/04&d@ to remove terminator to font designation field &dA if line2{1} = "|" if len(line2) = 1 return end line2 = line2{2..} end &dA goto AAA111 else return end else if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ textline = "!" else t3 = ors("!") t3 = music_con(t3) textline = chr(t3) end perform stringout (textline) line2 = line2{2..} goto AAA111 end end end if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ textline = line2 else textline = "" loop for t2 = 1 to len(line2) t3 = ors(line2{t2}) t3 = music_con(t3) textline = textline // chr(t3) repeat end perform stringout (textline) return &dA &d@ &dA &dA &d@*P&dA 8. staff &dA &d@ &dA &dA &d@ Purpose: Typeset staff &dA &dA &d@ Inputs: y = absolute vertical location &dA &d@ esksp = starting point of staff lines &dA &d@ esksyslen = length of staff lines &dA &d@ stave_type = type of staff 0 = 5-line /* New &dA12/18/05 &dA &d@ 1 = single line &dA procedure staff int slen if notesize >= 10 slen = 64 else slen = 32 end &dA &dA &d@ New &dA12/18/05&d@: Single line stave &dA if stave_type = 1 y += eskvpar(4) d2 = esksp + esksyslen - eskhpar(1) z = 90 loop for x = sp to d2 step eskhpar(1) perform setmus repeat x = d2 perform setmus y -= eskvpar(4) return end &dA &d@ End of &dA11/11/05&d@ addition if notesize >= 18 /* Added &dA11/18/03&d@ to fill holes in lines /* New &dA12/18/04&d@ changed from &dE= 21&d@ to &dE>= 18 d2 = esksp + esksyslen - slen z = 81 loop for x = esksp to d2 step slen - 1 perform setmus ++x perform setmus repeat x = d2 perform setmus --x perform setmus else d2 = esksp + esksyslen - slen z = 81 loop for x = esksp to d2 step slen perform setmus repeat x = d2 perform setmus end return &dA &d@ &dA &dA &d@*P&dA 9. settie &dA &d@ &dA &dA &d@ Purpose: Typeset typeset tie &dA &dA &d@ Inputs: x1 = x-object coordinate of first note &dA &d@ y1 = y-object coordinate of first note (+1000 if on virtual staff) &dA &d@ tspan = distance spanned by tie &dA &d@ sitflag = situation flag &dA &d@ eskf12 = staff number &dA &d@ tpost_x = post adjustment to left x position added &dA04/20/03 &dA &d@ tpost_y = post adjustment to y position " &dA &d@ tpost_leng = post adjustment to right x position " &dA &dA &d@ Internal varibles: d1 = temporary variable &dA &d@ d2 = temporary variable &dA &d@ tiechar = first tie character &dA &d@ textend = tie extention character &dA &d@ hd = horizontal displacement &dA &d@ vd = vertical displacement &dA procedure settie int d1,d2,d3,d4,d5 int virtoff label STL(4) &dA &dA &d@ 1) decode y-object coordinate of first note &dA virtoff = 0 if y1 > 700 y1 -= 1000 virtoff = eskvst(eskf12) end &dA &dA &d@ 2) complete sitflag &dA d5 = eskhpar(60) d1 = sitflag - 1 & 0x0c >> 2 + 1 goto STL(d1) STL(1): /* tips down, space if y1 < eskvpar(2) ++sitflag else if y1 = eskvpar(3) and tspan > d5 /* e.g., C5 ++sitflag end end goto STLE STL(2): /* tips down, line if y1 < eskvpar(1) ++sitflag else if y1 = eskvpar(2) and tspan > d5 ++sitflag end end goto STLE STL(3): /* tips up, space if y1 > eskvpar(6) ++sitflag else if y1 = eskvpar(7) and tspan > d5 ++sitflag end end goto STLE STL(4): /* tips up, line if y1 > eskvpar(5) ++sitflag else if y1 = eskvpar(6) and tspan > d5 ++sitflag end end STLE: &dA &dA &d@ 3) from sitflag and tspan, get tiechar, hd and vd &dA * putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag tspan -= tpost_x /* added &dA04/20/03 tspan += tpost_leng /* added &dA04/20/03 if tspan < eskhpar(61) /* minimum length depends on notesize putc Error: Tie too short to print putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag getc return end d1 = sitflag + 3 / 4 d3 = rem * 3 + 1 d2 = ( TIE_DISTS ) if tspan < ( (TIE_DISTS - 1) * eskhpar(62) + eskhpar(61) ) d2 = tspan - eskhpar(61) if eskhpar(62) = 3 ++d2 end d2 = d2 / eskhpar(62) + 1 /* row number for tie parameters end tiechar = tiearr(sizenum,d1,d2,d3) hd = tiearr(sizenum,d1,d2,d3+1) vd = tiearr(sizenum,d1,d2,d3+2) if sitflag > 8 vd = 0 - vd end &dA &dA &d@ 4) typeset tie &dA &d@ x = x1 + hd + esksp + tpost_x /* modified &dA04/20/03&d@ etc. y = y1 - vd + esksq(eskf12) + virtoff if tpost_y < 1000 y += tpost_y else tpost_y -= 10000 y = y1 + tpost_y + esksq(eskf12) + virtoff end scf = 300 scx = x scy = y scb = tiechar perform charout d1 = tiechar & 0x7f &dA &d@ Revision &dA09/21/02&d@: Trying to remove "magic numbers" from settie. if d1 = tiearr(sizenum,1,TIE_DISTS,4) /* staff free general long glyph textend = tiechar + 5 ++tiechar goto EXT end if d1 = tiearr(sizenum,1,TIE_DISTS,1) /* staff constrained general long glphy textend = tiechar + 1 tiechar += 2 goto EXT end if d1 > eskhpar(63) /* above glyph eskhpar(63), tie is compound ++tiechar scb = tiechar perform charout end goto EXTa * EXT: vd = sitflag - 1 / 8 sitflag = rem + 1 hd = tspan vd = hd - expar(sitflag) + 32 / 8 /* was + 8 / 8 scb = textend loop for tcnt = 1 to vd perform charout repeat vd = hd - expar(sitflag) + 32 / 8 /* was + 16 / 8 vd = 40 - rem /* was 16 - rem scx -= vd scb = tiechar perform charout * EXTa: scf = notesize return &dA &d@ &dA &dA &d@*P&dA 10. sethyph (level) &dA &d@ &dA &dA &d@ Purpose: Typeset hyphons &dA &dA &d@ Inputs: level = level of text line (usually 1) &dA &d@ x = absolute coordinate of terminating syllable &dA &d@ y = absolute coordinate text line &dA &d@ eskbackloc(.) = location first space beyond last syllable &dA &d@ or location of first hyphon on next line &dA &dA &d@ Internal varibles: a,b,c,d &dA procedure sethyph (level) int level int a,b,c,d /* a,b,c,d added &dA03/15/04&d@ getvalue level scf = mtfont scy = y a = x - eskbackloc(level) * a = distance over which to set hyphons b = 3 * eskhpar(6) if a < b if a >= eskhpar(17) if eskbackloc(level) = ibackloc(level) /* changed from eskhpar(15) &dA08/26/03 scx = eskbackloc(level) scb = ors("-") perform charout if a < eskhpar(6) goto CM end end b /= 2 if a > b b = a - eskhpar(17) + 3 * 2 / 5 a = b + eskbackloc(level) scx = a scb = ors("-") perform charout a += b else a = a - eskhpar(17) + 3 / 2 + eskbackloc(level) end scx = a scb = ors("-") perform charout else &dK &d@ if x = eskhpar(9) if x = esksysright /* esksysright (from i-file) replaces eskhpar(9) &dA12/31/08 scx = eskbackloc(level) scb = ors("-") perform charout goto CM end end else if eskbackloc(level) = ibackloc(level) /* changed from eskhpar(15) &dA08/26/03 b = 2 * a / eskhpar(6) + 1 c = a / b eskbackloc(level) -= c a += c end b = a / eskhpar(6) c = a / b --b eskbackloc(level) += c / 2 scx = eskbackloc(level) scb = ors("-") perform charout loop for d = 1 to b eskbackloc(level) += c scx = eskbackloc(level) scb = ors("-") perform charout repeat end CM: scf = notesize return &dA &d@ &dA &dA &d@*P&dA 11. setunder (level) &dA &d@ &dA &dA &d@ Purpose: Typeset underline &dA &dA &d@ Inputs: level = level of text line (usually 1) &dA &d@ eskuxstop(.) = x-coordinate of end of line &dA &d@ eskuxstart(.) = x-coord. of first space beyond last syllable &dA &d@ or location of first hyphon on next line &dA &d@ y = y-coordinate for text line &dA &d@ underflag = execution flag, currently set for ties and &dA &d@ melismas &dA &d@ eskxbyte(.) = ending punctuation &dA &dA &d@ Internal varibles: a,b,c,d &dA procedure setunder (level) int a,b,c,d /* &dA03/15/04&d@ adding a,b,c,d int level getvalue level if underflag = 0 return end x = eskuxstart(level) - eskhpar(19) scf = mtfont scx = x scy = y a = eskuxstop(level) - eskuxstart(level) * a = distance over which to set hyphons if a >= eskhpar(18) y -= eskvpar(13) scx = eskuxstart(level) scy = y scb = ors("_") b = eskuxstop(level) - underspc(sizenum) d = underspc(sizenum) loop for c = eskuxstart(level) to b step d perform charout repeat scx = b perform charout scx += 5 scy += eskvpar(13) end if underflag = 1 and eskxbyte(level) <> "_" scb = ors(eskxbyte(level)) perform charout end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 14. putslur &dA &d@ &dA &dA &dA &d@ Purpose: Typeset slur &dA &dA &d@ Inputs: (x1,y1) = starting note head &dA &d@ (x2,y2) = terminating note head &dA &d@ slur_edit_flag = flag indicating that y1 and/or y2 have been altered &dA &d@ postx = horiz. movement of slur after it has been chosen &dA &d@ posty = vert. movement of slur after it has been chosen &dA &d@ addcurve = flag indicating the curvature should be added &dA &d@ sitflag = situation flag &dA &d@ &dA &d@ bit clear bit set &dA &d@ -------------- ------------- &dA &d@ bit 0: full slur dotted slur &dA &d@ bit 1: stock slur custom slur &dA &d@ bit 2: first tip down first tip up &dA &d@ (*) bit 3: second tip down second tip up &dA &d@ (+) bit 4: compute stock slur hold stock slur &dA &d@ &dA &d@ (*) used on custom slurs only &dA &d@ (+) used on stock slurs only &dA &dA &d@ bit 5: continuous slur broken slur /* &dA03/15/97 &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA &d@ &dA &d@ &dA &d@ Internal variables: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 &dA &d@ c1,c2,c3,c4,c5,c6,c7 &dA procedure putslur str line2.480 bstr tbt.2500 /* added &dA01/26/05&d@ bstr tbt2.2500 /* added &dA01/26/05&d@ int save_y1,save_y2 int save_x1,save_x2 save_y1 = y1 /* added &dA01/03/05&d@, etc. save_y2 = y2 save_x1 = x1 save_x2 = x2 &dA &dA &d@ determine case &dA a9 = bit(2,sitflag) a1 = a9 * 2 + 1 /* 1,1,3,3 if y1 < y2 ++a1 /* 1,2,3,4 = tips down rising, tips down falling, etc. end &dA &dA &d@ determine method of dealing with slurs stock vs. custon &dA if notesize = 14 a5 = 800 /* changed from 801 on &dA9-12-97&d@ end if notesize = 6 a5 = 400 /* changed from 801 on &dA9-12-97&d@ end if notesize = 21 a5 = 600 /* changed from 601 on &dA9-12-97&d@ end if notesize = 18 /* New size-18 &dA12/18/04&d@ a5 = 800 end if notesize = 16 /* New size-16 &dA01/01/09&d@ a5 = 800 end if x2 - x1 < a5 /* stock slurs SR5: a5 = eskvpar(10) + eskvpar20 - y1 * 2 + 1 / eskvpar(2) - 20 a6 = eskvpar(10) + eskvpar20 - y2 * 2 + 1 / eskvpar(2) - 20 a7 = abs(a5-a6) &dA &dA &d@ determine whether to use the parametric method of slur placement &dA if a7 < 11 or (x2 - x1 < 100 and slur_edit_flag = 0) /* protopar file specific if a7 > 10 a7 -= 10 a7 = a7 + 20 * eskvpar(2) / 2 - eskvpar20 if a1 = 1 y1 -= a7 else if a1 = 2 y2 -= a7 else if a1 = 3 y2 += a7 else /* a1 = 4 y1 += a7 end end end goto SR5 end if a5 < 1 or a6 < 1 goto SR1 end if a5 > 11 or a6 > 11 goto SR2 end goto SR3 * adjust parameters upward SR1: a10 = a5 a11 = a6 if a6 < a5 a10 = a6 a11 = a5 end a10 = 1 - a10 /* minimum amount to raise pars if a7 < 10 a12 = a10 / 2 if a9 = 0 /* convex slur a10 += rem else if a11 + a10 > 3 a10 += rem end end end a5 += a10 a6 += a10 goto SR3 * adjust parameters downward SR2: a10 = a5 a11 = a6 if a6 > a5 a10 = a6 a11 = a5 end a10 -= 11 /* minimum amount to lower pars if a7 < 10 a12 = a10 / 2 if a9 = 1 /* concave slur a10 += rem else if a11 - a10 < 9 a10 += rem end end end a5 -= a10 a6 -= a10 SR3: &dA &dA &d@ get stock slur number and location &dA SR4: a7 = x2 - x1 if notesize = 14 or notesize = 16 or notesize = 18 /* Modified (size-16) &dA01/01/09 if a7 < 10 --x1 ++x2 goto SR4 end end if notesize = 21 if a7 < 15 --x1 ++x2 goto SR4 end end if notesize = 6 if a7 < 5 --x1 ++x2 goto SR4 end end if notesize = 14 or notesize = 16 or notesize = 18 /* Modified (size-16) &dA01/01/09 a7 = x2 - x1 / 2 - 2 /* a7 should be less than 399 end if notesize = 21 a7 = x2 - x1 + 1 / 3 - 2 /* a7 should be less than 199 end if notesize = 6 a7 = x2 - x1 - 2 /* a7 should be less than 399 end if notesize = 14 or notesize = 6 or notesize = 16 or notesize = 18 /* Modified (size-16) &dA01/01/09 if a7 >= 399 putc Program Error examine return 10 end end if notesize = 21 if a7 >= 199 putc Program Error examine return 10 end end if notesize = 14 line2 = DISP_DISK // ":/musprint/bitmap/slurs/c/" end if notesize = 21 line2 = DISP_DISK // ":/musprint/bitmap21/slurs/c/" end if notesize = 6 line2 = DISP_DISK // ":/musprint/bitmap06/slurs/c/" end if notesize = 18 /* New (size-18) &dA12/18/04&d@ line2 = DISP_DISK // ":/musprint/bitmap18/slurs/c/" end if notesize = 16 /* New (size-16) &dA01/01/09&d@ line2 = DISP_DISK // ":/musprint/bitmap16/slurs/c/" end &dA &d@ line2 = "c:\wbh\res\mus\prnt\bitmap\slurs\protopar\c\" line2 = line2 // chs(a5) // "/" // chs(a6) open [3,1] line2 loop for a8 = 1 to a7 getf [3] repeat getf [3] c1 c2 c3 c4 c5 c6 c7 .t1 line2 if a1 < 3 x1 += c2 y1 -= c3 a3 = c4 else x1 += c5 y1 += c6 a3 = c7 end close [3] x = x1 + esksp y = y1 + esksq(eskf12) else /* we don't use parametric method if a1 < 3 /* tips down c1 = y1 / eskvpar(2) if y1 > eskvpar(1) and rem = 0 y1 = (c1 - 1) * eskvpar(2) + eskvpar(1) end c1 = y2 / eskvpar(2) if y2 > eskvpar(1) and rem = 0 y2 = (c1 - 1) * eskvpar(2) + eskvpar(1) end a3 = abs(y1 - y2) /* rise y1 -= eskvpar(2) else c1 = y1 / eskvpar(2) if y1 < eskvpar(8) and rem = 0 y1 += eskvpar(1) /* OK 04-24-95 end c1 = y2 / eskvpar(2) if y2 < eskvpar(8) and rem = 0 y2 += eskvpar(1) /* OK 04-24-95 end a3 = abs(y1 - y2) /* rise y1 += eskvpar(2) end x = x1 + esksp + eskvpar(2) y = y1 + esksq(eskf12) a7 = x2 - x1 - eskvpar(1) /* length if notesize = 14 or notesize = 16 or notesize = 18 /* Modified (size-16) &dA01/01/09 &dA &dA &dA &d@ For 14-dot slurs, the distribution of length for stock slurs is a follows &dA &dA &d@ Lengths Length Rise Number &dA &d@ in dots increments increments of types (possible) &dA &d@ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 8 to 18 2 2 6 &dA &d@ 20 to 196 4 2 12 &dA &d@ 200 to 392 8 2 24 &dA &d@ 400 to 784 16 2 48 &dA if a7 < 8 a7 = 8 end if a7 < 20 c1 = a7 / 2 if rem > 0 /* Fixing error: was &dEif rem > 1&d@ &dA12/18/04 ++a7 end else if a7 < 200 c1 = a7 / 4 if rem > 1 ++x end a7 -= rem else if a7 < 400 c1 = a7 / 8 x += (rem >> 1) a7 -= rem else c1 = a7 / 16 x += (rem >> 1) a7 -= rem if rem > 11 x -= 8 a7 += 16 end if a7 >= 784 a7 = 784 end end end end &dA &dA &d@ For 14-dot slurs and 18-dot slurs, (Comment modified (size-18) &dA12/18/04&d@) &dA &dA &d@ Slur number = (rise * 1200) + (length * 3) + type number &dA &d@ number ranges from 8 to 143999 &dA c1 = a3 / 4 a3 -= rem if a1 > 2 y += rem end a3 = a3 * 1200 + (a7 * 3) + 1 end if notesize = 21 &dA &dA &dA &d@ For 21-dot slurs, the distribution of length for stock slurs is a follows &dA &dA &d@ Lengths Length Rise Number &dA &d@ in dots increments increments of types (possible) &dA &d@ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 12 to 27 3 2 6 &dA &d@ 30 to 294 6 2 12 &dA &d@ 300 to 600 12 2 24 &dA if a7 < 12 a7 = 12 end if a7 < 30 a7 = a7 + 1 / 3 * 3 else if a7 < 300 a7 = a7 + 1 / 6 * 6 rem >>= 1 x += rem else if a7 < 600 a7 = a7 + 3 / 12 * 12 rem >>= 1 x += rem else a7 = 600 end end end &dA &dA &d@ For 21-dot slurs, &dA &dA &d@ Slur number = (rise * 600) + (length * 2) + type number &dA &d@ number ranges from 8 to 143999 &dA c1 = a3 / 4 a3 -= rem if a1 > 2 y += rem end a3 = a3 * 600 + (a7 * 2) + 1 end if notesize = 6 &dA &dA &dA &d@ For 6-dot slurs, the distribution of length for stock slurs is a follows &dA &dA &d@ Lengths Length Rise Number &dA &d@ in dots increments increments of types (possible) &dA &d@ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 4 to 9 1 1 6 &dA &d@ 10 to 98 2 1 12 &dA &d@ 100 to 396 4 1 24 &dA if a7 < 4 a7 = 4 end if a7 > 9 if a7 < 100 c1 = a7 / 2 a7 -= rem else if a7 < 396 c1 = a7 / 4 x += (rem >> 1) a7 -= rem else a7 = 396 end end end &dA &dA &d@ For 6-dot slurs, &dA &dA &d@ Slur number = (rise * 2400) + (length * 6) + type number &dA &d@ number ranges from 8 to 143999 &dA c1 = a3 / 2 a3 -= rem y += rem a3 = a3 * 2400 + (a7 * 6) + 1 end end x += postx y += posty a3 += addcurve /* new 6-30-93 if notesize = 14 if a3 > 120000 /* max rise = 96 goto NOSTOCK end end if notesize = 16 if a3 > 120000 /* max rise = 96 &dA01/01/09&d@ goto NOSTOCK end end if notesize = 18 /* New (size-18) &dA12/18/04&d@ if a3 > 115200 /* max rise = 92 goto NOSTOCK end end if notesize = 21 if a3 > 70000 goto NOSTOCK end end /* large gaps should now be supported &dA &dA &d@ a1 = case number &dA &d@ a3 = stock slur number &dA &d@ x = horizontal position &dA &d@ y = vertical position &dA &dA &dA &d@ Enter new code for acquiring and printing slur &dA perform printslur_screen (a1, a3, x, y, con3, sitflag) if a3 = 1000000 goto NOSTOCK end return end NOSTOCK: /* long slurs y1 = save_y1 /* added &dA01/03/05&d@, etc. y2 = save_y2 x1 = save_x1 x2 = save_x2 if a1 < 3 /* tips down c1 = y1 / eskvpar(2) if y1 > eskvpar(1) and rem = 0 y1 = (c1 - 1) * eskvpar(2) + eskvpar(1) end c1 = y2 / eskvpar(2) if y2 > eskvpar(1) and rem = 0 y2 = (c1 - 1) * eskvpar(2) + eskvpar(1) end a3 = abs(y1 - y2) /* rise y1 -= eskvpar(2) else c1 = y1 / eskvpar(2) if y1 < eskvpar(8) and rem = 0 y1 += eskvpar(1) /* OK 04-24-95 end c1 = y2 / eskvpar(2) if y2 < eskvpar(8) and rem = 0 y2 += eskvpar(1) /* OK 04-24-95 end a3 = abs(y1 - y2) /* rise y1 += eskvpar(2) end x = x1 + esksp + eskvpar(2) + postx y = y1 + esksq(eskf12) + posty a7 = x2 - x1 - eskvpar(1) /* length perform make_longslur (a7,a3,a1) /* length,rise,smode /* return: a7 = offset, a3 = height y = y - a7 &dA &dA &d@ Code added &dA01/26/05&d@ to implement dotted slurs in NOSTOCK situation &dA &d@ 1) Determine a5 = maximum length of slur &dA &d@ 2) Construct tbt = dotted mask for this slur &dA if sitflag = 1 a5 = 0 loop for i = 1 to a3 tbt = cbi(longslur(i)) a6 = bln(tbt) if a6 > a5 a5 = a6 end repeat if a5 = 0 dputc Possible Error in constructing dotted mask a5 = 100 end a6 = a5 / gapsize if bit(0,a6) = 0 --a6 end &dA &dA &d@ xxxxxxxxxxx....xxxx....xxxx....xxxx....xxxx....xxxxxxxxxxx &dA &d@ | odd number | &dA &d@ a6 = largest odd number of intervals that will fit inside a5 &dA a6 *= gapsize a7 = a5 - a6 a7 >>= 1 /* initial correction tbt = dup("1",a7) // dotted{1,a6} // dup("1",a7+10) /* mask end &dA &d@ End of this &dA01/26/05&d@ addition scx = x scy = y c2 = 0 loop for i = 1 to a3 &dA &dA &d@ Code added &dA01/26/05&d@ to implement dotted slurs in NOSTOCK situation &dA if sitflag = 1 tbt2 = cbi(longslur(i)) /* bit equivalent of longslur(i) tbt2 = bnd(tbt2,tbt) /* &dEand&d@ this with mask tbt2 = trm(tbt2) /* and trm to length longslur(i) = cby(tbt2) /* put this back in longslur(i) end &dA &d@ End of this &dA01/26/05&d@ addition bt(i) = cbi(longslur(i)) c1 = bln(bt(i)) if c1 > c2 c2 = c1 end repeat * /* display slur contained in bt(a3) if con3 = 1 if con1 = 0 setb gstr,bt,scx,scy,a3,c2,1,3 else setb red_gstr,bt,scx,scy,a3,c2,1,1 end else if con1 = 0 clearb gstr,bt,scx,scy,a3,c2,1,3 else clearb red_gstr,bt,scx,scy,a3,c2,1,1 end end return &dA &d@ &dA &dA &d@*P&dA 15. puttuplet &dA &d@ &dA &dA &d@ Purpose: Typeset tuplet and/or bracket &dA &dA &d@ Inputs: x1 = horizontal starting point of tuplet/bracket &dA &d@ x2 = horizontal stopping point of tuplet/bracket &dA &d@ y1 = vertical starting point &dA &d@ y2 = vertical stopping point &dA &d@ a1 = tuplet number &dA &d@ &dA &d@ sitflag = situation flag bit clear bit set &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄ &dA &dA &d@ bit 0 no tuplet tuplet &dA &d@ bit 1 no bracket bracket &dA &d@ bit 2 tips down tips up &dA &dA &d@ bit 5 broken bracket continuous bracket /* &dA03/15/97 &dA &d@ bit 6 number outside number inside &dA &d@ bit 7 square bracket curved bracket &dA &d@ &dA &d@ &dA &d@ Calling variables to internal procedures: a1,a4,a5 &dA procedure puttuplet int f,xav,yav,h,k int t1,t2,t3,t4,t5,savex2 savex2 = x2 x2 += notesize if bit(1,sitflag) = 1 x2 = eskvpar(2) / 3 + x2 end a4 = x2 - x1 a4 = y2 - y1 * 60 / a4 xav = x1 + x2 / 2 yav = xav - x1 * a4 / 60 + y1 &dA &dA &d@ xav = x at center of tuplet/bracket &dA &d@ a4 = slope * 60 &dA &d@ yav = y at center of tuplet/bracket &dA &dA &d@ Part I: tuplet present &dA if bit(0,sitflag) = 1 x = xav y = yav + esksq(eskf12) h = x - eskhpar(45) + (notesize / 3) k = x + eskhpar(45) - (notesize / 7) x = 0 - eskhpar(45) / 2 + x + esksp &dA &dA &d@ New code (12/01/94) to deal with complex tuples &dA t4 = a1 t1 = t4 / 1000 t2 = rem if t1 > 0 t3 = 2 if t2 > 9 ++t3 end if t1 > 9 ++t3 end t4 = eskhpar(45) * t3 + 1 >> 1 x -= t4 /* create space for colon + double digits h -= t4 k += t4 else t3 = 0 if t2 > 9 ++t3 end t4 = eskhpar(45) * t3 + 1 >> 1 x -= t4 /* create space for double digits h -= t4 k += t4 end if bit(1,sitflag) = 1 /* bracket present if bit(7,sitflag) = 1 /* curved bracket if bit(2,sitflag) = 0 /* tips down y -= (eskvpar(1) + 1 / 2) else /* tips up y += (eskvpar(1) + 1 / 2) end if bit(5,sitflag) = 0 /* broken bracket y -= (eskvpar(3) >> 2) end end &dA &dA &d@ &dA03/15/97&d@ numbers below or above &dA if bit(5,sitflag) = 1 /* continuous bracket if bit(7,sitflag) = 1 /* curved bracket if bit(6,sitflag) = 0 /* number outside if bit(2,sitflag) = 1 /* tips up y += eskvpar(2) else /* tips down y -= (eskvpar(5) + 1 / 2) end else /* number inside if bit(2,sitflag) = 1 /* tips up y -= eskvpar(3) else /* tips down y += (eskvpar(5) + 1 / 2) end end else /* square bracket if bit(6,sitflag) = 0 /* number outside if bit(2,sitflag) = 1 /* tips up y += eskvpar(3) else /* tips down y -= eskvpar(2) end else /* number inside if bit(2,sitflag) = 1 /* tips up y -= eskvpar(2) else /* tips down y += eskvpar(3) end end end h = xav + 2 /* eliminate space in bracket line k = xav - 2 end end scx = x scy = y &dA &dA &d@ Put out numerator of tuple &dA t3 = t2 / 10 t2 = rem if t3 > 0 a1 = t3 + 221 scb = a1 perform charout end a1 = t2 + 221 scb = a1 perform charout &dA &dA &d@ Put out denominator of tuple (if present) &dA if t1 > 0 a1 = 249 /* colon scb = a1 perform charout t3 = t1 / 10 t1 = rem if t3 > 0 a1 = t3 + 221 scb = a1 perform charout end a1 = t1 + 221 scb = a1 perform charout end end * * Part II: bracket present * if bit(1,sitflag) = 1 /* bracket present &dA &dA &d@ Square brackets &dA if bit(7,sitflag) = 0 /* square bracket * 1) compute slope a5 = abs(a4) a5 = a5 + 3 / 5 if a5 > 6 a5 = 6 end if a5 = 5 a5 = 4 end if a5 = 6 a5 = 5 end if a4 > 0 a4 = a5 else a4 = 0 - a5 end yav -= eskvpar(40) * 2) case 1: broken bracket if bit(5,sitflag) = 0 a1 = h - x1 + 2 / 3 * 3 x1 = h - a1 f = 6 if a4 < 0 f = -6 end y1 = x1 - xav * a4 + 6 / 12 + yav x = x1 + esksp y = y1 + esksq(eskf12) perform brackethook perform bracketline a1 = x2 - k + 2 / 3 * 3 y1 = k - x1 * a4 + f / 12 + y1 x1 = k perform bracketline perform brackethook else * 3) case 2: continuous bracket a1 = x2 - x1 + 2 / 3 * 3 x1 = 0 - a1 - 1 / 2 + xav y1 = x1 - xav * a4 + 6 / 12 + yav x = x1 + esksp y = y1 + esksq(eskf12) perform brackethook perform bracketline perform brackethook end else &dA &dA &d@ Curved brackets (slurs) /* &dA03/15/97&d@ &dA &dA &d@ Inputs: (x1,y1) = starting note head &dA &d@ (x2,y2) = terminating note head &dA &d@ slur_edit_flag = flag indicating that y1 and/or y2 have been altered &dA &d@ postx = horiz. movement of slur after it has been chosen &dA &d@ posty = vert. movement of slur after it has been chosen &dA &d@ addcurve = flag indicating the curvature should be added &dA &d@ sitflag = situation flag &dA &d@ &dA &d@ bit clear bit set &dA &d@ -------------- ------------- &dA &d@ bit 0: full slur dotted slur &dA &d@ bit 1: stock slur custom slur &dA &d@ bit 2: first tip down first tip up &dA &d@ (*) bit 3: second tip down second tip up &dA &d@ (+) bit 4: compute stock slur hold stock slur &dA &d@ &dA &d@ (*) used on custom slurs only &dA &d@ (+) used on stock slurs only &dA &dA &d@ bit 5: continuous slur broken slur /* &dA03/15/97 &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA &d@ t1 = sitflag x2 = savex2 /* restore x2 to original if bit(2,t1) = 1 /* tips up sitflag = 12 posty = 0 - eskvpar(5) /* reason: y1 and y2 were supplied as endpoints else /* for square brackets, not the notes themselves sitflag = 0 /* this code is a cludge to correct for this posty = eskvpar(5) / 2 /* approximately. Rigorous solution would be end /* to set through the original oby's slur_edit_flag = 1 postx = 0 addcurve = 0 if bit(5,t1) = 0 /* broken slur t2 = k - h << 8 + 0x20 sitflag += t2 end perform putslur end end return * procedure brackethook if bit(2,sitflag) = 1 y = y - notesize + 2 end scx = x scy = y scb = 89 perform charout return &dA &d@ &dA &dA &d@*P&dA 16. bracketline &dA &d@ &dA &dA &d@ Purpose: typeset bracket line &dA &dA &d@ Inputs: a1 = length &dA &d@ a4 = slope &dA &d@ a5 = slope type 0,1,2,3,4,5 &dA &d@ x1 = x starting point &dA &d@ y1 = y starting point &dA &dA &d@ Outputs: x = x coordinate of end of line &dA &d@ y = y coordinate of end of line &dA procedure bracketline int h,i,k if a1 = 0 return end x = x1 + esksp y = y1 + esksq(eskf12) scf = 400 scx = x scy = y if a4 > 0 z = 184 + a5 end if a4 < 0 z = 164 + a5 end if a4 = 0 z = 161 end h = a1 / 12 k = rem if a4 = 0 loop for i = 1 to h x += 12 scb = z perform charout repeat else loop for i = 1 to h scb = z perform charout if a4 > 0 scy += a4 else h = 0 - a4 scy -= h end x += 12 y += a4 repeat end if k > 0 if k = 9 if a4 < 0 h = a4 - 1 * 2 / 3 z += 5 end if a4 > 0 h = a4 + 1 * 2 / 3 z += 5 end if a4 = 0 h = 0 ++z end end if k = 6 if a4 < 0 h = a4 - 1 / 2 z += 10 end if a4 > 0 h = a4 + 1 / 2 z += 10 end if a4 = 0 h = 0 z += 2 end end if k = 3 if a4 < 0 h = a4 - 1 / 3 z += 15 end if a4 > 0 h = a4 + 1 / 3 z += 15 end if a4 = 0 h = 0 z += 3 end end scb = z perform charout x += k y += h end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 17. putwedge &dA &d@ &dA &dA &d@ Purpose: Typeset wedge &dA &dA &d@ Inputs: x1 = horizontal starting point of wedge &dA &d@ x2 = horizontal stopping point of wedge &dA &d@ y1 = vertical starting point &dA &d@ y2 = vertical stopping point &dA &d@ c1 = starting spread of wedge &dA &d@ c2 = stopping spread of wedge &dA &d@ procedure putwedge int leng,slope,z1,clen,fullcnt int nex,h y1 -= eskvpar(1) y2 -= eskvpar(1) leng = x2 - x1 x = x1 + esksp scf = 400 scx = x * compute slope slope = c2 - c1 * 240 / leng slope = abs(slope) if slope < 8 slope = 8 end if c2 > c1 slope = slope + 2 / 4 else slope = slope + 3 / 4 end if slope > 20 slope = 20 end z1 = slope if c2 < c1 slope = 0 - slope end * compute character if z1 > 12 z1 = z1 - 13 / 2 + 13 end * compute length of character if z1 < 11 clen = 120 / z1 else clen = 128 / z1 end * compute number of full characters fullcnt = leng / clen * compute extension set nex = 0 h = rem - 30 if h > 0 ++nex tarr(nex) = 74 rem = h end h = rem - 20 if h > 0 ++nex tarr(nex) = 75 rem = h end h = rem - 10 if h > 0 ++nex tarr(nex) = 78 rem = h end if rem > 0 ++nex tarr(nex) = 88 - rem end * write out wedge . . . if slope > 0 /* cresc. h = c1 / 2 y2 += h y1 -= h z = z1 + 31 * -- top y = y1 + esksq(eskf12) loop for h = 1 to fullcnt scy = y scb = z perform charout --y repeat loop for h = 1 to nex z = tarr(h) scy = y scb = z perform charout repeat * -- bottom scx = x z = z1 + 51 y = y2 + esksq(eskf12) loop for h = 1 to fullcnt scy = y scb = z perform charout ++y repeat loop for h = 1 to nex z = tarr(h) scy = y scb = z perform charout repeat else /* decresc. h = c2 / 2 y1 = y1 - h - fullcnt y2 = y2 + h + fullcnt * -- top y = y1 + esksq(eskf12) loop for h = 1 to nex z = tarr(h) scy = y scb = z perform charout repeat z = z1 + 51 loop for h = 1 to fullcnt scy = y scb = z perform charout ++y repeat scx = x * -- bottom y = y2 + esksq(eskf12) loop for h = 1 to nex z = tarr(h) scy = y scb = z perform charout repeat z = z1 + 31 loop for h = 1 to fullcnt scy = y scb = z perform charout --y repeat end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 18. putfigcon &dA &d@ &dA &dA &d@ Purpose: Typeset figure continuation line &dA &dA &d@ Inputs: x1 = horizontal starting point of line &dA &d@ x2 = horizontal stopping point of line &dA &d@ a3 = vertical level of line &dA &d@ y1 = additional vertical displacement from default height &dANew 11/06/03 &dA &d@ procedure putfigcon int g x = x1 + esksp --a3 &dA &dA &d@ New code &dA11/06/03&d@ adding figoff(.) and y1 &dA y = eskvpar(37) * a3 + eskvpar(36) + esksq(eskf12) + figoff(eskf12) + y1 scx = x scy = y g = x2 - eskhpar(44) scb = 220 loop while x1 <= g perform charout x1 += eskhpar(44) repeat x = g + esksp scx = x perform charout return &dA &d@ &dA &dA &d@*P&dA 19. puttrans &dA &d@ &dA &dA &d@ Purpose: Typeset octave transposition &dA &dA &d@ Inputs: x1 = horizontal starting point of transposition &dA &d@ x2 = horizontal stopping point of transposition &dA &d@ y1 = vertical level of transposition &dA &d@ a1 = length of ending hook &dA &d@ a3 = situation, 0 = 8av up, 1 = 8av down &dA &d@ procedure puttrans int h,j,k x = x1 + esksp y = y1 + esksq(eskf12) scx = x scy = y scb = 233 perform charout x += eskhpar(42) scx = x x1 += eskhpar(42) j = x2 - (eskhpar(43) >> 1) k = 0 scb = 91 loop while x1 <= j k = 1 perform charout x1 += eskhpar(43) repeat h = eskhpar(43) >> 1 x1 -= h if k = 1 if x1 <= j scx -= h perform charout end if a1 > 0 j = eskhpar(43) >> 2 scx -= j if a1 < notesize a1 = notesize end if a3 = 1 k = a1 - 2 scy -= k end loop while a1 > notesize scb = 89 perform charout scy += notesize a1 -= notesize repeat k = notesize - a1 scy -= k scb = 89 perform charout end end return &dA &d@ &dA &dA &d@*P&dA 20. putending &dA &d@ &dA &dA &d@ Purpose: Typeset ending &dA &dA &d@ Inputs: x1 = horizontal starting point of ending &dA &d@ x2 = horizontal stopping point of ending &dA &d@ y1 = vertical level of ending &dA &d@ a1 = length of start hook &dA &d@ a2 = length of ending hook &dA &d@ a3 = ending number, 0 = none &dA &d@ procedure putending str out.20 int h,k if eskf12 > 1 return end x = x1 + esksp y = y1 + esksq(1) scx = x scy = y if a1 > 0 if a1 < notesize a1 = notesize end loop while a1 > notesize scb = 89 perform charout scy += notesize a1 -= notesize repeat k = notesize - a1 scy -= k scb = 89 perform charout end if a3 > 0 scx = x + eskvpar(1) scy = y + eskvpar(4) scf = mtfont out = chs(a3) perform stringout (out) scb = 46 perform charout scf = notesize end scx = x scy = y h = x2 - eskhpar(1) scb = 90 loop while x1 <= h perform charout x1 += eskhpar(1) repeat x = h + esksp scx = x perform charout if a2 > 0 if a2 < notesize a2 = notesize end loop while a2 > notesize scb = 89 perform charout scy += notesize a2 -= notesize repeat k = notesize - a2 scy -= k scb = 89 perform charout end return &dA &d@ &dA &dA &d@*P&dA 21. putdashes &dA &d@ &dA &dA &d@ Purpose: Typeset dashes &dA &dA &d@ Inputs: x1 = horizontal starting point of dashes &dA &d@ x2 = horizontal stopping point of dashes &dA &d@ y1 = vertical level of dashes &dA &d@ a1 = spacing parameter &dA &d@ a2 = font designator &dA &d@ procedure putdashes int h int a,b,c,d,e b = x2 - x1 if b < 0 return end x = x1 + esksp + hyphspc(sizenum) y = y1 + esksq(eskf12) scf = a2 scx = x scy = y scb = 45 perform charout if a1 = 0 a = hyphspc(sizenum) * 5 c = b / a if c = 0 a1 = x2 - x1 c = 2 else if rem > hyphspc(sizenum) * 2 ++c end a1 = b / c end d = 1 else a = a1 c = b / a d = 0 end loop for e = 1 to c - 1 x += a1 scx = x perform charout if d = 1 b -= a1 --c if c > 0 a1 = b / c end end repeat scf = notesize return &dA &d@ &dA &dA &d@*P&dA 22. puttrill &dA &d@ &dA &dA &d@ Purpose: Typeset long trill &dA &dA &d@ Inputs: x1 = horizontal starting point of trill &dA &d@ x2 = horizontal stopping point of trill &dA &d@ y1 = vertical level of trill &dA &d@ a1 = situation 1 = no trill &dA &d@ 2 = trill with no accidental &dA &d@ 3 = trill with sharp &dA &d@ 4 = trill with natural &dA &d@ 5 = trill with flat &dA &d@ 6 = trill with sharp following New &dA11/05/05 &dA &d@ 7 = trill with natural following " &dA &d@ 8 = trill with flat following " &dA &d@ procedure puttrill int h,t1,t2,k1 /* k1 is new &dA11/05/05 x = x1 + esksp y = y1 + esksq(eskf12) k1 = x1 /* localize x1 /* New &dA11/05/05&d@ h = k1 /* New &dA11/05/05&d@ scx = x scy = y if a1 > 1 if a1 > 2 and a1 < 6 t1 = y - eskvpar(45) t2 = int("..389"{a1}) + 210 /* music font scb = t2 scy = t1 perform charout scy = y end x += eskhpar(41) scb = 236 perform charout scx = x &dA &dA &d@ New code added to implement accidentals following a trill sign &dA11/05/05 &dA if a1 > 5 and a1 < 9 x -= eskvpar(1) t1 = y - eskvpar(2) t2 = a1 + 185 /* music font (cue size) k1 += eskvpar(2) scx = x scy = t1 scb = t2 perform charout x += eskvpar(3) scx = x scy = y end &dA &dA &d@ End of &dA11/05/05&d@ New Code h = k1 + eskhpar(41) /* k1 replaces x1 &dA11/05/05 end scb = 237 loop while h < x2 perform charout h += eskhpar(40) repeat return &dA &d@ &dA &dA &d@*P&dA 23. sysline &dA &d@ &dA &dA &d@ Purpose: Typeset left-hand system line &dA &dA &d@ Inputs: eskf11 = number of parts &dA &d@ esksq(1) = y coordinate of first part &dA &d@ esksq(eskf11) = y coordinate of last part &dA &d@ esksp = x-coordinate of beginning of line &dA &d@ esksyscode = format for brace/bracket &dA &d@ procedure sysline int a1,a2,a3,a4,a5,a6,a7 int a8,a9,a10,a11 /* added &dA03/11/06&d@ if esksyscode = "" return end &dA &dA &d@ 1. typeset left-hand bar &dA x = esksp z = 82 y1 = esksq(1) &dK &d@ y2 = esksq(eskf11) &dA &dA &d@ Adding code &dA11/13/03&d@ to deal with mixed staff sizes &dA a4 = notesize a3 = nsz(eskf11) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction if notesize <> a3 notesize = a3 /* set font size for computing eskvpar(44) perform init_par end y2 = esksq(eskf11) + eskvpar(44) /* line thickness added &dA04-25-95 y2 -= a5 if notesize <> a4 notesize = a4 /* return to original font size perform init_par end &dA brkcnt = 0 if eskf11 > 1 or eskvst(1) > 0 perform putbar (eskf11) end &dA &dA &d@ 2. typeset braces &dA a2 = 0 loop for a1 = 1 to len(esksyscode) if esksyscode{a1} = "[" x = esksp - eskhpar(46) y1 = esksq(a2+1) end if esksyscode{a1} = "]" y2 = esksq(a2) &dA &dA &d@ Adding code &dA11/13/03&d@ to deal with mixed staff sizes &dA a4 = notesize a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction y2 -= a5 &dA z = 84 brkcnt = 0 perform putbar (a2) y = y1 z = 87 perform setmus y = y2 + eskvpar(8) + eskvst(a2) z = 88 perform setmus end if ".:,;" con esksyscode{a1} /* changed &dA11/13/03&d@ ++a2 end repeat &dA &dA &d@ 3. typeset brackets &dA x1 = x - eskhpar(47) a2 = 0 loop for a1 = 1 to len(esksyscode) if esksyscode{a1} = "{" y1 = esksq(a2+1) end if esksyscode{a1} = "}" x = x1 y2 = esksq(a2) + eskvpar(8) + eskvst(a2) &dA &dA &d@ Adding code &dA11/13/03&d@ to deal with mixed staff sizes &dA a4 = notesize a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction y2 -= a5 &dA &dA &dA &d@ Adding code &dA03/11/06&d@ to fully implement the 2-font system of brackets &dA if notesize < 10 a8 = 100 a9 = 3 a10 = 6 a11 = 96 else a8 = 201 a9 = 6 a10 = 12 a11 = 192 end &dA a3 = y2 - y1 &dA &dA &d@ There are three cases: a3 <= 201 (one glyph) granularity = 6 &dA &d@ 202 <= a3 <= 402 (two glyphs) granularity = 12 &dA &d@ 403 <= a3 <= 570 (three glyphs) granularity = 12 &dA &dK &d@ if a3 <= 201 if a3 <= a8 /* New &dA03/11/06&d@ &dK &d@ a4 = a3 + 2 / 6 * 6 /* actual length a4 = a3 + 2 / a9 * a9 /* actual length New &dA03/11/06&d@ a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y &dK &d@ a5 = a4 / 6 + 20 /* font number a5 = a4 / a9 + 20 /* font number New &dA03/11/06&d@ scx = x scy = y scb = a5 scf = 320 perform charout scf = notesize else &dK &d@ if a3 <= 402 if a3 <= (a8 * 2) /* New &dA03/11/06&d@ &dK &d@ a4 = a3 + 5 / 12 * 12 /* actual length a4 = a3 + 5 / a10 * a10 /* actual length New &dA03/11/06&d@ a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y &dK &d@ a5 = a4 / 12 + 10 * 2 /* font number a5 = a4 / a10 + 10 * 2 /* font number New &dA03/11/06&d@ a6 = a4 / 2 /* y increment to second glyph scx = x scy = y scb = a5 scf = 320 perform charout scy += a6 ++scb perform charout scf = notesize else &dK &d@ a4 = a3 + 5 / 12 * 12 /* actual length a4 = a3 + 5 / a10 * a10 /* actual length New &dA03/11/06&d@ a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y &dK &d@ a5 = a4 / 12 - 5 * 3 + 1 /* font number a5 = a4 / a10 - 5 * 3 + 1 /* font number New &dA03/11/06&d@ &dK &d@ a6 = a4 - 384 /* y increment to third glyph a6 = a4 - (a11 * 2) /* y increment to third glyph New &dA03/11/06 scx = x scy = y scb = a5 scf = 320 perform charout &dK &d@ scy += 192 scy += a11 /* New &dA03/11/06&d@ ++scb perform charout scy += a6 ++scb perform charout scf = notesize end end end if ".:,;" con esksyscode{a1} /* changed &dA11/13/03&d@ ++a2 end repeat return &dA &d@ &dA &dA &d@*P&dA 24. putbar (t1) &dA &d@ &dA &dA &d@ Purpose: Typeset bar line &dA &dA &d@ Inputs: t1 = staff number of last line &dA &d@ y1 = coordinate of top of line &dA &d@ y2 = coordinate of last bar character &dA &d@ brkcnt = number of breaks in bar &dA &d@ barbreak(.,1) = y coordinate of top of break . &dA &d@ barbreak(.,2) = y coordinage of bottom of break . &dA &d@ x = x-coordinat of line &dA &d@ z = font character &dA procedure putbar (t1) int t1,t2 int a3 getvalue t1 if brkcnt = 0 t2 = y2 + eskvst(t1) loop for y = y1 to t2 step eskvpar(8) perform setmus repeat y = t2 perform setmus return end c3 = y1 loop for c1 = 1 to brkcnt c4 = barbreak(c1,1) - eskvpar(8) if c4 > c3 if c4 < y2 loop for y = c3 to c4 step eskvpar(8) perform setmus repeat y = c4 perform setmus c3 = barbreak(c1,2) end end repeat c4 = y2 + eskvst(t1) if c4 >= c3 loop for y = c3 to c4 step eskvpar(8) perform setmus repeat y = c4 perform setmus end return &dA &d@ &dA &dA &d@*P&dA 26a. printslur_screen &dA &d@ &dA &dA &d@ Purpose: read slur data from bigslur, compile and &dA &d@ send slur to screen &dA &dA &d@ Input: ori case: 1,2,3 or 4 &dA &d@ snum slur number &dA &d@ x x location &dA &d@ y y location &dA &d@ mode 1 = display, 0 = clear (cancel) &dA &d@ sitflag situation flag &dA &dA &d@ bit 5: continuous slur broken slur &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA procedure printslur_screen (ori,snum,x,y,mode,sitflag) str file.200,pointer.6,data.500 &dA &d@ bstr bt.800(150) &dAThis is now global&d@ int snum,ori int offset,datalen,nrows int slen,srise int bulge int h,i,j,k,n,x,y,t,maxn int dpnt,sdpnt int code,cnt,ndata(2),kdata(2) int mode,sitflag int broksize /* &dA03/15/97&d@ real rx * getvalue ori,snum,x,y,mode,sitflag if bit(5,sitflag) = 1 /* &dA03/15/97&d@ broksize = sitflag >> 8 else broksize = 0 end sitflag &= 0x01 &dA &d@ file = "c:\wbh\res\mus\prnt\bitmap\slurs\bigslur" if notesize = 14 file = DISP_DISK // ":/musprint/bitmap/slurs/bigslur" end if notesize = 21 file = DISP_DISK // ":/musprint/bitmap21/slurs/bigslur" end if notesize = 6 file = DISP_DISK // ":/musprint/bitmap06/slurs/bigslur" end if notesize = 18 /* Notesize 18 bigslur is new &dA12/18/04 file = DISP_DISK // ":/musprint/bitmap18/slurs/bigslur" end if notesize = 16 /* Notesize 16 bigslur is new &dA01/01/09 file = DISP_DISK // ":/musprint/bitmap16/slurs/bigslur" end &dA &dA &d@ putc printslur called &dA &d@ putc file = ~file &dA &d@ putc ori = ~ori snum = ~snum x = ~x y = ~y &dA &d@ getc &dA open [1,5] file i = snum * 6 + 1 len(pointer) = 6 read [1,i] pointer offset = ors(pointer{1,4}) datalen = ors(pointer{5,2}) if datalen < 4 or datalen > 500 close [1] snum = 1000000 passback snum return end len(data) = datalen if offset = 0 close [1] snum = 1000000 passback snum return end read [1,offset] data n = ors(data{1,3}) if n <> snum close [1] snum = 1000000 passback snum return end nrows = ors(data{4}) slen = ors(data{5,2}) srise = ors(data{7}) bulge = ors(data{8}) if bulge > 127 /* added &dA01/03/05&d@ bulge = 0 end slen += bulge /* added &dA11-19-92&d@ if bulge > 0 x -= bulge end i = 0 /* look for vert shift if ori = 1 i = nrows - 1 else if ori = 2 i = nrows - 1 - srise else if ori = 3 i = srise end end end y = y - i /* move screen cursor to point scx = x scy = y * if ori = 1 or ori = 2 dpnt = 9 else if slen < 256 dpnt = len(data) - 1 else dpnt = len(data) - 2 end end * maxn = 0 loop for i = 1 to nrows if slen < 256 cnt = 1 code = ors(data{dpnt,2}) if code & 0x8000 <> 0 cnt = 2 if ori > 2 dpnt = dpnt - 2 code = ors(data{dpnt,2}) end end sdpnt = dpnt loop for j = 1 to cnt code = code & 0x7fff rx = -.5 + sqt(flt(code)*2.0+.25) t = fix(rx+.0000001) kdata(j) = 255 - t t = t + 1 * t / 2 ndata(j) = code - t dpnt = dpnt + 2 if j < cnt code = ors(data{dpnt,2}) end repeat if ori > 2 dpnt = sdpnt - 2 end else cnt = 1 code = ors(data{dpnt,3}) if code & 0x800000 <> 0 cnt = 2 if ori > 2 dpnt = dpnt - 3 code = ors(data{dpnt,3}) end end sdpnt = dpnt loop for j = 1 to cnt code = code & 0x7fffff rx = -.5 + sqt(flt(code)*2.0+.25) t = fix(rx+.0000001) kdata(j) = 1000 - t t = t + 1 * t / 2 ndata(j) = code - t dpnt = dpnt + 3 if j < cnt code = ors(data{dpnt,3}) end repeat if ori > 2 dpnt = sdpnt - 3 end end * j = ndata(1) + kdata(1) bt(i) = zpd(ndata(1)) // npd(j) if cnt = 2 j = ndata(2) + kdata(2) bt(i) = bt(i) // zpd(ndata(2)) // npd(j) end if ori = 2 or ori = 3 bt(i) = bt(i) // zpd(slen) bt(i) = rev(bt(i)) bt(i) = trm(bt(i)) end n = bln(bt(i)) if n > maxn maxn = n end repeat if sitflag = 1 j = maxn / gapsize if bit(0,j) = 0 --j end &dA &dA &d@ xxxxxxxxxxx....xxxx....xxxx....xxxx....xxxx....xxxxxxxxxxx &dA &d@ | odd number | &dA &d@ j = largest odd number of intervals that will fit inside maxn &dA j *= gapsize i = maxn - j i >>= 1 /* initial correction bt(250) = dup("1",i) // dotted{1,j} // dup("1",i+10) /* mask loop for i = 1 to nrows bt(i) = bnd(bt(i),bt(250)) repeat end if broksize > 0 /* &dA03/15/97&d@ j = maxn - broksize >> 1 if j < 0 j = 0 end i = maxn - j - j bt(250) = dup("1",j) // dup("0",i) // dup("1",j) loop for i = 1 to nrows bt(i) = bnd(bt(i),bt(250)) repeat end close [1] /* display slur contained in bt(nrows) if mode = 1 /* con3 = 1 if con1 = 0 setb gstr,bt,scx,scy,nrows,maxn,1,3 else setb red_gstr,bt,scx,scy,nrows,maxn,1,1 end else if con1 = 0 clearb gstr,bt,scx,scy,nrows,maxn,1,3 else clearb red_gstr,bt,scx,scy,nrows,maxn,1,1 end end return * &dA &d@ &dA &dA &d@*P&dA 32. barline &dA &d@ &dA &dA &d@ Purpose: Typeset bar line &dA &dA &d@ Inputs: eskf11 = number of parts &dA &d@ esksq(1) = y coordinate of first part &dA &d@ esksq(eskf11) = y coordinate of last part &dA &d@ x = x-coordinate of line &dA &d@ z = bar character &dA &d@ esksyscode = format for bar &dA &d@ govstaff = governing staff for size (length) of barline &dA &d@ nsz(.) = notesizes for each staff in the systme &dA &d@ &dA &d@ &dA &d@ Procedure rewritten &dA11/13/03&d@ to deal with mixed staff sizes &dA procedure barline int a1,a2,a3,a4,a5 if z = 86 /* Case: dotted bar line cannot connect staff lines loop for a1 = 1 to eskf11 y = esksq(a1) a4 = nsz(a1) if notesize <> a4 notesize = a4 /* set font size for segment perform init_par end perform setmus repeat else a2 = 0 loop for a1 = 1 to len(esksyscode) if "[(" con esksyscode{a1} a4 = 0 /* this will become the font size for this segment y1 = esksq(a2+1) end if "])" con esksyscode{a1} &dA &dA &d@ If a4 is not determined at this point, set it to the default &dA if a4 = 0 a4 = nsz(a2) /* font size of bottom staff in this segment end a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction if notesize <> a3 notesize = a3 /* set font size for computing eskvpar(44) perform init_par end y2 = esksq(a2) + eskvpar(44) /* line thickness added &dA04-25-95 y2 -= a5 if notesize <> a4 notesize = a4 /* set font size for segment perform init_par end perform putbar (a2) end if ".:,;" con esksyscode{a1} ++a2 if mpt > 2 if a4 = 0 a4 = nsz(a2) else if nsz(a2) > a4 a4 = nsz(a2) end end end end repeat end &dA return &dA &dA &d@ ************************************************** &dA procedure esksave1 if htype = "V" &dA &dA &d@ structure of transp super-object: 4. situation: 0=8av up, 1=8av down &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from obj1 &dA &d@ 8. length of right vertical hook &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) tline = txt(line,[' '],lpt) y1 = int(tline) /* + esksuperdata(k,2) if y1 > 700 y1 -= 1000 y1 += eskvst(eskf12) end tline = txt(line,[' '],lpt) a1 = int(tline) perform puttrans return end if htype = "E" &dA &dA &d@ structure of ending super-object: 4. ending number (0 = none) &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from staff lines &dA &d@ 8. length of left vertical hook &dA &d@ 9. length of right vertical hook &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) perform putending return end if htype = "D" &dA &dA &d@ structure of dashes super-object: 4. horiz. disp. from obj1 &dA &d@ 5. horiz. disp. from obj2 &dA &d@ 6. vert. disp. from staff lines &dA &d@ 7. spacing parameter &dA &d@ 8. font designator &dA tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) tline = txt(line,[' '],lpt) y1 = esksuperdata(k,2) if y1 > 700 y1 = eskvst(eskf12) else y1 = 0 end y1 += int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) perform putdashes return end if htype = "R" &dA &dA &d@ structure of trill super-object: 4. situation: 1 = no trill, only ~~~~ &dA &d@ 2 = trill with ~~~~ &dA &d@ 3 = tr ~~~~ with sharp above &dA &d@ 4 = tr ~~~~ with natural above &dA &d@ 5 = tr ~~~~ with flat above &dA &d@ 5. horiz. disp. from object 1 &dA &d@ 6. horiz. disp. from object 2 &dA &d@ 7. vert. disp. from object 1 &dA tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) tline = txt(line,[' '],lpt) y1 = int(tline) + esksuperdata(k,2) if y1 > 700 y1 -= 1000 y1 += eskvst(eskf12) end perform puttrill return end if htype = "W" &dA &dA &d@ structure of wedge super-object: 4. left spread &dA &d@ 5. right spread &dA &d@ 6. horiz. disp. from obj1 &dA &d@ 7. beg. vert. disp. from staff &dA &d@ 8. horiz. disp. from obj2 &dA &d@ 9. end. vert. disp. from staff &dA tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) c3 = esksuperdata(k,2) if c3 > 700 c3 = eskvst(eskf12) else c3 = 0 end y1 = int(tline) + c3 tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) a1 = x2 - x1 if a1 < eskhpar(39) x2 = x1 + eskhpar(39) end tline = txt(line,[' '],lpt) y2 = int(tline) + c3 perform putwedge return end return &dAÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dAº L O N G S L U R C O N S T R U C T I O N º&d@ &dAÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ #define MAPZ 2500 procedure make_longslur (length,rise,smode) str out.MAPZ str map.MAPZ(250),zeros.MAPZ bstr temp.MAPZ int g,h,i,j,k,p,q,s,t int hh,ii,jj,kk int x1,x2,y1,y2 int rise,length int pc,pd,pe,pf,pg,ph int scnt int smode real delta,alpha,beta,delta2,beta2 real X,x,Y,y,z,Cx,Cy,R,L,H,D,W,Q,P,A,B,Ca,Cb real a,b,c real xx,yy,u,v real inpx,outpx,inpy,outpy,ind,outd real sx(8000),sy(8000) real PP,QQ real SCALE real rtype zeros = zpd(MAPZ) &dA* I. Determine scaling factor if notesize = 14 SCALE = 1.0 else SCALE = flt(notesize) / 14.0 end &dA* II. Get rise and length limits getvalue length,rise,smode i = length - 1 X = flt(i) Y = flt(rise) X = X / SCALE /* &dA05-12-95&d@ all computations done Y = Y / SCALE /* at original size. length = length * 14 / notesize /* clear slur array loop for i = 1 to 250 map(i) = pad(MAPZ) repeat &dA &dA &d@ &dEBeginning of slur generation&d@ &dA &dAÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dA³ P A R A M E T R I C M A G I C ³&d@ &dAÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ rtype = 2.0 if X < 600.0 H = X * .03 + 9.0 + (1.9 * rtype) else H = 27.0 + (1.9 * rtype) end if X > 1200.0 H = H + (X - 1200.0 / 200.0) end rtype -= 1.0 L = X * X + (Y * Y) L = sqt(L) a = rtype / 75. W = L * (.66 - a) /* experimental value &dA &dA &d@ compute R, P, A, B, Cx, Cy, Ca, Cb and check limitations &dA &dA &d@ 1. Q: &dA if X > 300.0 Q = 15.0 else Q = 13.0 end LS_PAA: &dA &dA &d@ 2. R = L*L/Q/8 + Q/2 &dA &d@ x = L * L / Q / 8.0 y = Q / 2.0 R = x + y &dA &dA &d@ 3. P = R - (R*R - (W*W/4))^1/2 component of height from &dA &d@ middle section x = (R * R) - (W * W / 4.0) P = R - sqt(x) y = (L - W) / 2.0 + P if H > y H = y end if H < Q H = dec(Q) + .5 end &dA &dA &d@ 4. A = (L - W) / 2 B = H - P = transition point &dA A = (L - W) / 2.0 B = H - P &dA &dA &d@ 5. Cx = X/2 Cy = R - H = center of main arc &dA Cx = L / 2.0 Cy = H - R /* a negative number &dA &dA &d@ 6. Compute = center of starting arc &dA &dA &d@ [ B*(Cx-A)/(Cy-B) + (A*A + B*B)/2/A - A ] &dA &d@ Cb = ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ [ B/A + (Cx-A)/(Cy-B) ] &dA &dA &d@ Ca = (A*A + B*B)/2/A - B*(Cb)/ A &dA a = (Cx - A) / (Cy - B) b = (A * A) + (B * B) b = b / 2.0 / A Cb = (B * a + b - A) / (B / A + a) Ca = b - (B * Cb / A) &dA &dA &d@ normalize D-function &dA xx = L / 2.0 D = sqt(xx) / 4.8 if D > 1.50 D -= .16 /* radical if H / L > .200 D -= .10 end end if D > 1.70 D = D - 1.70 * .2 + 1.70 end if D > 1.95 D = D - 1.95 * .3 + 1.95 end if D > 2.25 D = D - 2.25 * .4 + 2.25 end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 1 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ º sqt(A*A + B*B) º &dA &d@ 1. compute beta = 2 * sin-1ºÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĺ sweep angle &dA &d@ º 2*sqt(Ca*Ca + Cb*Cb)º &dA a = A * A + (B * B) b = Ca * Ca + (Cb * Cb) c = sqt(b) beta = rtype / 7.5 if L >= 400. delta = L * .001 else delta = L * .006 - 2.00 end if R / c > 3.00 - beta + delta Q += .1 if Q < H - .5 goto LS_PAA end end c = sqt(a/b) beta = 2.0 * ars(c/2.0) &dA &dA &d@ 2. compute delta so that sweep hits every dot &dA a = sqt(a) /* length of arc (approx) delta = beta / a / 2.0 scnt = 0 alpha = 0.0 &dA &dA &d@ 3. begin sweep &dA LS_SW1A: a = 1.0 - cos(alpha) b = sin(alpha) x = Ca * a - (Cb * b) y = Ca * b + (Cb * a) if x < A ++scnt sx(scnt) = x sy(scnt) = y alpha += delta goto LS_SW1A end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 2 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. compute beta2 = sin-1{ [(L/2)-A] / R } &dA a = L / 2.0 - A / R beta2 = ars(a) &dA &dA &d@ 2. compute delta so that sweep hits every dot &dA delta2 = beta2 * 2.0 / W / 2.0 alpha = 0.0 - beta2 &dA &dA &d@ 3. begin sweep &dA LS_SW2A: x = R * sin(alpha) + Cx y = R * cos(alpha) + Cy if x < L - A ++scnt sx(scnt) = x sy(scnt) = y alpha += delta2 goto LS_SW2A end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 3 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. beta and delta already computed &dA alpha = beta &dA &dA &d@ 2. begin sweep &dA LS_SW3A: a = 1.0 - cos(alpha) b = sin(alpha) x = L - (Ca * a) + (Cb * b) y = Ca * b + (Cb * a) if x < L ++scnt sx(scnt) = x sy(scnt) = y alpha -= delta goto LS_SW3A end ++scnt sx(scnt) = L sy(scnt) = 0.0 &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ E N D O F S W E E P S. C O N S T R U C T S L U R ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. rotate data to produce rise &dA a = X / L b = Y / L loop for i = 1 to scnt x = sx(i) * a - (sy(i) * b) y = sx(i) * b + (sy(i) * a) sx(i) = x sy(i) = y repeat &dA &dA &d@ 2. setup thickness parameters &dA pc = length * 60 / (length + 400) /* carefully worked out formula &dA05/13/95 pd = pc * 3 / 10 pe = scnt - pc pf = scnt - pd if notesize = 21 /* disable this feature for notesize = 21 &dA12/03/08 pc = 1 pe = scnt end pg = 50 * scnt / 100 if length < 400 ph = 0 else ph = (length - 400) * scnt * 4 / 40000 end &dA &dA &d@ 3. compute ind, outd &dA loop for i = 1 to scnt if i < pc /* left hand side of slur ind = 0.6 if notesize = 21 ind = 1.3 end if i < pd /* extreme left end if notesize = 16 /* New size-16 &dA12/31/08&d@ outd = .4 * flt(i) / flt(pc) else outd = flt(i) / flt(pc) + .1 end else outd = 0.4 end if notesize = 14 outd += .4 end if notesize = 18 /* New size-18 &dA12/18/04&d@ outd += .3 end if notesize = 18 /* New size-18 &dA12/18/04&d@ outd += .3 end if notesize = 21 outd += .3 end goto LS_PCD end if i > pe /* right hand side of slur ind = 0.6 if i >= pf /* extreme right end j = scnt - i if notesize = 16 /* New size-16 &dA12/31/08&d@ outd = 0.4 * flt(j) / fl(pc) else outd = flt(j) / flt(pc) + .1 end else outd = 0.4 end if notesize = 14 outd += .4 end if notesize = 16 /* New size-16 &dA01/01/09&d@ outd += .3 end if notesize = 18 /* New size-18 &dA12/18/04&d@ outd += .3 end goto LS_PCD end /* middle of slur if i > pg + ph /* right side j = pe - i s = pe - pg - ph else /* left side if i < pg - ph j = i - pc s = pg - pc - ph else s = 10000 j = 9999 end end b = flt(j) * ars(1.0) / flt(s) /* max(b) = sin-1(1) a = sin(b) if notesize = 14 outd = D - .8 * a + .8 ind = D - .6 * a + .6 end &dA &dA &d@ New &dA01/01/09&d@ parameters for notesize 16 (based on create16.z) &dA if notesize = 16 outd = D - 0.1 * a + 0.4 ind = D - 0.6 * a + 0.6 outd += .29000 ind += .29000 end &dA &dA &d@ New &dA12/18/04&d@ parameters for notesize 18 (based on create18.z) &dA if notesize = 18 outd = D - 0.7 * a + 0.7 ind = D - 0.6 * a + 0.6 outd += .69000 ind += .79000 end &dA &dA &d@ &dA01/26/06&d@ parameters added for notesize 6 &dA if notesize = 6 outd = D - 0.8 * a + 0.8 ind = D - 0.6 * a + 0.6 outd += .39000 ind += .49000 end &dA &dA &d@ &dA12/03/08&d@ parameters changed for notesize 21 &dA if notesize = 21 outd = D - 0.6 * a + 0.6 ind = D - 1.0 * a + 1.0 outd += .29000 ind += .89000 end &dA &dA &d@ 4. compute outside point, inside point &dA LS_PCD: x = sx(i) y = sy(i) &dA &dA &d@ give finite width to slur &dA if i < scnt u = sx(i+1) v = sy(i+1) else u = x v = y end if i > 1 xx = sx(i-1) yy = sy(i-1) else xx = x yy = y end u -= xx /* delta x v -= yy /* delta y c = u * u + (v * v) c = sqt(c) /* delta hypotinus a = outd / c b = ind / c outpx = x - (a * v) outpy = y + (a * u) inpx = x + (b * v) inpy = y - (b * u) &dA &dA &d@ 5. compute box coordinates &dA if outpx < inpx a = outpx outpx = inpx inpx = a end if outpy < inpy a = outpy outpy = inpy inpy = a end outpx = outpx + 30.0 /* - .5 inpx = inpx + 30.0 /* - .5 outpy = outpy + 20.0 - 1.0 inpy = inpy + 20.0 + .5 &dA &dA &d@ For notesize = 21, it appears that scaling here is better &dA if notesize = 21 inpx = inpx * SCALE outpx = outpx * SCALE inpy = inpy * SCALE outpy = outpy * SCALE end x1 = fix(inpx) x2 = fix(outpx) y1 = fix(inpy) y2 = fix(outpy) if x2 - x1 < 2 ++y2 /* radical end &dA &dA &d@ 6. set points inside box to 1 (with inverted vertical axis) &dA &dA &dA &d@ Here is where you scale the slur back to its original size &dA if notesize <> 21 x1 = x1 * notesize / 14 x2 = x2 * notesize + 7 / 14 y1 = y1 * notesize / 14 y2 = y2 * notesize + 7 / 14 end if y2 > 249 y2 = 249 end loop for j = y1 to y2 q = 250 - j loop for k = x1 to x2 map(q){k} = "x" repeat repeat repeat &dA &dA &d@ &dEEnd of slur generation&d@ &dA /* determine size of map display loop for i = 1 to 250 map(i) = trm(map(i)) if map(i) <> "" goto LS_CE end repeat LS_CE: y1 = i loop for j = i to 249 map(j+1) = trm(map(j+1)) if map(j) = "" and map(j+1) = "" goto LS_CF end repeat LS_CF: y2 = j - 1 loop for j = 1 to MAPZ loop for i = y1 to y2 if map(i){j} = "x" goto LS_CH end repeat repeat LS_CH: x1 = j x2 = 0 loop for i = y1 to y2 if x2 < len(map(i)) x2 = len(map(i)) end repeat /* write slur to longslur(.) x2 = x2 - x1 /* x range j = 0 if smode < 3 loop for i = y1 to y2 map(i) = map(i) // pad(MAPZ) out = map(i){x1,x2} if smode = 2 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat else loop for i = y2 to y1 step -1 map(i) = map(i) // pad(MAPZ) out = map(i){x1,x2} if smode = 3 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat end if smode = 1 length = j - 1 else if smode = 2 length = j - 1 - rise else if smode = 3 length = rise else length = 0 end end end rise = j passback length,rise /* length = initial offset; rise = number of rows return &dA &d@ &dIÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dA &d@ &dIº º&d@ &dA &d@ &dIº PROCEDURES ADDED FOR SCREEN DISPLAY º&d@ &dA &d@ &dIº º&d@ &dA &d@ &dIÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ * procedure stringout (out) str out.500 int font,i,k,fontoff getvalue out font = revmap(scf) fontoff = font - 1 * 256 if con3 = 1 if con2 > 0 and con2 <> 5 if conx1 > scx - 10 conx1 = scx - 10 end if cony1 > scy - hght(font) cony1 = scy - hght(font) end if cony2 < scy + dpth(font) cony2 = scy + dpth(font) end end if con1 = 0 loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff setb gstr,FA,scx,scy,k,1 end repeat else loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff setb red_gstr,FA,scx,scy,k,1 end repeat end if con2 > 0 and conx2 < scx + 10 conx2 = scx + 10 end else if con1 = 0 loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff clearb gstr,FA,scx,scy,k,1 end repeat else loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff clearb red_gstr,FA,scx,scy,k,1 end repeat end end return procedure charout int font,k,i,j font = revmap(scf) k = font - 1 * 256 + scb &dA &dA &d@ putc k = ~k font = ~font /* &dADEBUG&d@ &dA if con3 = 1 if con2 > 0 and con2 <> 5 if conx1 > scx - 10 conx1 = scx - 10 end if cony1 > scy - hght(font) cony1 = scy - hght(font) end if cony2 < scy + dpth(font) cony2 = scy + dpth(font) end end if con1 = 0 setb gstr,FA,scx,scy,k,1 else setb red_gstr,FA,scx,scy,k,1 end if con2 > 0 and conx2 < scx + 40 conx2 = scx + 40 end else if con1 = 0 clearb gstr,FA,scx,scy,k,1 else clearb red_gstr,FA,scx,scy,k,1 end end return procedure pan (flag) str lflag.1 /* New &dA12/18/05&d@ int k,h,j int x(4),y(4) int flag int sflag,oldsflag int wflag2,wflag3,wflag4 int px,py int t1,t2 int font,color,scflag int tsavensz int v1,v2,v3,v4,v5,v6,v7,v8,v9,v10 int v3a(10) flag = 0 x(1) = 20 y(1) = 240 x(2) = 10 y(2) = 160 x(3) = 20 y(3) = 160 x(4) = 20 y(4) = 160 wflag2 = 0 wflag3 = 0 wflag4 = 0 sflag = 1 oldsflag = 1 trecord_cnt = 0 treset [X2] activate red_gstr,px,py,14 PPP: if oldsflag > 0 px = x(oldsflag) py = y(oldsflag) end if oldsflag <> sflag if oldsflag = 1 activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 else if oldsflag = 2 activate tstr2,px,py,5 activate tstr2,px,py,0 activate blue_horiz2t,px-10-LMRG2,py-TMRG2,5 activate blue_horiz2b,px-10-LMRG2,py+1650-TMRG2,5 activate blue_vert2v,px-LMRG2,py-80-TMRG2,5 activate blue_vert2r,px+159-LMRG2,py-80-TMRG2,5 activate red_tstr2,px,py,5 activate red_tstr2,px,py,0 else if oldsflag = 3 activate tstr3,px,py,5 activate tstr3,px,py,0 activate blue_horiz3t,px-10-LMRG3,py-TMRG3,5 activate blue_horiz3b,px-10-LMRG3,py+1100-TMRG3,5 activate blue_vert3v,px-LMRG3,py-80-TMRG3,5 activate blue_vert3r,px+106-LMRG3,py-80-TMRG3,5 activate red_tstr3,px,py,5 activate red_tstr3,px,py,0 else activate tstr4,px,py,5 activate tstr4,px,py,0 activate blue_horiz4t,px-10-LMRG4,py-TMRG4,5 activate blue_horiz4b,px-10-LMRG4,py+825-TMRG4,5 activate blue_vert4v,px-LMRG4,py-80-TMRG4,5 activate blue_vert4r,px+79-LMRG4,py-80-TMRG4,5 activate red_tstr4,px,py,5 activate red_tstr4,px,py,0 end end end end px = x(sflag) py = y(sflag) if sflag = 1 activate gstr,px,py,1 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,3 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,3 activate blue_vert1v,px-LMRG1,py-80-TMRG1,3 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,3 if oldsflag <> sflag activate red_gstr,px,py,4 else if trecord_cnt > 0 activate red_gstr,px,py,4 else activate red_gstr,px,py,14 end end else if sflag = 2 activate tstr2,px,py,1 activate blue_horiz2t,px-10-LMRG2,py-TMRG2,3 activate blue_horiz2b,px-10-LMRG2,py+1650-TMRG2,3 activate blue_vert2v,px-LMRG2,py-80-TMRG2,3 activate blue_vert2r,px+159-LMRG2,py-80-TMRG2,3 if trecord_cnt > 0 activate red_tstr2,px,py,4 end else if sflag = 3 activate tstr3,px,py,1 activate blue_horiz3t,px-10-LMRG3,py-TMRG3,3 activate blue_horiz3b,px-10-LMRG3,py+1100-TMRG3,3 activate blue_vert3v,px-LMRG3,py-80-TMRG3,3 activate blue_vert3r,px+106-LMRG3,py-80-TMRG3,3 if trecord_cnt > 0 activate red_tstr3,px,py,4 end else activate tstr4,px,py,1 activate blue_horiz4t,px-10-LMRG4,py-TMRG4,3 activate blue_horiz4b,px-10-LMRG4,py+825-TMRG4,3 activate blue_vert4v,px-LMRG4,py-80-TMRG4,3 activate blue_vert4r,px+79-LMRG4,py-80-TMRG4,3 if trecord_cnt > 0 activate red_tstr4,px,py,4 end end end end activate msgstr,0,MSGVLOC,1 activate redmsgstr,0,MSGVLOC,4 PPQ: if sflag = 1 x2cur = 8 * px + xcur y2cur = py + ycur else if sflag = 2 x2cur = 8 * px + (xcur / 2) y2cur = py + (ycur / 2) else if sflag = 3 x2cur = 8 * px + (xcur / 3) y2cur = py + (ycur / 3) else x2cur = 8 * px + (xcur / 4) y2cur = py + (ycur / 4) end end end if x2cur < LMARG h = LMARG - x2cur + 7 / 8 + 9 / 10 * 10 x(sflag) += h goto PPP end if x2cur > RMARG h = x2cur - RMARG + 7 / 8 + 9 / 10 * 10 x(sflag) -= h goto PPP end if y2cur < TMARG h = TMARG - y2cur + 79 / 80 * 80 y(sflag) += h goto PPP end if y2cur > BMARG h = y2cur - BMARG + 79 / 80 * 80 y(sflag) -= h goto PPP end clearb curstr, CURSOR, acur, bcur, 1, 1 x2cur -= 30 y2cur -= 10 x2cur = x2cur / 8 acur = rem bcur = 0 setb curstr, CURSOR, acur, bcur, 1, 1 activate curstr, x2cur, y2cur, 3 &dA &dA &d@ Display current line &dA if cmode = "h" and supercursor > 0 a = super_pointers(supercursor,1) else a = X_point end tget [X,a] new_line .t8 jtype .t8 temp .t3 g g g if "JH" con new_line{1} new_line = new_line{1,2} // new_line{8..} end tsavensz = notesize notesize = MSGFONTZ if notesize <> tsavensz perform init_par end #if MSGLINOPT font = 200 color = 4 scflag = 0 scx = MSGTAB6A scy = MSGROW2 perform msgout (current_line,font,color,scflag) scflag = 1 scx = MSGTAB6A scy = MSGROW2 perform msgout (new_line,font,color,scflag) #endif current_line = new_line &dA &dA &d@ Display current definition &dA new_def = "" if current_line{1} = "K" new_def = sub_def(g) // " sub-object" end if current_line{1} = "J" &dK &d@ if "BCKTDSNRGQFIM" con jtype if "BCKTDSNRGQFIMr" con jtype /* New &dA10/15/07&d@ if mpt = 14 /* New &dA10/15/07&d@ mpt = 8 end new_def = obj_def(mpt) // " object" end end if current_line{1} = "H" mpt = 1 line = txt(temp,[' ']) line = txt(temp,[' ']) if "BTSXWDERVFN" con line{1} new_def = super_def(mpt) // " super-object" end end if current_line{1} = "W" new_def = "Word(s) sub-object" end if current_line{1} = "T" new_def = "Text sub-object" end if current_line{1} = "L" or current_line{1} = "l" new_def = "Lines (musical staff) " new_def = new_def // "Special commands: arrow up/down moves text lines or figures up or down" end if current_line{1} = "S" new_def = "System of staff lines" end if current_line{1} = "X" new_def = "General text record" end font = MSGFONT color = 4 scflag = 0 scx = MSGTAB5A scy = MSGROW2 perform msgout (current_def,font,color,scflag) scflag = 1 scx = MSGTAB5A scy = MSGROW2 perform msgout (new_def,font,color,scflag) if notesize <> tsavensz notesize = tsavensz perform init_par end current_def = new_def NOOP: perform pgetk (k) if k <> oldk or k <> 0x030120 ptoggle = 0 else ptoggle = 1 - ptoggle end oldk = k oldsflag = sflag NEWK: if k = 0x03040a /* activate gstr,0,0,5 activate gstr,0,0,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 flag = 1 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x030810 /* activate gstr,0,0,5 activate gstr,0,0,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 flag = 2 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x03080c /* activate gstr,0,0,5 activate gstr,0,0,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x01001b /* putc .b27 Y.b27 F... return 1 end &dA &dA &d@ &dA ReDraw Command &dA if k = 0x010052 or k = 0x010072 /* r or R = redraw activate gstr,0,0,0 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct activate gstr,0,0,-1 goto PPP end &dA &dA &d@ &dA Cancel Command &dA if k = 0x010043 /* C = cancel if trecord_cnt = 0 goto NOOP end h = 1 CC1: g = list_order(h,1) if g <> TOP_FLAG h = g goto CC1 end &dA &dA &d@ Here is where you cancel all changes &dA CC3: a = list_order(h,4) if a <> 0 list_order(h,4) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto CC3 end setup red_gstr,300,3100,1 if wflag4 <> 0 setup red_tstr4,160,910,1 setup red_tstr2,160,1600,1 else if wflag2 <> 0 setup red_tstr2,160,1600,1 end end if wflag3 <> 0 setup red_tstr3,160,1040,1 end activate red_gstr,px,py,3 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 treset [X2] trecord_cnt = 0 con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct activate gstr,0,0,-1 goto PPP end &dA &dA &d@ &dA Save Command &dA if k = 0x010053 or k = 0x010073 /* s or S = save if trecord_cnt = 0 goto NOOP end h = 1 SS1: g = list_order(h,1) if g <> TOP_FLAG h = g goto SS1 end hh = h SS2: if list_order(h,5) = -1 list_order(h,3) = -1 list_order(h,5) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto SS2 end &dA &d@ &dA &d@ Here is where you turn off the things that have been moved &dA &d@ con1 = 0 /* construct on black con2 = 5 con3 = 0 /* use clearb con4 = 0 perform construct &dA &d@ &dA &d@ Here is where you re-display the things that are moved &dA &d@ con1 = 0 /* construct on black con2 = 3 /* selective construction, with staff lines con3 = 1 /* use setb perform construct activate gstr,0,0,-1 &dA &dA &d@ Here is where you copy modified records back to the main table &dA h = hh SS3: a = list_order(h,4) if a <> 0 tget [X2,a] line line = trm(line) tput [X,h] ~line list_order(h,4) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto SS3 end setup red_gstr,300,3100,1 if wflag4 <> 0 setup red_tstr4,160,910,1 setup red_tstr2,160,1600,1 else if wflag2 <> 0 setup red_tstr2,160,1600,1 end end if wflag3 <> 0 setup red_tstr3,160,1040,1 end activate red_gstr,px,py,3 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 treset [X2] trecord_cnt = 0 goto PPP end &dA &dA &d@ &dA &dA &d@ &dA Editing commands &dA &d@ &dA &dA if (k >= 0x03010d and k <= 0x03011c) or (k >= 0x030105 and k <= 0x030108) /* various combinations of alt     /* also cont-shft     /* also shft     if (k >= 0x03010d and k <= 0x030110) incre = 1 else incre = 3 end if cmode = "g" if (k = 0x03010d or k = 0x03010f or (k >= 0x030111 and k <= 0x030114)) else goto PPQ end &dA &dA &d@ Flag all members of "group" for purposes of turning off glyphs &dA g = pointers(obcursor,5) &dA &dA &d@ &dA12/17/03&d@ &dA &dA &d@ Get the larr index that helped generate the obx for this object &dA larrx = pointers(g,10) if larrx = 0 dputc Program Warning: No larr index for this object end &dA loop h = g g = pointers(h,5) repeat while g <> h con4 = pointers(h,8) /* pointer to system record for this system GRP11: g = pointers(h,1) /* pointer to table a = list_order(g,4) if a = 0 tget [X,g] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X2,a] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end list_order(g,3) = -1 list_order(g,5) = -1 &dA &dA &d@ &dA12/17/03&d@ &dA &dA &d@ Compare larrx for each member of group; hope they are all the same &dA &dK &d@ dputc larrx = ~larrx pointers(~h ,10) = ~pointers(h,10) if larrx > 0 and pointers(h,10) <> larrx and pointers(h,10) <> 0 dputc Program Error: larr indices for members of group are not identical end &dA &dA &dA &d@ Flag all super-objects &dA if supcnt > 0 b = g a = 0 /* super-object counter GRP13: b = list_order(b,2) c = list_order(b,4) if c > 0 tget [X2,c] tbyte .t8 supernum else tget [X,b] tbyte .t8 supernum end if tbyte <> "H" goto GRP13 end loop for d = 1 to supcnt if o(d) = supernum list_order(b,3) = -1 /* flag super object record list_order(b,5) = -1 o(d) = 0 ++a /* increment super-object counter if a = supcnt goto GRP12 else goto GRP13 end end repeat goto GRP13 /* this super-object is not on list end &dA &dA &d@ Flag all associated sub-object &dA GRP12: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte list_order(g,3) = -1 list_order(g,5) = -1 goto GRP12 end if pointers(h+1,9) = pointers(h,9) ++h goto GRP11 end g = h h = pointers(g,6) if h > g goto GRP11 end &dA &d@ &dA &d@ Here is where you turn off the things that will be moved &dA &d@ con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct &dA &dA &d@ Now look at group again; adjust position of members of "group" &dA g = pointers(obcursor,5) loop h = g g = pointers(h,5) repeat while g <> h GRP1: g = pointers(h,1) /* pointer to table a = list_order(g,4) if a = 0 ++trecord_cnt list_order(g,4) = trecord_cnt tget [X,g] line .t10 line2 a = trecord_cnt else tget [X2,a] line .t10 line2 end &dA &dA &d@ Increase (decrease) the x-coordinate of this object &dA sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 c += incre if larrx > 0 cum_larr(larrx,1) += incre /* added &dA12/17/03&d@ larrx = 0 end else c -= incre if larrx > 0 cum_larr(larrx,1) -= incre /* added &dA12/17/03&d@ larrx = 0 end end line = line{1,9} // chs(b) // " " // chs(c) // line2{sub..} tput [X2,a] ~line &dA &dA &d@ If this is a bar line, adjust the appropriate bar record (added &dA12/06/03&d@) &dA if line{8} = "B" a = int(line{3..}) a = pointers(a,2) tget [X,a] line2 b = int(line2{3..}) d = int(line2{sub..}) /* replace this with value = c line2 = "B " // chs(b) // " " // chs(c) // line2{sub..} b = list_order(a,4) if b = 0 ++trecord_cnt list_order(a,4) = trecord_cnt b = trecord_cnt end tput [X2,b] ~line2 list_order(a,3) = -1 list_order(a,5) = -1 end &dA &dA &dA &d@ Incremented backward (forward) all associated text records &dA GRP2: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte goto GRP2 end if pointers(h+1,9) = pointers(h,9) ++h goto GRP1 end g = h h = pointers(g,6) if h > g goto GRP1 end &dA &d@ &dA &d@ Here is where you re-display the things that are moved &dA &d@ con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 1 /* use setb perform construct activate red_gstr,0,0,-1 if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,5 activate red_tstr2,px,py,3 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,5 activate red_tstr3,px,py,3 end end if wflag4 = 1 conx1 >>= 1 cony1 >>= 1 conx2 >>= 1 cony2 >>= 1 dscale2 red_tstr2, red_tstr4, conx1, cony1, conx2, cony2 if sflag = 4 activate red_tstr4,px,py,5 activate red_tstr4,px,py,3 end end goto PPQ end &dA &dA &d@ End of "group" movement &dA if cmode = "j" goto JAC0 end if cmode = "x" tget [X,X_point] line if line{1} = "J" goto JAC00 end if "X" con line{1} con4 = X_point /* pointer to system record for this system list_order(X_point,3) = -1 list_order(X_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end sub = 3 b = int(line{sub..}) c = int(line{sub..}) d = int(line{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 or k = 0x030117 c += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 or k = 0x030115 c -= incre else if k = 0x03010e or k = 0x030119 or k = 0x03011b or k = 0x030116 d -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c or k = 0x030118 d += incre end end end end tput [X2,a] X ~b ~c ~d ~line{sub..} con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ End of &dE"X" movement&d@ in mode "x" &dA if "KWTk" con line{1} d = mpt h = X_point KAC1: /* attempt to set obcursor correctly g = list_order(h,1) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "J" goto KAC1 end b = int(line{3..}) con4 = pointers(b,8) /* pointer to system record for this system if d = 2 a = pointers(b,7) c = list_order(a,4) if c = 0 tget [X,a] .t3 c textoff else tget [X2,c] .t3 c textoff end end list_order(h,3) = -1 list_order(h,5) = -1 list_order(X_point,3) = -1 list_order(X_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 2 /* selective construction, no super-objects con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line .t3 line2 a = trecord_cnt else tget [X2,a] line .t3 line2 end sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 or k = 0x030117 b += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 or k = 0x030115 b -= incre else if d = 3 and c < 11 c = c - 1 * eskvpar(41) + textoff + 1000 end if k = 0x03010e or k = 0x030119 or k = 0x03011b or k = 0x030116 c -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c or k = 0x030118 c += incre end end end end line = line{1,2} // chs(b) // " " // chs(c) // line2{sub..} tput [X2,a] ~line con2 = 2 /* selective construction, omit super-objects goto REDIS end &dA &dA &d@ End of &dEsub-object movement&d@ in mode "x" &dA if line{1} = "L" or line{1} = "l" lflag = line{1} h = X_point b = 0 LAC1: /* mark all elements on line g = list_order(h,2) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if b = 0 and line{1} = "J" b = int(line{3..}) con4 = pointers(b,8) /* pointer to system record for this system end list_order(h,3) = -1 list_order(h,5) = -1 if line{1} <> "E" goto LAC1 end &dA &dA &d@ Flag barline records for this system &dA LAC1A: g = list_order(h,2) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "B" goto LAC1A end list_order(h,3) = -1 list_order(h,5) = -1 LAC1B: g = list_order(h,2) if g <> BOTTOM_FLAG a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} = "B" list_order(h,3) = -1 list_order(h,5) = -1 goto LAC1B end end &dA &dA &d@ Turn off all red on this line &dA con1 = 1 /* construct on red_gstr con2 = 3 /* selective construction, including redrawn staff line con3 = 0 /* use clearb sysflag = 0 perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end line = line // " " &dA &d@ Field 2: y off-set in system b = int(line{3..}) &dA &d@ Field 3: text off-set(s) from line (separated by |) &dA &d@ Field 4: eskdyoff(s) separated by | &dA &d@ Field 5: eskuxstart(s) separated by | &dA &d@ Field 6: eskbackloc(s) spearated by | &dA &d@ Field 7: eskxbyte(s) (length of field = number of bytes) line = line{sub..} line = mrt(line) lpt = 1 tline = txt(line,[' '],lpt) /* lpt -> beyond field 3 loop for v3 = 1 to 10 v3a(v3) = 0 repeat v3 = 1 v3a(1) = int(tline) LAC1Ba: if tline{sub} = "|" ++sub ++v3 v3a(v3) = int(tline{sub..}) goto LAC1Ba end line = line{sub..} line = mrt(line) lpt = 1 tline = txt(line,[' '],lpt) /* lpt -> beyond field 4 tline = txt(line,[' '],lpt) /* lpt -> beyond field 5 tline = txt(line,[' '],lpt) /* lpt -> beyond field 6 tline = txt(line,[' '],lpt) /* lpt -> beyond field 7 tline = line{1,lpt} tline = trm(tline) /* tline = fields 4 through 7 line = line{lpt..} line = mrt(line) &dA &d@ Field 8: y off-set to virtual staff line (0 = none) if line = "" putc Format Error in Line Record return 10 end d = int(line) &dA &d@ Field 9: notesize (0 = not specified; i.e., no change) line = line{sub..} line = mrt(line) if line = "" v9 = 0 else line = line // " " v9 = int(line) line = line{sub..} end &dA &d@ Field 10: additional offset for figured harmony (0 = not specified) line = mrt(line) if line = "" v10 = 0 else v10 = int(line) end if k >= 0x030115 and k <= 0x030118 if k = 0x030115 d -= eskvpar(2) else if k = 0x030116 b -= eskvpar(2) else if k = 0x030117 d += eskvpar(2) else b += eskvpar(2) end end end else if k >= 0x03010d and k <= 0x03011c if k = 0x03010f or k = 0x030112 or k = 0x030114 if d <> 0 d += incre end else if k = 0x03010d or k = 0x030111 or k = 0x030113 if d <> 0 d -= incre end else if k = 0x03010e or k = 0x030119 or k = 0x03011b b -= incre else b += incre end end end else if k >= 0x030105 and k <= 0x030108 if k = 0x030106 /*  if v3a(1) = 0 --v10 else loop for e = 1 to v3 v3a(e) -= 1 repeat end end if k = 0x030108 /*  if v3a(1) = 0 ++v10 else loop for e = 1 to v3 v3a(e) += 1 repeat end end if k = 0x030107 /* Ä ++v10 end if k = 0x030105 /* Ä --v10 end end end end line = "" loop for e = 1 to v3 - 1 line = line // chs(v3a(e)) // "|" repeat line = line // chs(v3a(v3)) tput [X2,a] ~lflag ~b ~line ~tline ~d ~v9 ~v10 con2 = 3 /* selective construction; including redrawn staff line sysflag = 0 goto REDIS end &dA &dA &d@ End of &dEstaff line movement&d@ in mode "x" &dA if line{1} = "S" h = X_point con4 = X_point SAC1: /* mark all elements in system g = list_order(h,2) if g = BOTTOM_FLAG goto SAC2 end a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "S" list_order(h,3) = -1 list_order(h,5) = -1 goto SAC1 end SAC2: &dA &dA &d@ Turn off all red and all black on this system &dA if list_order(X_point,4) = 0 con1 = 0 /* erasing black system con2 = 0 /* redraw entire system con3 = 0 /* use clearb perform construct activate gstr,0,0,-1 if wflag2 = 1 dscale2 gstr, tstr2 if sflag = 2 activate tstr2,px,py,1 end end if wflag3 = 1 dscale3 gstr, tstr3 if sflag = 3 activate tstr3,px,py,1 end end if wflag4 = 1 dscale2 tstr2, tstr4 if sflag = 4 activate tstr4,px,py,1 end end end con1 = 1 /* construct on red_gstr con2 = 4 /* redraw entire system; use updated records con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end lpt = 5 tline = txt(line,[' '],lpt) esksp = int(tline) tline = txt(line,[' '],lpt) esksysy = int(tline) tline = txt(line,[' '],lpt) esksyslen = int(tline) tline = txt(line,[' '],lpt) esksysh = int(tline) tline = txt(line,[' '],lpt) eskf11 = int(tline) tline = txt(line,[' '],lpt) tline = tline // pad(2) esksyscode = tline{2..} if esksyscode con quote esksyscode = esksyscode{1,mpt-1} end if k >= 0x030115 and k <= 0x030118 if k = 0x030116 esksysy -= eskvpar(2) end if k = 0x030118 esksysy += eskvpar(2) end else if k = 0x03010f or k = 0x030112 or k = 0x030114 esksysh += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 esksysh -= incre else if k = 0x03010e or k = 0x030119 or k = 0x03011b esksysy -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c esksysy += incre end end end end end tput [X2,a] S 0 ~esksp ~esksysy ~esksyslen ~esksysh ~eskf11 "~esksyscode " con2 = 4 /* redraw entire system; use updated records goto REDIS end &dA &dA &d@ End of &dEsystem movement&d@ in mode "x" &dA if line{1} = "H" SX_point = X_point goto HAC1000 end &dA &dA &d@ End of &dEsuper-object movement&d@ in mode "x" &dA goto PPQ end if cmode = "h" SX_point = super_pointers(supercursor,1) goto HAC1000 end &dA &dA &d@ &dASUPER-OBJECT MOVEMENT&d@ &dA HAC1000: a = list_order(SX_point,4) if a = 0 tget [X,SX_point] line else tget [X2,a] line end lpt = 8 tline = txt(line,[' '],lpt) supernum = int(tline) /* supernum htype = txt(line,[' '],lpt) &dA &dA &d@ All objects associated with this super-object, which have previously been &dA &d@ moved (and are now drawn in &dAred&d@, must be identified. &dA if htype = "B" line2 = line{lpt..} a3 = int(line2) /* stem length a3 = int(line2{sub..}) /* slope a3 = int(line2{sub..}) /* font a3 = int(line2{sub..}) /* number of objects else a3 = 2 end /* a3 = number of objects a1 = 0 h = SX_point HAC1: /* looking backward through file g = list_order(h,1) a = list_order(g,4) if a = 0 tget [X,g] tline .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X2,a] tline .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end h = g if tline{1} <> "J" goto HAC1 end if supcnt > 0 loop for c = 1 to supcnt if o(c) = supernum /* this object is related to supernum goto HAC3 end repeat end goto HAC1 HAC3: if a1 = 0 list_order(g,3) = -1 /* at least one object must be flagged list_order(g,5) = -1 a1 = 1 end if a > 0 list_order(g,3) = -1 list_order(g,5) = -1 HAC2: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte else tget [X,g] tbyte end if "KTWA" con tbyte list_order(g,3) = -1 /* flag all sub-objects related to this object list_order(g,5) = -1 goto HAC2 end end --a3 if a3 > 0 goto HAC1 end c = int(tline{3..}) con4 = pointers(c,8) /* pointer to system record for this system &dA &dA &d@ If this super-object is a tuple and the tuple is associated with a beam, &dA &d@ then the beam must be flagged, or else the tuple will not turn off. &dA if htype = "X" /* tuple a1 = lpt tline = txt(line,[' '],a1) sitflag = int(tline) if bit(3,sitflag) = 1 /* associated with a beam tline = txt(line,[' '],a1) a3 = int(tline) tline = txt(line,[' '],a1) x1 = int(tline) tline = txt(line,[' '],a1) y1 = int(tline) tline = txt(line,[' '],a1) x2 = int(tline) tline = txt(line,[' '],a1) y2 = int(tline) tline = txt(line,[' '],a1) a2 = int(tline) &dA &dA &d@ get stem direction (a2 = beam super number) and flag beam &dA &d@ hh = SX_point HAC101: &dA &d@ The following code could cause a problem if records get out of order if a2 > supernum /* usually the case gg = list_order(hh,2) /* looking forward through file else gg = list_order(hh,1) /* looking backward through file end &dA if gg < 1 or gg > 10000 putc putc Problem with finding Beam associated with Tuple super-object return 10 end aa = list_order(gg,4) if aa = 0 tget [X,gg] ttline .t8 a3 else tget [X2,aa] ttline .t8 a3 end hh = gg if ttline{1} <> "H" goto HAC101 end if a3 <> a2 goto HAC101 end if ttline con "B" list_order(hh,3) = -1 /* flag beam list_order(hh,5) = -1 end end end &dA &dA &d@ End of code which flags the beam assocated with a tuplet &dA list_order(SX_point,3) = -1 list_order(SX_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(SX_point,4) /* better get line again! if a = 0 tget [X,SX_point] line else tget [X2,a] line end lpt = 8 tline = txt(line,[' '],lpt) supernum = int(tline) /* supernum htype = txt(line,[' '],lpt) &dA &dA &d@ &dD Ties &dA if htype = "T" tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = line line = line{lpt+1..} perform strip3 sitflag = int(line) --sitflag if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 if k = 0x03010e sitflag &= 0xf7 else if k = 0x030110 sitflag |= 0x08 else if k = 0x03010d sitflag &= 0xfb else sitflag |= 0x04 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 or k = 0x03011b --y1 else if k = 0x03011a or k = 0x03011c ++y1 end end end end end ++sitflag a = list_order(SX_point,4) b = supernum if a > 0 tput [X2,a] ~tline{1,7} ~b T ~y1 ~x1 ~x2 0 0 0 ~sitflag 0 else ++trecord_cnt tput [X2,trecord_cnt] ~tline{1,7} ~b T ~y1 ~x1 ~x2 0 0 0 ~sitflag 0 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Beams &dA if htype = "B" tline = txt(line,[' '],lpt) @k = int(tline) /* length of first stem (positive = stem up) tline = txt(line,[' '],lpt) @m = int(tline) /* slope of beam if k >= 0x030111 and k <= 0x030114 /* do nothing else if k >= 0x03010d and k <= 0x030110 if k = 0x03010e @k += incre if @k < 0 and @k > 0 - eskvpar(2) @k = eskvpar(2) end else if k = 0x030110 @k -= incre if @k > 0 and @k < eskvpar(2) @k = 0 - eskvpar(2) end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030116 if @m > -15 --@m end else if k = 0x030118 if @m < 15 ++@m end end end else if k = 0x030119 or k = 0x03011b @k += incre if @k < 0 and @k > 0 - eskvpar(2) @k = eskvpar(2) end else if k = 0x03011a or k = 0x03011c @k -= incre if @k > 0 and @k < eskvpar(2) @k = 0 - eskvpar(2) end end end end end end a = list_order(SX_point,4) b = supernum if a > 0 tput [X2,a] ~line{1,7} ~b B ~@k ~@m ~line{lpt..} else ++trecord_cnt tput [X2,trecord_cnt] ~line{1,7} ~b B ~@k ~@m ~line{lpt..} list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Slurs &dA if htype = "S" tline = txt(line,[' '],lpt) sitflag = int(tline) /* situation flag tline = txt(line,[' '],lpt) x1 = int(tline) /* horizontal adjustment to start tline = txt(line,[' '],lpt) y1 = int(tline) /* vertical adjustment to start tline = txt(line,[' '],lpt) x2 = int(tline) /* horizontal adjustment to end tline = txt(line,[' '],lpt) y2 = int(tline) /* vertical adjustment to end tline = txt(line,[' '],lpt) addcurve = int(tline) /* post adjustment to curvature tline = txt(line,[' '],lpt) a = int(tline) postx = 0 /* post adjustment to x position posty = 0 /* post adjustment to y position if lpt < len(line) tline = txt(line,[' '],lpt) postx = int(tline) end if lpt < len(line) tline = txt(line,[' '],lpt) posty = int(tline) end if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  sitflag &= 0xf3 else if k = 0x030110 /*  sitflag |= 0x0c else if k = 0x03010d /*  decrease addcurve --addcurve &dA &d@ sitflag &= 0xfe else /*  increase addcurve ++addcurve &dA &d@ sitflag |= 0x01 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --postx else if k = 0x030116 --posty else if k = 0x030117 ++postx else ++posty end end end else if sitflag < 4 a1 = eskvpar(1) else a1 = 0 - eskvpar(1) end if k = 0x030119 y1 -= a1 else if k = 0x03011a y1 += a1 else if k = 0x03011b y2 -= a1 else if k = 0x03011c y2 += a1 end end end end end end end line = line{1,7} // chs(supernum) // " S " // chs(sitflag) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~y1 ~x2 ~y2 ~addcurve 0 ~postx ~posty else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~y1 ~x2 ~y2 ~addcurve 0 ~postx ~posty list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Figure continuation lines &dA if htype = "F" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) &dA &dA &d@ Adding code &dA11/06/03&d@ to look for optional additional vert. disp. &dA y1 = 0 if lpt < len(line) tline = txt(line,[' '],lpt) y1 = int(tline) end if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x03011c /* Alt     etc. if k = 0x03010e or k = 0x030119 or k = 0x03011b /*  y1 -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c /*  y1 += incre end end end end line = line{1,7} // chs(supernum) // " F " // chs(a3) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Tuplets &dA if htype = "X" tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y2 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if bit(3,sitflag) = 1 &dA &dA &d@ get stem direction (a2 = beam super number) and flag beam &dA &d@ hh = SX_point HAC100: &dA &d@ The following code could cause a problem if records get out of order if a2 > supernum /* usually the case gg = list_order(hh,2) /* looking forward through file else gg = list_order(hh,1) /* looking backward through file end &dA aa = list_order(gg,4) if aa = 0 tget [X,gg] ttline .t8 a3 else tget [X2,aa] ttline .t8 a3 end hh = gg if ttline{1} <> "H" goto HAC100 end if a3 <> a2 goto HAC100 end if ttline con "B" a3 = int(ttline{mpt+1..}) if a3 < 0 a3 = DOWN else a3 = UP end list_order(hh,3) = -1 /* flag beam also list_order(hh,5) = -1 end end if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e or k = 0x030110 /*   if bit(3,sitflag) = 1 if k = 0x03010e /*  if a3 = UP sitflag |= 0x10 /* tuple near beam else sitflag &= 0xef /* tuple near notes end else /*  if a3 = DOWN sitflag |= 0x10 /* tuple near beam else sitflag &= 0xef /* tuple near notes end end end else if k = 0x03010d /*  bracket tips up or no bracket if bit(1,sitflag) = 1 if bit(2,sitflag) = 0 sitflag |= 0x04 /* tips up else sitflag &= 0xfd /* no bracket end end else /*  add bracket or bracket tips down if bit(1,sitflag) = 0 sitflag |= 0x02 /* add bracket else sitflag &= 0xfb /* bracket tips down end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 --y2 else if k = 0x030117 ++x1 ++x2 else ++y1 ++y2 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y2 else if k = 0x03011c ++y2 end end end end end end end line = line{1,7} // chs(supernum) // " X " // chs(sitflag) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~a1 ~x1 ~y1 ~x2 ~y2 ~a2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~a1 ~x1 ~y1 ~x2 ~y2 ~a2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Transpositions &dA if htype = "V" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  ++a1 else if k = 0x030110 /*  --a1 else if k = 0x03010d /*  if a3 > 0 --a3 end else /*  if a3 < 3 ++a3 end end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else if k = 0x03011c ++y1 end end end end end end end line = line{1,7} // chs(supernum) // " V " // chs(a3) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 ~a1 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 ~a1 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Endings &dA if htype = "E" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  ++a1 else if k = 0x030110 /*  --a1 else if k = 0x03010d /*  --a2 else /*  ++a2 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else if k = 0x03011c ++y1 end end end end end end end line = line{1,7} // chs(supernum) // " E " // chs(a3) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 ~a1 ~a2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 ~a1 ~a2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Dashes associated with text or directives (dynamics, tempo, etc) &dA if htype = "D" tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  /* do nothing else if k = 0x030110 /*  /* do nothing else if a1 = 0 a1 = hyphspc(sizenum) * 3 end if k = 0x03010d /*  --a1 else /*  ++a1 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else if k = 0x03011c ++y1 end end end end end end end line = line{1,7} // chs(supernum) // " D " a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 ~a1 ~a2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 ~a1 ~a2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Wavey line trills ~~~~~~ &dA if htype = "R" tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  ++y1 else if k = 0x030110 /*  --y1 end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else if k = 0x03011c ++y1 end end end end end end end line = line{1,7} // chs(supernum) // " E " // chs(a1) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Wedges &dA if htype = "W" tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y2 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  if c1 < eskvpar(4) ++c1 end else if k = 0x030110 /*  if c1 > 0 --c1 end else if k = 0x03010d /*  decrease addcurve if c2 > 0 --c2 end else /*  increase addcurve if c2 < eskvpar(4) ++c2 end end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 --y2 else if k = 0x030117 ++x1 ++x2 else ++y1 ++y2 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y2 else if k = 0x03011c ++y2 end end end end end end end line = line{1,7} // chs(supernum) // " W " // chs(c1) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~c2 ~x1 ~y1 ~x2 ~y2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~c2 ~x1 ~y1 ~x2 ~y2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end goto PPQ &dA &dA &d@ &dAEND OF SUPER-OBJECT MOVEMENT&d@ &dA &dA &dA &d@ &dAObject Movement&d@ &dA JAC0: if pointers(obcursor,1) <> X_point h = X_point JAC1: /* attempt to set obcursor correctly g = list_order(h,1) if g <> TOP_FLAG /* top of list a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "J" goto JAC1 end obcursor = int(line{3..}) end end con4 = pointers(obcursor,8) /* pointer to system record for this system JAC00: g = pointers(obcursor,1) /* pointer to table a = list_order(g,4) if a = 0 tget [X,g] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X2,a] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end &dA &dA &d@ Code added &dA12/06/03&d@ &dA if line{8} = "B" /* do nothing, please goto NOOP end &dA list_order(g,3) = -1 list_order(g,5) = -1 &dA &dA &d@ Flag all super-objects &dA if supcnt > 0 b = g a = 0 /* super-object counter JAC2: b = list_order(b,2) c = list_order(b,4) if c > 0 tget [X2,c] tbyte .t8 supernum else tget [X,b] tbyte .t8 supernum end if tbyte <> "H" goto JAC2 end loop for d = 1 to supcnt if o(d) = supernum list_order(b,3) = -1 /* flag super object record list_order(b,5) = -1 o(d) = 0 ++a /* increment super-object counter if a = supcnt goto JAC3 else goto JAC2 end end repeat goto JAC2 /* this super-object is not on list end &dA &dA &d@ Flag all associated sub-objects &dA JAC3: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte list_order(g,3) = -1 list_order(g,5) = -1 goto JAC3 end &dA &d@ &dA &d@ Here is where you turn off the things that will be moved &dA &d@ con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 &dA &dA &d@ Now look at object again; adjust position of object &dA g = pointers(obcursor,1) /* pointer to table a = list_order(g,4) if a = 0 ++trecord_cnt list_order(g,4) = trecord_cnt tget [X,g] line .t10 line2 a = trecord_cnt else tget [X2,a] line .t10 line2 end &dA &dA &d@ Increase (decrease, raise, lower) the x-coordinate of this object &dA sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) d = int(line2{sub..}) if k >= 0x030115 and k <= 0x030118 if k = 0x030115 c -= incre else if k = 0x030116 d -= incre else if k = 0x030117 c += incre else d += incre end end end else if k = 0x03010f or k = 0x030112 or k = 0x030114 c += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 c -= incre else if k = 0x03010e or k = 0x030119 or k = 0x0311b d -= incre else if k = 0x030110 or k = 0x03011a or k = 0x0311c d += incre end end end end end line = line{1,9} // chs(b) // " " // chs(c) // " " // chs(d) // line2{sub..} tput [X2,a] ~line &dA &dA &d@ Incremented backward (forward) all associated text records &dA JAC4: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte if mpt = 2 &dA &dA &d@ Backup (advance) x-coordinate of text sub-object &dA b = int(line) if k = 0x03010f or k = 0x030112 or k = 0x030114 b -= incre else b += incre end line = tbyte // " " // chs(b) // line{sub..} if a > 0 tput [X2,a] ~line else ++trecord_cnt tput [X2,trecord_cnt] ~line list_order(g,4) = trecord_cnt end end goto JAC4 end con2 = 1 /* selective construction &dA &dA &d@ End of &dE"object" movement&d@ &dA REDIS: &dA &d@ &dA &d@ Here is where you re-display the things that are moved &dA &d@ con1 = 1 /* construct on red_gstr /* con2 = 1 or 2 or 3 or 4. This has been set earlier con3 = 1 /* use setb perform construct activate red_gstr,0,0,-1 if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,5 activate red_tstr2,px,py,3 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,5 activate red_tstr3,px,py,3 end end if wflag4 = 1 conx1 >>= 1 cony1 >>= 1 conx2 >>= 1 cony2 >>= 1 dscale2 red_tstr2, red_tstr4, conx1, cony1, conx2, cony2 if sflag = 4 activate red_tstr4,px,py,5 activate red_tstr4,px,py,3 end end goto PPQ end if k = 0x03010b /* ctrl  if x(sflag) < 40 x(sflag) += 10 end end if k = 0x030109 /* ctrl  if x(sflag) > xze - 340 x(sflag) -= 10 end end if k = 0x03010a /* ctrl  if y(sflag) > yze - 3500 y(sflag) -= 80 end end if k = 0x03010c /* ctrl  if y(sflag) < 320 y(sflag) += 80 end end if k = 0x010067 /* g newcmode = "g" perform change_cmode end if k = 0x010066 /* f newcmode = "j" perform change_cmode end if k = 0x01006a /* j newcmode = "j" perform change_cmode end if k = 0x010068 /* h newcmode = "h" perform change_cmode a = pointers(obcursor,1) loop while list_order(a,1) <> TOP_FLAG a = list_order(a,1) tget [X,a] tbyte repeat while tbyte <> "H" if tbyte <> "H" loop while list_order(a,2) <> BOTTOM_FLAG a = list_order(a,2) tget [X,a] tbyte repeat while tbyte <> "H" end if tbyte = "H" tget [X,a] .t3 supercursor .t8 line &dA &dA &d@ Set cursor at new location &dA a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end end if k = 0x010078 /* x newcmode = "x" perform change_cmode end if k >= 0x030101 and k <= 0x030104 if k = 0x030101 /*  if cmode = "g" h = pointers(obcursor,4) if h > 0 and h <= object_count obcursor = h goto SETCUR end end if cmode = "j" if obcursor > 1 --obcursor goto SETCUR end end if cmode = "x" BWXP: if list_order(X_point,1) = TOP_FLAG /* top of list goto PPQ else X_point = list_order(X_point,1) end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) tget [X,X_point] .t3 t1 t2 xcur += t1 ycur += t2 goto PPQ end if "H" = rectype tget [X,X_point] .t3 supercursor .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end if rectype = "L" or rectype = "l" h = X_point loop g = list_order(h,2) tget [X,g] line .t3 a if line{1} = "J" c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 b xcur ycur tget [X,c] .t3 c ycur += c end h = g repeat while "JE" not_con line{1} goto PPQ end if "SX" con rectype tget [X,X_point] .t3 g xcur ycur goto PPQ end if "AEB" con rectype goto BWXP end end if cmode = "h" if supercursor <= 1 goto PPQ end --supercursor a1 = super_pointers(supercursor,1) tget [X,a1] .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 obcursor .t8 jtype .t10 c d oby perform setcurloc (obcursor,X_point) /* return new X_point if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end end if k = 0x030102 /*  if "gj" con cmode obcursor = pointers(obcursor,5) goto SETCUR end if cmode = "x" UPXP: if list_order(X_point,1) = TOP_FLAG /* top of list goto PPQ end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) if obcursor > 1 --obcursor end goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) rectype = "J" goto PPQ end if "AEB" con rectype X_point = list_order(X_point,1) goto UPXP end if "HLlSX" con rectype X_point = list_order(X_point,1) goto UPXP end end end if k = 0x030103 /*  if cmode = "g" h = pointers(obcursor,3) if h > 0 and h <= object_count obcursor = h goto SETCUR end end if cmode = "j" if obcursor < object_count ++obcursor goto SETCUR end end if cmode = "x" FWXP: if list_order(X_point,2) = BOTTOM_FLAG goto PPQ end X_point = list_order(X_point,2) tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) tget [X,X_point] .t3 t1 t2 xcur += t1 ycur += t2 goto PPQ end if "H" = rectype tget [X,X_point] .t3 supercursor .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end if rectype = "L" or rectype = "l" h = X_point loop g = list_order(h,2) tget [X,g] line .t3 a if line{1} = "J" c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 b xcur ycur tget [X,c] .t3 c ycur += c end h = g repeat while "JE" not_con line{1} goto PPQ end if "SX" con rectype tget [X,X_point] .t3 g xcur ycur goto PPQ end if "AEB" con rectype goto FWXP end end if cmode = "h" if supercursor = super_count or supercursor = 0 goto PPQ end ++supercursor a1 = super_pointers(supercursor,1) tget [X,a1] .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 obcursor .t8 jtype .t10 c d oby perform setcurloc (obcursor,X_point) /* return new X_point if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end end if k = 0x030104 /*  if "gj" con cmode obcursor = pointers(obcursor,6) goto SETCUR end if cmode = "x" DOWNXP: if list_order(X_point,2) = BOTTOM_FLAG goto PPQ end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) if obcursor < object_count ++obcursor end goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) if obcursor < object_count ++obcursor end rectype = "J" goto SETCUR end if "AEB" con rectype X_point = list_order(X_point,2) goto DOWNXP end if "HLlSX" con rectype X_point = list_order(X_point,2) goto DOWNXP end end end SETCUR: perform setcurloc (obcursor,X_point) /* return new X_point goto PPQ end if k = 0x030120 or k = 0x030121 if k = 0x030120 /* page up a = X_point &dA &d@ get an original index loop while a > table_size and list_order(a,1) <> TOP_FLAG a = list_order(a,1) repeat &dA &d@ get first system index which is smaller that this index b = system_rec(1) if a <= table_size loop for i = system_cnt to 1 step -1 if system_rec(i) < a b = system_rec(i) i = 1 end repeat end if b = system_rec(1) ptoggle = 0 end if ptoggle = 0 if cmode = "h" if supercursor = 0 goto PPQ end loop tget [X,b] tbyte .t3 a if tbyte = "H" if a = 1 a = 2 end supercursor = a k = 0x030101 /*  goto NEWK end b = list_order(b,2) repeat while b <> BOTTOM_FLAG else if cmode = "x" if b = system_rec(1) loop b = list_order(b,2) tget [X,b] tbyte repeat while tbyte <> "J" if list_order(b,2) <> BOTTOM_FLAG b = list_order(b,2) end end X_point = b k = 0x030101 /*  goto NEWK else loop tget [X,b] tbyte .t3 a if tbyte = "J" obcursor = a X_point = b k = 0x030101 /*  goto NEWK end b = list_order(b,2) repeat while b <> BOTTOM_FLAG end end else if cmode = "h" if supercursor = 0 goto PPQ end loop tget [X,b] tbyte .t3 a if tbyte = "H" if a = super_count a = super_count - 1 end supercursor = a k = 0x030103 /*  goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG else if cmode = "x" c = b if c >= table_size loop c = list_order(c,1) tget [X,c] tbyte repeat while "KJWTH" not_con tbyte c = list_order(c,1) end X_point = c k = 0x030103 /*  goto NEWK else loop tget [X,b] tbyte .t3 a if tbyte = "J" obcursor = a X_point = b k = 0x030103 /*  goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG end end end goto PPQ end if k = 0x030121 /* page down a = X_point &dA &d@ get an original index loop while a > table_size and list_order(a,1) <> TOP_FLAG a = list_order(a,1) repeat &dA &d@ set c = bottom of page c = table_size loop while list_order(c,2) <> BOTTOM_FLAG c = list_order(c,2) repeat &dA &d@ if possible, set c = next bigger index for system b = 0 if a <= table_size loop for i = 1 to system_cnt if system_rec(i) > a c = system_rec(i) i = system_cnt b = 1 end repeat end if b = 0 oldk = 0x030120 end if cmode = "h" if supercursor = 0 goto PPQ end b = c loop tget [X,b] tbyte .t3 a if tbyte = "H" if a = super_count a = super_count - 1 end supercursor = a k = 0x030103 /*  goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG else if cmode = "x" if c >= table_size loop c = list_order(c,1) tget [X,c] tbyte repeat while "KJWTH" not_con tbyte c = list_order(c,1) end X_point = c k = 0x030103 /*  goto NEWK else b = c loop tget [X,b] tbyte .t3 a if tbyte = "J" obcursor = a X_point = b k = 0x030103 /*  goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG end end goto PPQ end end if k = 0x010032 /* 2 if sflag <> 2 sflag = 2 if wflag2 = 0 dscale2 gstr, tstr2 if trecord_cnt > 0 dscale2 red_gstr, red_tstr2 end wflag2 = 1 end end end if k = 0x010033 /* 3 if sflag <> 3 sflag = 3 if wflag3 = 0 dscale3 gstr, tstr3 if trecord_cnt > 0 dscale3 red_gstr, red_tstr3 end wflag3 = 1 end end end if k = 0x010034 /* 4 if sflag <> 4 sflag = 4 if wflag2 = 0 dscale2 gstr, tstr2 if trecord_cnt > 0 dscale2 red_gstr, red_tstr2 end wflag2 = 1 end if wflag4 = 0 dscale2 tstr2, tstr4 if trecord_cnt > 0 dscale2 red_tstr2, red_tstr4 end wflag4 = 1 end end end if k = 0x010031 /* 1 if sflag <> 1 sflag = 1 end px = x(sflag) py = y(sflag) activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 x2cur = 8 * px + xcur y2cur = py + ycur if x2cur < LMARG2 h = LMARG2 - x2cur + 7 / 8 + 9 / 10 * 10 x(sflag) += h end if x2cur > RMARG2 h = x2cur - RMARG2 + 7 / 8 + 9 / 10 * 10 x(sflag) -= h end if y2cur < TMARG2 h = TMARG2 - y2cur + 79 / 80 * 80 y(sflag) += h end if y2cur > BMARG2 h = y2cur - BMARG2 + 79 / 80 * 80 y(sflag) -= h end end goto PPP return &dA &dA &d@ setcurloc &dA &dA &d@ Input: a = index in pointers array for a particular object &dA &dA &d@ Output: b = address in table for this object &dA &dA &d@ Other outputs: xcur = x coordinate of cursor &dA &d@ ycur = y coordinate of cursor &dA &d@ grand_space = distance between grand staff lines &dA &dA procedure setcurloc (a,b) str line.100,jtype.1 int a,b,c,d,g int x,y int dummy getvalue a if a = 0 return end b = pointers(a,1) /* object c = pointers(a,7) /* line d = pointers(a,8) /* system if d = 0 return 2 end tget [X,d] .t3 g xcur ycur tget [X,c] .t3 y .t3 line line = trm(line) line = rev(line) if line con " " line = line{1,mpt-1} line = rev(line) grand_space = int(line) end ycur += y tget [X,b] .t8 jtype g x y if jtype = "F" y += figoff(eskf12) end if jtype = "B" y = 0 end if y > 800 y = y - 1000 + grand_space end passback b xcur += x ycur += y return procedure msgout (out,fnum,color,scflag) str out.180 int font,i,k,fnum,color,scflag,plane getvalue out,fnum,color,scflag plane = 1 font = revmap(fnum) font = font - 1 * 256 if color = 1 if scflag = 1 loop for i = 1 to len(out) k = ors(out{i}) + font setb msgstr,FA,scx,scy,k,plane repeat else loop for i = 1 to len(out) k = ors(out{i}) + font clearb msgstr,FA,scx,scy,k,plane repeat end activate msgstr,0,0,-1 else if scflag = 1 loop for i = 1 to len(out) k = ors(out{i}) + font setb redmsgstr,FA,scx,scy,k,plane repeat else loop for i = 1 to len(out) k = ors(out{i}) + font clearb redmsgstr,FA,scx,scy,k,plane repeat end activate redmsgstr,0,0,-1 end return procedure setupmsg int a,b,c,d,e,font,color,scflag int tsavensz str out.80 tsavensz = notesize notesize = MSGFONTZ if notesize <> tsavensz perform init_par end font = MSGFONT color = 1 scflag = 1 scx = MSGTAB1 scy = MSGROW1 out = messages(1) perform msgout (out,font,color,scflag) scx = MSGTAB2 scy = MSGROW1 out = messages(2) perform msgout (out,font,color,scflag) scx = MSGTAB3 scy = MSGROW1 out = messages(3) perform msgout (out,font,color,scflag) scx = MSGTAB4 scy = MSGROW1 out = messages(4) perform msgout (out,font,color,scflag) scx = MSGTAB1 scy = MSGROW1 out = messages(1) color = 4 perform msgout (out,font,color,scflag) cmode = "g" color = 1 scx = MSGTAB5 scy = MSGROW2 out = messages(5) perform msgout (out,font,color,scflag) #if MSGLINOPT scx = MSGTAB6 scy = MSGROW2 out = messages(6) perform msgout (out,font,color,scflag) #endif if notesize <> tsavensz notesize = tsavensz perform init_par end return procedure change_cmode int a,b,c,d,e,font,color,scflag int tsavensz str out.80 tsavensz = notesize notesize = MSGFONTZ if notesize <> tsavensz perform init_par end font = MSGFONT color = 3 scflag = 0 if cmode = "g" out = messages(1) scx = MSGTAB1 scy = message_row(1) else if cmode = "j" out = messages(2) scx = MSGTAB2 scy = message_row(2) else if cmode = "h" out = messages(3) scx = MSGTAB3 scy = message_row(3) else if cmode = "x" out = messages(4) scx = MSGTAB4 scy = message_row(4) end end end end perform msgout (out,font,color,scflag) scflag = 1 if newcmode = "g" out = messages(1) scx = MSGTAB1 scy = message_row(1) else if newcmode = "j" out = messages(2) scx = MSGTAB2 scy = message_row(2) else if newcmode = "h" out = messages(3) scx = MSGTAB3 scy = message_row(3) else if newcmode = "x" out = messages(4) scx = MSGTAB4 scy = message_row(4) end end end end perform msgout (out,font,color,scflag) if notesize <> tsavensz notesize = tsavensz perform init_par end cmode = newcmode return &dA &dA &d@ getobposition &dA &dA &d@ Input: a = address in table of a particular sub-object (or word, or text item) &dA &dA &d@ Output: b = index in pointers array for object associated with this sub-object &dA &dA &d@ Other outputs: xcur = x coordinate of cursor for object &dA &d@ ycur = y coordinate of cursor for object &dA &d@ grand_space = distance between grand staff lines &dA &dA procedure getobposition (a,b) int a,b str byte.1,line.10 getvalue a b = a loop b = list_order(b,1) /* back up 1 on list if b = TOP_FLAG dputc Program error return 10 end tget [X,b] byte repeat while byte <> "J" tget [X,b] .t3 line a = int(line) perform setcurloc (a,b) b = a passback b return &dA &dA &d@ Procedure construct &dA &dA &d@ Purpose: construct or erase sections of music &dA &dA &d@ Inputs: con1 = black/red flag &dA &d@ 0 = construct on gstr &dA &d@ 1 = construct on red_gstr &dA &d@ con2 = full/partial &dA &d@ 0 = make a full construction using X table records &dA &d@ 1 = use only records with list_order(.,3) <> 0 &dA &d@ 2 = same as 1, but omit all references to super-objects &dA &d@ 3 = same as 1, but also redraw staff lines &dA &d@ 4 = full construction; make use of updated records &dA &d@ 5 = save as 3, but use original X table records &dA &d@ con3 = turn on/off &dA &d@ 1 = use setb &dA &d@ 0 = use clearb &dA &d@ con4 = starting point &dA &d@ 0 = start at top; use entire file &dA &d@ >0 = start at record con4; stop before next "S" record &dA &dA &d@ Outputs: conx1 = \ &dA &d@ cony1 = \ ROW and COLUMN boundaries to box where &dA &d@ conx2 = / reconstruction took place. These outputs &dA &d@ cony2 = / are valid only when con2 > 0 and con3 = 1. &dA procedure construct label LTY(16) if con2 > 0 and con3 = 1 conx1 = 100000 cony1 = 100000 conx2 = 0 cony2 = 0 end loop for k = 1 to SUPERMAX esksupermap(k) = 0 repeat sysnum = 0 if con4 > 0 eskrec = con4 else eskrec = 1 end eskf12 = 0 scf = notesize TOP: if eskrec > f04 return end if con2 = 0 tget [X,eskrec] line else if con2 = 4 trec = list_order(eskrec,4) if trec = 0 tget [X,eskrec] line else tget [X2,trec] line end else if list_order(eskrec,3) <> 0 if con2 = 5 trec = 0 else trec = list_order(eskrec,4) end if trec = 0 tget [X,eskrec] line else tget [X2,trec] line end if con3 = 1 &dK &d@ if "SL" not_con line{1} if "SLl" not_con line{1} /* Chnaged &dA12/18/05&d@ list_order(eskrec,3) = 0 /* remove flag end end else eskrec = list_order(eskrec,2) goto TOP end end end line = trm(line) if line{1} = "S" and con4 > 0 and eskrec > con4 return end eskrec = list_order(eskrec,2) if "ESLlXJKAWTHBkZY@" con line{1} /* New &dA02/21/06&d@ goto LTY(mpt) end &dA &dA &d@ END OF LINE &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(1): /* line{1} = "E" loop for k = 1 to SUPERMAX if esksupermap(k) <> 0 if con2 = 0 putc Outstanding superobject at end of line return 10 end esksupermap(k) = 0 examine end repeat loop for c8 = 1 to ntext if line{c8+2} <> " " if line{c8+2} <> "*" if line{c8+2} <> eskxbyte(c8) putc Current xbyte different from xbyte at end of line return 10 end y = esksq(eskf12) + eskf(eskf12,c8) if eskxbyte(c8) = "-" x = esksp + esksyslen perform sethyph (c8) end if "_,.;:!?" con eskxbyte(c8) eskuxstop(c8) = esksp + esksyslen - eskhpar(56) underflag = 2 perform setunder (c8) end eskxbyte(c8) = "*" else if "_,.;:!?" con eskxbyte(c8) y = esksq(eskf12) + eskf(eskf12,c8) underflag = 1 if eskuxstop(c8) > esksp + esksyslen - eskhpar(57) eskuxstop(c8) = esksp + esksyslen - eskhpar(57) end perform setunder (c8) end end end repeat goto TOP &dA &dA &d@ S Y S T E M (recoded &dA05/26/03&d@) &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(2): /* line{1} = "S" eskf12 = 0 sysnum = sysnum + 1 #if REPORT3 putc System ~sysnum putc Line ... #endif sub = 5 esksp = int(line{sub..}) esksysy = int(line{sub..}) esksyslen = int(line{sub..}) esksysright = esksysy + esksyslen /* added &dA12/31/08&d@ esksysh = int(line{sub..}) eskf11 = int(line{sub..}) line = line // " " tline = line{sub..} tline = mrt(tline) esksyscode = tline{2..} if esksyscode con quote esksyscode = esksyscode{1,mpt-1} end &dA &dA &d@ Code to check number of parts in syscode (modified &dA11/13/03&d@) &dA a2 = 0 loop for c8 = 1 to len(esksyscode) if ".:,;" con esksyscode{c8} ++a2 end repeat if a2 <> eskf11 and esksyscode <> "" putc &dASyscode Warning&d@: Incorrect number of parts in syscode. eskrec = ~(eskrec - 1) end &dA sysflag = 0 goto TOP &dA &dA &d@ L I N E &dA &d@ ÄÄÄÄÄÄÄ &dA LTY(3): /* line{1} = "L" LTY(4): /* line{1} = "l" /* Added &dA12/18/05&d@ &dA &dA &d@ New code to deal with single line staff &dA12/18/05&d@ &dA stave_type = 0 if line{1} = "l" stave_type = 1 end &dA &dA &dA &d@ New &dA08/28/03&d@. Must zero out parameters eskdyoff, eskuxstart, backloc, and ibackloc &dIOK &dA loop for c8 = 1 to 10 eskdyoff(c8) = 0 eskuxstart(c8) = 0 eskbackloc(c8) = 0 ibackloc(c8) = 0 repeat line = line // " " eskf12 = eskf12 + 1 #if REPORT3 putc ~eskf12 ... #endif &dA &dA &d@ Field 2: y off-set in system &dA esksq(eskf12) = int(line{3..}) esksq(eskf12) += esksysy &dA &dA &d@ Field 3: text off-set(s) from line (separated by |) &dA ntext = 0 NSR1: ++ntext eskf(eskf12,ntext) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR1 end &dA &dA &d@ Field 4: eskdyoff(s) separated by | &dA c8 = 0 NSR2: ++c8 eskdyoff(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR2 end &dA &dA &d@ Field 5: eskuxstart(s) separated by | &dA c8 = 0 NSR3: ++c8 eskuxstart(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR3 end &dA &dA &d@ Field 6: eskbackloc(s) separated by | &dA c8 = 0 NSR4: ++c8 eskbackloc(c8) = int(line{sub..}) ibackloc(c8) = eskbackloc(c8) /* New &dA08/26/03&d@ if line{sub} = "|" ++sub goto NSR4 end tline = line{sub+1..} tline = mrt(tline) &dA &dA &d@ Field 7: eskxbyte(s) (length of field = number of bytes) &dA if tline con " " c8 = mpt - 1 if ntext < c8 loop for ntext = ntext + 1 to c8 eskf(eskf12,ntext) = eskf(eskf12,ntext-1) + eskvpar(41) repeat end loop for c8 = 1 to ntext eskxbyte(c8) = tline{c8} repeat end &dA &dA &d@ New &dA08/28/03&d@ &dA loop for c8 = 1 to ntext if eskdyoff(c8) = 0 eskdyoff(c8) = eskdyoff(1) end if eskuxstart(c8) = 0 eskuxstart(c8) = eskuxstart(1) end if eskbackloc(c8) = 0 eskbackloc(c8) = eskbackloc(1) end if ibackloc(c8) = 0 ibackloc(c8) = ibackloc(1) end repeat &dA &dA &d@ Field 8: y off-set to virtual staff line (0 = none) &dA eskvst(eskf12) = 0 if tline con " " tline = tline{mpt..} eskvst(eskf12) = int(tline) tline = tline // " " tline = tline{sub..} end &dA &dA &d@ Field 9: notesize (0 = not specified; i.e., no change) &dA if tline con " " tline = tline{mpt..} c8 = int(tline) tline = tline // " " /* New code &dA09/14/03&d@ tline = tline{sub..} /* " " " if chr(c8) in [6,14,18,21] /* New: notesize 18 added &dA12/18/04 if c8 <> notesize notesize = c8 perform init_par end end end nsz(eskf12) = notesize /* New code &dA11/13/03&d@ &dA &dA &d@ Field 10: additional off-set for figured harmony New &dA09/14/03&d@ &dA figoff(eskf12) = 0 if tline con " " tline = tline{mpt..} figoff(eskf12) = int(tline) tline = tline // " " /* New code &dA09/14/03&d@ tline = tline{sub..} /* " " " end y = esksq(eskf12) if con2 > 0 and con2 <> 4 if (con2 <> 3 and con2 <> 5) /* or trec = 0 loop for c8 = 1 to ntext buxstop(c8) = 1000000 repeat goto TOP end end perform staff if eskvst(eskf12) > 0 y = esksq(eskf12) + eskvst(eskf12) perform staff end loop for c8 = 1 to ntext buxstop(c8) = 1000000 repeat goto TOP &dA &dA &d@ G L O B A L T E X T &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &dA &d@ New Code &dA02/12/05&d@ &dA LTY(16): /* line{1} = "@" goto TOP LTY(15): /* line{1} = "Y" sub = 3 z = int(line{sub..}) if z = 0 /* New &dA03/26/05 goto TOP end x = int(line{sub..}) &dA &dA &d@ &dA03/04/05&d@ Deal with optional "C" or "R" following x-data &dA ttext = " " if line{sub} = "C" or line{sub} = "R" ttext = line{sub} // " " ++sub end &dA y = int(line{sub..}) tline = line{sub..} tline = mrt(tline) line = "X " // chs(z) // " " // chs(x) // ttext // chs(y) // " " /* New &dA03/04/05 &dK &d@ line = "X " // chs(z) // " " // chs(x) // " " // chs(y) // " " if tline <> "" loop for i = 1 to len(tline) if tline{i} = "\" if i < len(tline) if ">]" con tline{i+1} ++i /* skip \> and \] else if "<[" con tline{i+1} loop while i < len(tline) and tline{i} <> "|" ++i /* skip up to "|" character repeat else line = line // tline{i} end end else line = line // tline{i} end else line = line // tline{i} end repeat end &dA &d@ End of &dA02/12/05&d@ addition LTY(5): /* line{1} = "X" lpt = 3 tline = txt(line,[' '],lpt) z = int(tline) &dA &dA &d@ Code added &dA08/28/02&d@ &dA if lpt > len(line) if z = 6 or z = 14 or z = 21 or z = 18 or z = 16 /* New: notesize 16 added &dA01/01/09 notesize = z perform init_par scf = notesize end goto TOP end tline = txt(line,[' '],lpt) tline = tline // " " /* New &dA03/04/05&d@ x = int(tline) ttext = tline{sub} /* New &dA03/04/05&d@ tline = txt(line,[' '],lpt) y = int(tline) if lpt > len(line) line = "" else line = line{lpt+1..} line = trm(line) end &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA a1 = 0 perform setwords (a1) scf = notesize goto TOP &dA &dA &d@ O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(6): /* line{1} = "J" trec = list_order(eskrec,1) if con2 = 5 or con2 = 0 trec2 = 0 else trec2 = list_order(trec,4) end if trec2 > 0 tget [X2,trec2] line .t8 jtype ntype obx oby z i i supcnt else tget [X,trec] line .t8 jtype ntype obx oby z i i supcnt end if con2 = 2 supcnt = 0 end j = int(line{3..}) line = line{sub..} line = mrt(line) line = "J " // line * &dA &dA &d@ New code &dA09/14/03&d@ &dA if jtype = "F" oby += figoff(eskf12) end save_jtype = jtype if jtype = "N" loop for c8 = 1 to ntext eskuxstop(c8) = esksp + obx + eskhpar(7) buxstop(c8) = 1000000 repeat end * if jtype = "D" /* steve's version: if jtype in ['D','F'] if ntype = 0 goto ECZ3 end if bit(1,ntype) = 1 goto ECZ3 end if bit(2,ntype) = 1 and eskf12 = 1 goto ECZ3 end if bit(3,ntype) = 1 and eskf12 = eskf11 goto ECZ3 end /* skip over directives ESKD2: tget [X,eskrec] line2 if line2{1} = "W" /* steve's version: if line2{1} in ['K','W'] eskrec = list_order(eskrec,2) goto ESKD2 end goto TOP end &dA &dA &d@ Collect super-object information &dA ECZ3: if supcnt > 0 perform strip8 if int(line) <> supcnt /* TEMP putc strip error return 10 end lpt = 0 tline = txt(line,[' '],lpt) loop for i = 1 to supcnt tline = txt(line,[' '],lpt) j = int(tline) * look for previous reference to this superobject loop for k = 1 to SUPERMAX if esksupermap(k) = j goto EWA end repeat h = 0 loop for k = 1 to SUPERMAX if esksupermap(k) = 0 h = k k = SUPERMAX end repeat if h = 0 putc No more superobject capacity return 10 end &dA &dA &d@ if not found, then set up reference to this superobject. &dA k = h esksupermap(k) = j esksuperpnt(k) = 1 * k (value 1 to SUPERMAX) = pointer into esksuperdata for this superobject EWA: h = esksuperpnt(k) * store object information in esksuperdata and increment esksuperpnt esksuperpnt(k) = h + 2 esksuperdata(k,h) = obx esksuperdata(k,h+1) = oby &dO &dO &d@ dputc Storing esksuperdata &dO &d@ putc .t10 esksuperdata(~k ,~h ) = ~obx .t40 esksuperdata(~k ,~(h+1) ) = ~oby &dO repeat end &dA &dA &d@ if no sub-objects, then typeset object &dA if eskvst(eskf12) > 0 and oby > 700 oby -= 1000 oby += eskvst(eskf12) end if z > 32 x = esksp + obx if jtype <> "B" y = esksq(eskf12) + oby perform setmus else if con1 = 1 /* red only (code added &dA12/06/03&d@) y = esksq(eskf12) + oby perform setmus end end end &dA &dA &d@ typeset underline (if unset) &dA esksaverec = eskrec &dK &d@ if jtype = "R" if jtype = "R" or jtype = "r" /* New &dA10/15/07&d@ loop for c8 = 1 to ntext if "_,.;:!?" con eskxbyte(c8) &dA &dA &d@ check next note for new syllable &dA EYR4: tget [X,eskrec] line eskrec = list_order(eskrec,2) line = line // pad(12) if line{1} = "E" if line{c8+2} = "*" goto EYR2 end goto EYR3 end if line{1} = "J" and line{8} = "N" EYR1: tget [X,eskrec] line eskrec = list_order(eskrec,2) if "kKA" con line{1} /* Added &dA11-11-93&d@ goto EYR1 end if line{1} = "T" c9 = int(line{3..}) c9 = int(line{sub..}) /* text line number if c8 = c9 goto EYR2 end goto EYR1 end goto EYR3 end goto EYR4 * EYR2: y = esksq(eskf12) + eskf(eskf12,c8) underflag = 1 if mpt > 1 eskuxstop(c8) -= eskhpar(20) end if buxstop(c8) < eskuxstop(c8) eskuxstop(c8) = buxstop(c8) end perform setunder (c8) eskxbyte(c8) = "*" buxstop(c8) = 1000000 end EYR3: eskrec = esksaverec repeat end if jtype = "B" oby = 0 loop for c8 = 1 to ntext buxstop(c8) = esksp + obx - eskhpar(57) repeat end goto TOP &dA &dA &d@ S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(7): /* line{1} = "K" trec = list_order(eskrec,1) if con2 = 5 or con2 = 0 trec2 = 0 else trec2 = list_order(trec,4) end if trec2 > 0 tget [X2,trec2] .t3 sobx soby z else tget [X,trec] .t3 sobx soby z end x = esksp + obx + sobx y = esksq(eskf12) + oby + soby perform setmus &dA &dA &d@ Adding code &dA05/26/03&d@ for printing repeat dots on the grandstaff &dA if save_jtype = "B" and z = DOT_CHAR y += eskvst(eskf12) perform setmus end goto TOP &dA &dA &d@ A T T R I B U T E S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(8): /* line{1} = "A" goto TOP &dA &dA &d@ W O R D S &dA &d@ ÄÄÄÄÄÄÄÄÄ &dA LTY(9): /* line{1} = "W" lpt = 3 tline = txt(line,[' '],lpt) * line structure = sobx soby font# text sobx = int(tline) tline = txt(line,[' '],lpt) soby = int(tline) tline = txt(line,[' '],lpt) z = int(tline) if len(line) > lpt and z <> 0 /* &dA10/01/03&d@ adding condition z <> 0 line = line{lpt+1..} x = esksp + obx + sobx y = esksq(eskf12) + oby + soby a1 = 0 &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA perform setwords (a1) end goto TOP &dA &dA &d@ T E X T &dA &d@ ÄÄÄÄÄÄÄ &dA LTY(10): /* line{1} = "T" line = line // " " * line structure = sobx tlevel[|soby] ttext xbyte textlen sobx = int(line{3..}) tlevel = int(line{sub..}) if tlevel < 1 or tlevel > 10 putc Error: Invalid tlevel in Text record ~(eskrec - 1) putc Enter blank line to stop program getc line line = trm(line) if line = "" return 10 end goto TOP end soby = 0 if line{sub} = "|" ++sub soby = int(line{sub..}) end line = line{sub..} line = mrt(line) /* ttext is next in line &dA &dA &d@ New &dA08/28/03&d@ Stripping of ttext moved up 26 lines to here. We &dA &d@ need to know if ttext = "~" in order to set underflag &dA &d@ correctly. &dA if line con " " ttext = line{1,mpt-1} line = line{mpt..} line = mrt(line) end &dA &dA &d@ typeset back hyphons or underlines (if they exist) &dA if eskxbyte(tlevel) = "-" y = esksq(eskf12) + eskf(eskf12,tlevel) x = esksp + obx + sobx perform sethyph (tlevel) end if "_,.;:!?" con eskxbyte(tlevel) x = esksp + obx + sobx - eskhpar(20) if mpt > 1 x -= eskhpar(20) end if eskuxstop(tlevel) > x eskuxstop(tlevel) = x end y = esksq(eskf12) + eskf(eskf12,tlevel) if ttext = "~" underflag = 2 /* New &dA08/28/03&d@ don't set punctuation 'till after next note. else underflag = 1 end perform setunder (tlevel) end &dA &dA &d@ typeset underline if terminator (~) is found (Code added &dA02-24-95&d@) &dA if ttext = "~" x = esksp + obx + sobx + eskhpar(20) + eskhpar(20) eskuxstop(tlevel) = x y = esksq(eskf12) + eskf(eskf12,tlevel) underflag = 1 perform setunder (tlevel) eskxbyte(tlevel) = " " /* New &dA08/28/03&d@ xbyte zeroed &dEafter&d@ calling setunder goto TOP end sub = 1 loop while ttext con "_" ttext{mpt} = " " repeat textlen = 0 eskxbyte(tlevel) = "*" if line <> "" line = line // " " eskxbyte(tlevel) = line{1} textlen = int(line{2..}) end x = esksp + obx + sobx y = esksq(eskf12) + eskf(eskf12,tlevel) + soby eskbackloc(tlevel) = x + textlen eskuxstart(tlevel) = x + textlen + eskhpar(19) * print text &dA &dA &d@ &dA04/22/04&d@ replacing settext with setwords &dA &dA &d@ Call to setwords now includes paramter: 1 = setwords called from TEXT sub-obj &dA z = mtfont line = ttext a1 = 1 perform setwords (a1) &dK &d@ perform settext &dA goto TOP &dA &dA &d@ S U P E R - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(11): /* line{1} = "H" lpt = 8 tline = txt(line,[' '],lpt) * line structure = supernum htype . . . supernum = int(tline) * get esksuperdata for this superobject loop for k = 1 to SUPERMAX if esksupermap(k) = supernum goto EWB end repeat putc Error: No refererce to superobject ~supernum in previous objects examine return 10 * k = index into esksuperdata EWB: htype = txt(line,[' '],lpt) &dA &dA &d@ Construct esksuperdata for case where con2 = 1 or 3 (partial construction) &dA if con2 = 1 or con2 = 3 or con2 = 5 if htype = "B" line2 = line{lpt..} a3 = int(line2) /* stem length a3 = int(line2{sub..}) /* slope a3 = int(line2{sub..}) /* font a3 = int(line2{sub..}) /* number of objects else a3 = 2 end a3 <<= 1 h = 0 trec = eskrec EWB1: trec = list_order(trec,1) if con2 = 5 or con2 = 0 trec2 = 0 else trec2 = list_order(trec,4) end if trec2 > 0 tget [X2,trec2] tline .t8 jtype ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X,trec] tline .t8 jtype ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end if tline{1} <> "J" goto EWB1 end loop for i = 1 to supcnt if o(i) = supernum ++h esksuperdata(k,h) = oby /* construct esksuperdata up-side-down ++h esksuperdata(k,h) = obx i = supcnt end repeat if h < a3 goto EWB1 end &dA &dA &d@ reverse order of esksuperdata(k,.) &dA a1 = a3 loop for i = 1 to a3 >> 1 h = esksuperdata(k,i) esksuperdata(k,i) = esksuperdata(k,a1) esksuperdata(k,a1) = h --a1 repeat end &dA &dA &d@ compensate for out-of-order objects &dA if esksuperdata(k,1) > esksuperdata(k,3) x1 = esksuperdata(k,3) y1 = esksuperdata(k,4) esksuperdata(k,3) = esksuperdata(k,1) esksuperdata(k,4) = esksuperdata(k,2) esksuperdata(k,1) = x1 esksuperdata(k,2) = y1 end if htype = "T" &dA &dA &d@ structure of &dDtie superobject&d@: 4. vertical position of tied note &dA &d@ 5. horiz. displacement from 1st note &dA &d@ 6. horiz. displacement from 2nd note &dA &d@ 7. post adjustment of calculated left x position &dA04/20/03 &dA &d@ 8. post adjustment of calculated y position " &dA &d@ 9. post adjustment of calculated right x position " &dA &d@ 10. sitflag &dA &d@ 11. recalc flag &dA tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) tpost_x = int(tline) /* added &dA04/20/03&d@ etc. tline = txt(line,[' '],lpt) tpost_y = int(tline) tline = txt(line,[' '],lpt) tpost_leng = int(tline) tline = txt(line,[' '],lpt) sitflag = int(tline) tspan = esksuperdata(k,3) + x2 - x1 perform settie esksupermap(k) = 0 goto TOP end if htype = "B" &dA &dA &d@ structure of &dDbeam superobject&d@: slope vertoff font# #obs bc(1) ... &dA tline = txt(line,[' '],lpt) @k = int(tline) tline = txt(line,[' '],lpt) @m = int(tline) tline = txt(line,[' '],lpt) beamfont = int(tline) i = Mbeamfont(notesize) /* covers all 12 notesizes /* &dA12/18/04 if beamfont = i stemchar = 59 beamh = eskvpar(16) beamt = eskvpar(32) qwid = eskhpar(3) else stemchar = 187 beamh = eskvpar(16) * 4 / 5 beamt = eskvpar(32) * 4 + 3 / 5 qwid = eskhpar(5) end tline = txt(line,[' '],lpt) bcount = int(tline) j = 1 loop for i = 1 to bcount beamdata(i,1) = esksuperdata(k,j) + esksp beamdata(i,2) = esksuperdata(k,j+1) + esksq(eskf12) temp = txt(line,[' '],lpt) temp = rev(temp) e = 6 - len(temp) beamcode(i) = temp // "00000"{1,e} j += 2 repeat * print beam tbflag = 0 if tupldata(1) > 0 and tupldata(5) = supernum tbflag = bit(4,tupldata(1)) ++tbflag end perform esksetbeam tupldata(1) = 0 esksupermap(k) = 0 goto TOP end if htype = "S" &dA &dA &d@ structure of &dDslur superobject&d@: 4. sitflag &dA &d@ 5. extra horiz. displ. from obj-1 &dA &d@ 6. extra vert. displ. from obj-1 &dA &d@ 7. extra horiz. displ. from obj-2 &dA &d@ 8. extra vert. displ. from obj-2 &dA &d@ 9. extra curvature (new 6-30-93) &dA &d@ 10. beam flag &dA &d@ 11. post adjustment to x co-ordinate &dA &d@ 12. post adjustment to y co-ordinate &dA slur_edit_flag = 0 tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) y1 = int(tline) if y1 <> 0 slur_edit_flag = 1 end y1 += esksuperdata(k,2) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) tline = txt(line,[' '],lpt) y2 = int(tline) if y2 <> 0 slur_edit_flag = 1 end y2 += esksuperdata(k,4) if y1 > 700 y1 -= 1000 y1 += eskvst(eskf12) end if y2 > 700 y2 -= 1000 y2 += eskvst(eskf12) end tline = txt(line,[' '],lpt) addcurve = int(tline) tline = txt(line,[' '],lpt) j = int(tline) postx = 0 posty = 0 if lpt < len(line) tline = txt(line,[' '],lpt) postx = int(tline) end if lpt < len(line) tline = txt(line,[' '],lpt) posty = int(tline) end if bit(5,sitflag) = 0 /* This condition added &dA04/26/05 perform putslur end esksupermap(k) = 0 goto TOP end if htype = "F" &dA &dA &d@ structure of figcon super-object: 4. figure level &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. (optional) additional vert. disp. &dANew 11/06/03 &dA &d@ from default height &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) &dA &dA &d@ Adding code &dA11/06/03&d@ to look for optional additional vert. disp. &dA y1 = 0 if lpt < len(line) tline = txt(line,[' '],lpt) y1 = int(tline) end perform putfigcon esksupermap(k) = 0 goto TOP end if htype = "X" &dA &dA &d@ structure of tuplet super-object: 4. situation flag &dA &d@ 5. tuplet number &dA &d@ 6. horiz. disp. from obj1 &dA &d@ 7. vert. disp. from obj1 &dA &d@ 8. horiz. disp. from obj2 &dA &d@ 9. vert. disp. from obj2 &dA &d@ 10. associated beam super-number &dA tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y2 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if bit(3,sitflag) = 1 tupldata(1) = sitflag tupldata(2) = a1 tupldata(3) = x1 tupldata(4) = x2 tupldata(5) = a2 tupldata(6) = y1 tupldata(7) = y2 else x1 += esksuperdata(k,1) y1 += esksuperdata(k,2) x2 += esksuperdata(k,3) y2 += esksuperdata(k,4) if y1 > 700 y1 -= 1000 y1 += eskvst(eskf12) end if y2 > 700 y2 -= 1000 y2 += eskvst(eskf12) end perform puttuplet end esksupermap(k) = 0 goto TOP end &dA &dA &d@ For the rest of the superbjects, please see code at procedure esksave1 &dA perform esksave1 esksupermap(k) = 0 goto TOP &dA &dA &d@ B A R L I N E (section recoded &dA05/26/03&d@) &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(12): /* line{1} = "B" sub = 3 a7 = int(line{sub..}) if a7 = 99 if sysflag = 0 #if REPORT3 putc #endif sysflag = 1 end goto TOP end &dA &dA &d@ First make sure that the system line is printed. &dA &d@ (this code moved here and revised &dA11/13/03&d@) &dA savesub = sub savensz = notesize if sysflag = 0 #if REPORT3 putc #endif &dA &d@ Code added here &dA11/13/03&d@ to set govstaff for printing sysline, etc. govstaff = 0 a2 = 0 loop for c8 = 1 to len(esksyscode) if ".:,;" con esksyscode{c8} ++a2 if mpt > 2 if govstaff = 0 govstaff = a2 else if nsz(a2) > nsz(govstaff) govstaff = a2 end end end end repeat if govstaff = 0 govstaff = eskf11 /* default for govstaff end a2 = nsz(govstaff) if a2 <> notesize notesize = a2 perform init_par end perform sysline sysflag = 1 end sub = savesub &dA a8 = a7 & 0x0f x = int(line{sub..}) brkcnt = int(line{sub..}) loop for i = 1 to brkcnt a6 = int(line{sub..}) barbreak(i,1) = a6 + esksysy a6 = int(line{sub..}) barbreak(i,2) = a6 + esksysy repeat * sort breaks in ascending order of offset if brkcnt > 1 c5 = brkcnt - 1 loop for c1 = 1 to c5 c6 = c1 + 1 loop for c2 = c6 to brkcnt if barbreak(c2,1) < barbreak(c1,1) c3 = barbreak(c1,1) c4 = barbreak(c1,2) barbreak(c1,1) = barbreak(c2,1) barbreak(c1,2) = barbreak(c2,2) barbreak(c2,1) = c3 barbreak(c2,2) = c4 end repeat repeat end * x = x + esksp if a8 < 2 z = 82 perform barline end if a8 = 2 x = x - eskhpar(33) /* eskhpar(33) = heavy - light + 1 z = 84 perform barline end if a8 = 3 z = 86 perform barline end if a8 = 5 z = 82 perform barline x = x - eskhpar(48) /* eskhpar(48) = light + delta-light (auto eskhpar(44)) perform barline end if a8 = 6 z = 84 x = x - eskhpar(33) perform barline z = 82 x = x - eskhpar(34) /* eskhpar(34) = light + delta-heavy (auto eskhpar(45)) perform barline end if a8 = 9 z = 84 perform barline z = 82 x = x + eskhpar(33) + eskhpar(34) - 1 perform barline if a7 > 15 x = x + eskhpar(36) loop for eskf12 = 1 to eskf11 y = esksq(eskf12) + eskvpar(3) z = 44 perform setmus y = y + eskvpar(2) perform setmus &dA &dA &d@ Adding code &dA05/26/03&d@ for print second set of dots in case of grandstaff &dA &d@ if eskvst(eskf12) > 0 y = y - eskvpar(2) + eskvst(eskf12) z = 44 perform setmus y = y + eskvpar(2) perform setmus end repeat end end if a8 = 10 z = 84 perform barline x = x - eskhpar(33) - eskhpar(34) + 1 perform barline end &dA &dA &d@ Code added &dA11/13/03&d@ to reset notesize to local value &dA if notesize <> savensz notesize = savensz perform init_par end &dA goto TOP &dA &dA &d@ "Silent" S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(13): /* line{1} = "k" goto TOP &dA &dA &d@ "Silent" Z - R E C O R D S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(14): /* line{1} = "Z" goto TOP &dA &dA &d@ End of processing music data &dA return &dA &d@ &dA &dA &d@*P&dA XX. init_par &dA &d@ &dA &dA &dA &d@ Purpose: Initialize Vertical and Horizontal Parameters &dA &d@ and expar(.) parameters &dA &dA &d@ Inputs: notesize &dA &d@ &dA &d@ Outputs: eskvpar(.) &dA &d@ eskhpar(.) &dA &d@ eskvpar20 &dA &d@ expar(.) &dA &d@ revmap(.) &dA &d@ sizenum &dA &d@ &dA &d@ Other operations: In all cases, if scf = old notesize, then &dA &d@ scf reset to new notesize &dA &d@ procedure init_par int a,b,i int pz bstr cycle.200 sizenum = revsizes(notesize) &dA &dA &d@ Vertical parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if notesize = 14 eskvpar(13) = 8 eskvpar(42) = 4 eskvpar(43) = 240 eskvpar(44) = 1 end if notesize = 6 eskvpar(13) = 3 /* Changed from 4 to 3 &dA01/30/05&d@ eskvpar(42) = 2 eskvpar(43) = 80 eskvpar(44) = 1 end if notesize = 21 eskvpar(13) = 12 eskvpar(42) = 6 eskvpar(43) = 240 eskvpar(44) = 3 end if notesize = 18 /* New size-18 &dA12/18/04&d@ eskvpar(13) = 10 eskvpar(42) = 5 eskvpar(43) = 240 eskvpar(44) = 2 end if notesize = 16 /* New size-16 &dA01/01/09&d@ eskvpar(13) = 9 eskvpar(42) = 4 eskvpar(43) = 240 eskvpar(44) = 1 end loop for i = 1 to 10 eskvpar(i) = notesize * i / 2 repeat eskvpar(11) = 200 * notesize / 16 eskvpar(12) = 4 * notesize / 16 eskvpar(14) = 160 * notesize / 16 eskvpar(15) = 64 * notesize / 16 eskvpar(16) = 3 * notesize eskvpar(17) = notesize / 2 eskvpar(18) = 30 * notesize / 16 eskvpar(19) = 15 eskvpar(20) = notesize + 3 / 4 eskvpar(21) = notesize - eskvpar(20) eskvpar(22) = 6 * notesize / 16 eskvpar(23) = 9 * notesize / 16 eskvpar(24) = 7 * notesize / 16 eskvpar(25) = 22 * notesize / 16 eskvpar(26) = 27 * notesize / 16 eskvpar(27) = 72 * notesize / 16 eskvpar(28) = 15 * notesize / 16 eskvpar(29) = 38 * notesize / 16 eskvpar(30) = 3 * notesize - 8 / 16 eskvpar(31) = notesize / 2 + 1 eskvpar(32) = notesize * 8 + 4 / 10 eskvpar(33) = notesize * 12 + 10 / 14 eskvpar(34) = notesize - 3 / 9 eskvpar(35) = notesize / 3 eskvpar(36) = 7 * notesize eskvpar(37) = 5 * notesize / 4 eskvpar(38) = 4 * notesize / 3 eskvpar(39) = notesize eskvpar(40) = 3 * notesize / 5 eskvpar(41) = eskvpar(5) eskvpar(45) = 2 * notesize eskvpar20 = notesize * 10 &dA &dA &d@ Horizontal parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if notesize = 14 eskhpar(2) = 15 eskhpar(3) = 19 eskhpar(5) = 13 eskhpar(6) = 80 eskhpar(7) = 56 /* &dA01/20/05&d@ made explicit eskhpar(12) = 80 eskhpar(17) = 14 eskhpar(19) = 4 eskhpar(20) = 20 eskhpar(29) = 2 eskhpar(30) = 15 eskhpar(33) = 6 eskhpar(34) = 7 eskhpar(43) = 40 eskhpar(48) = 8 eskhpar(58) = 30 eskhpar(60) = 254 eskhpar(61) = 20 eskhpar(62) = 2 eskhpar(63) = 90 end if notesize = 6 eskhpar(2) = 7 eskhpar(3) = 8 eskhpar(5) = 6 eskhpar(6) = 34 eskhpar(7) = 18 /* &dA01/20/05&d@ changed from 24 to 18 and made explicit eskhpar(12) = 35 eskhpar(17) = 7 eskhpar(19) = 2 eskhpar(20) = 9 eskhpar(29) = 1 eskhpar(30) = 7 eskhpar(33) = 3 eskhpar(34) = 4 eskhpar(43) = 30 eskhpar(48) = 4 eskhpar(58) = 10 eskhpar(60) = 110 eskhpar(61) = 10 eskhpar(62) = 1 eskhpar(63) = 90 end if notesize = 21 eskhpar(2) = 19 eskhpar(3) = 28 eskhpar(5) = 18 /* &dA12/18/04&d@ changed from 19 to 18 eskhpar(6) = 110 eskhpar(7) = 88 /* &dA01/20/05&d@ made explicit eskhpar(12) = 100 eskhpar(17) = 21 eskhpar(19) = 6 eskhpar(20) = 30 eskhpar(29) = 3 eskhpar(30) = 19 eskhpar(33) = 8 /* &dA12/18/04&d@ changed from 9 to 8 eskhpar(34) = 11 eskhpar(43) = 30 eskhpar(48) = 13 eskhpar(58) = 30 eskhpar(60) = 381 eskhpar(61) = 30 eskhpar(62) = 3 eskhpar(63) = 80 end &dA &dA &d@ New &dA01/01/09&d@ notesize 16 parameters added &dA if notesize = 16 eskhpar(2) = 16 eskhpar(3) = 22 eskhpar(5) = 15 eskhpar(6) = 90 eskhpar(7) = 64 eskhpar(12) = 80 eskhpar(17) = 16 eskhpar(19) = 4 eskhpar(20) = 23 eskhpar(29) = 2 eskhpar(30) = 18 eskhpar(33) = 6 eskhpar(34) = 9 eskhpar(43) = 30 eskhpar(48) = 9 eskhpar(58) = 30 eskhpar(60) = 280 eskhpar(61) = 22 eskhpar(62) = 2 eskhpar(63) = 80 #if BIG16 ++eskhpar(3) #endif end &dA &dA &d@ New &dA12/18/04&d@ notesize 18 parameters added &dA if notesize = 18 eskhpar(2) = 17 eskhpar(3) = 26 eskhpar(5) = 17 eskhpar(6) = 100 eskhpar(7) = 72 /* &dA01/20/05&d@ made explicit eskhpar(12) = 90 eskhpar(17) = 18 eskhpar(19) = 5 eskhpar(20) = 26 eskhpar(29) = 3 eskhpar(30) = 17 eskhpar(33) = 7 eskhpar(34) = 9 eskhpar(43) = 30 eskhpar(48) = 10 eskhpar(58) = 30 eskhpar(60) = 326 eskhpar(61) = 26 eskhpar(62) = 2 eskhpar(63) = 80 end eskhpar(1) = 30 &dA &d@ eskhpar(2) = 18 * notesize / 16 &dA &d@ eskhpar(3) = 19 * notesize + 8 / 16 &dA &d@ eskhpar(4) = 3 &dA &d@ eskhpar(5) = 13 * notesize + 2 / 16 &dA &d@ eskhpar(6) = 80 &dA &d@ eskhpar(7) = 4 * notesize /* &dA01/20/05&d@ made explicit &dA &d@ eskhpar(8) = 200 &dA &d@ eskhpar(9) = 2250 eskhpar(10) = 26 * notesize / 16 eskhpar(11) = 200 * notesize / 16 &dA &d@ eskhpar(12) = 80 eskhpar(14) = 40 * notesize / 16 eskhpar(16) = 24 * notesize / 16 &dA &d@ eskhpar(17) = 14 eskhpar(18) = 2 * notesize &dA &d@ eskhpar(19) = 4 &dA &d@ eskhpar(20) = 20 &dA &d@ eskhpar(21) = 300 &dA &d@ eskhpar(22) = 6 * notesize / 16 (not used) &dA &d@ eskhpar(23) = 60 * notesize / 16 (not used) &dA &d@ eskhpar(24) = 7 * notesize + 2 / 7 (not used) &dA &d@ eskhpar(25) = notesize + 1 (not used) &dA &d@ eskhpar(26) = 15 * notesize / 16 (not used) &dA &d@ eskhpar(27) = 0 (not used) &dA &d@ eskhpar(28) = 0 - 32 * notesize / 16 (not used) &dA &d@ eskhpar(29) = 2 * notesize + 8 / 16 &dA &d@ eskhpar(30) += eskhpar(29) eskhpar(31) = 24 * notesize / 16 eskhpar(32) = 44 * notesize / 16 &dA &d@ eskhpar(33) = 6 * notesize / 16 &dA &d@ eskhpar(34) = 8 * notesize / 16 eskhpar(35) = 14 * notesize / 16 eskhpar(36) = 8 * notesize / 16 eskhpar(37) = 20 * notesize / 16 eskhpar(38) = 20 * notesize / 16 eskhpar(39) = 50 * notesize / 16 eskhpar(40) = 15 * notesize + 4 / 16 eskhpar(41) = eskvpar(5) eskhpar(42) = notesize * 4 &dA &d@ eskhpar(43) = 40 eskhpar(44) = notesize eskhpar(45) = notesize eskhpar(46) = 13 * notesize / 16 eskhpar(47) = 2 * notesize / 5 &dA &d@ eskhpar(48) = 10 * notesize / 16 &dA &d@ eskhpar(49) = 24 * notesize / 16 &dA &d@ eskhpar(50) = 12 * notesize / 16 eskhpar(51) = 31 * notesize / 16 eskhpar(52) = 19 * notesize / 16 eskhpar(53) = 4 * notesize / 16 eskhpar(54) = 18 * notesize / 16 eskhpar(55) = 6 * notesize / 16 eskhpar(56) = 12 * notesize / 16 eskhpar(57) = 2 * notesize eskhpar(59) = 3 * notesize / 5 &dA &dA &d@ New &dA01/01/09&d@ parameters added for notesize 16 &dA if notesize = 16 eskhpar(42) = 56 end &dA &dA &d@ New &dA12/18/04&d@ parameters added for notesize 18 &dA if notesize = 18 eskhpar(11) = 225 eskhpar(39) = 50 eskhpar(42) = 67 end if notesize = 21 eskhpar(11) = 250 eskhpar(39) = 50 eskhpar(42) = 76 end &dA &dA &d@ Other parameters and variables &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if notesize = 14 expar(1) = 240 expar(2) = 324 expar(3) = 254 expar(4) = 324 expar(5) = 256 expar(6) = 324 expar(7) = 260 expar(8) = 324 end if notesize = 6 expar(1) = 102 expar(2) = 139 expar(3) = 106 expar(4) = 146 expar(5) = 107 expar(6) = 144 expar(7) = 109 expar(8) = 148 end if notesize = 21 expar(1) = 360 expar(2) = 486 expar(3) = 381 expar(4) = 498 expar(5) = 386 expar(6) = 486 expar(7) = 390 expar(8) = 498 end &dA &dA &d@ notesize 16 added &dA01/01/09 &dA if notesize = 16 expar(1) = 278 expar(2) = 362 expar(3) = 290 expar(4) = 372 expar(5) = 296 expar(6) = 368 expar(7) = 298 expar(8) = 376 end &dA &dA &d@ notesize 18 added &dA12/18/04 &dA if notesize = 18 expar(1) = 308 expar(2) = 424 expar(3) = 326 expar(4) = 428 expar(5) = 330 expar(6) = 422 expar(7) = 334 expar(8) = 432 end loop for i = 1 to 223 pos(i) = urpos(i) * notesize repeat &dA &dA &d@ Dotted mask (modified &dA10/23/03&d@) &dA if notesize = 14 gapsize = 8 cycle = dup("1",10) // dup("0",6) end if notesize = 6 gapsize = 3 cycle = dup("1",4) // dup("0",2) end if notesize = 21 gapsize = 12 cycle = dup("1",15) // dup("0",9) end if notesize = 16 /* New size-16 mask &dA01/01/09&d@ gapsize = 9 cycle = dup("1",11) // dup("0",7) end if notesize = 18 /* New size-18 mask &dA12/18/04&d@ gapsize = 10 cycle = dup("1",12) // dup("0",8) end dotted = "" i = 2500 - (2 * gapsize) loop dotted = dotted // cycle repeat while len(dotted) < i &dA &dA &d@ scf can be &dA &d@ (1) old notesize (4 to 24) (requires change in scf) &dA &d@ (2) beamfont (101 to 114) (independent of notesize) &dA &d@ (3) text font (31 to 48) (actual font depends on notesize) &dA &d@ (4) 300 (ties) " &dA &d@ (5) 320 (brackets) " &dA &d@ (6) 400 (wedges) " &dA &d@ (7) 30 (variable pitch screen fonts, display only) &dA &d@ (8) 200 (fixed pitch screen font, display only) &dA if scf > 0 and scf < 25 scf = notesize end pz = revsizes(notesize) loop for a = 30 to 48 revmap(a) = XFonts(pz,a-29) repeat revmap(200) = scfont(notesize) revmap(300) = pz + TIE_OFFSET if notesize < 10 revmap(320) = SMALL_BRACK else revmap(320) = LARGE_BRACK end revmap(400) = wedgefont(notesize) return &dA &d@ ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ &dA &d@ ³*P procedure pgetk (k) Added &dA11/25/03&d@ ³ &dA &d@ ³ ³ &dA &d@ ³ Purpose: Combine all getk calls. Make possible the ³ &dA &d@ ³ implementation of macros ³ &dA &d@ ³ ³ &dA &d@ ³ Operation: The idea is that the user can set up 8 possible ³ &dA &d@ ³ macros, F5 to F12. And if the user types one ³ &dA &d@ ³ of these keys, pgetk will feed the buffer ³ &dA &d@ ³ successively to to user. If the buffer is ³ &dA &d@ ³ empty or is undefined, the normal getk will ³ &dA &d@ ³ be called. ³ &dA &d@ ³ ³ &dA &d@ ³ Variables: int macros(8,100) ³ &dA &d@ ³ int macropnt(8) ³ &dA &d@ ³ int macstrokes(8) ³ &dA &d@ ³ int macchange ³ &dA &d@ ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ procedure pgetk (k) int i,j,k int macroswitch(8) &dA &dA &d@ First: Look to see if a macro is active &dA loop for i = 1 to 8 if macropnt(i) > 0 j = macropnt(i) /* get next keystroke in macro ++macropnt(i) /* increment pointer k = macros(i,j) if k = 0 /* if k = 0, this is end marker macropnt(i) = 0 goto GETKK /* back to getk end goto RETGETK end repeat &dA &dA &d@ Also: Check for active pseudomacro (New &dA11/01/08&d@) &dA if pseudomacropnt > 0 k = pseudomacro(pseudomacropnt) if k = 0 pseudomacropnt = 0 goto GETKK /* back to getk end ++pseudomacropnt goto RETGETK end GETKK: getk k &dA &dA &d@ Second: Check to see if this is a call to a macro &dA if k >= 0x031004 and k <= 0x03100b i = k & 0x0f - 3 /* 1 to 8 macropnt(i) = 2 k = macros(i,1) /* get first keystroke in macro if k = 0 macropnt(i) = 0 /* no macro stored for this Fx goto GETKK end goto RETGETK end &dA &dA &d@ Third: Look for turning on or off loading of macro &dA if k >= 0x031014 and k <= 0x03101b /* shift Fx = start loading i = k & 0x0f - 3 /* 1 to 8 macroswitch(i) = 1 /* set macro for loading goto GETKK end if k >= 0x031024 and k <= 0x03102b /* ctrl Fx = stop loading i = k & 0x0f - 3 /* 1 to 8 j = macroswitch(i) if j = 0 j = 1 end macros(i,j) = 0 /* store end marker (or clear buffer) macstrokes(i) = j - 1 macroswitch(i) = 0 /* stop loading macchange = 1 goto GETKK end &dA &dA &d@ Fourth: load macro buffer, if appropriate &dA loop for i = 1 to 8 if macroswitch(i) > 0 j = macroswitch(i) if j > 100 macros(i,1) = 0 /* clear entire buffer macroswitch(i) = 0 /* stop loading else if k < 0x031000 /* no macros allowed inside macros macros(i,j) = k ++macroswitch(i) end end end repeat &dA &dA &d@ Fifth: Return value of k &dA RETGETK: passback k return &dA &d@ &dA &dA &d@*P&dA XXI. get_hght_dpth &dA &d@ &dA &dA &dA &d@ Purpose: Construct the hght(.) and dpth(.) arrays -- parameters &dA &d@ used in estimating size of scaling section after a change &dA &dA &d@ Outputs: hght(.) &dA &d@ dpth(.) &dA &d@ &dA &d@ Note: The hght(.) and dpth(.) values for the NEWFONTS case may &dA &d@ be reconstructed (updated) using the program &dA &d@ J:/MUSPRINT/NEW/XFONTS/TMS/eskpars.z &dA &d@ procedure get_hght_dpth hght(1) = 21 hght(2) = 23 hght(3) = 25 hght(4) = 27 hght(5) = 29 hght(6) = 33 hght(7) = 37 hght(8) = 57 hght(9) = 45 hght(10) = 73 hght(11) = 86 hght(12) = 61 hght(13) = 15 hght(14) = 15 hght(15) = 15 hght(16) = 15 hght(17) = 15 hght(18) = 15 hght(19) = 15 hght(20) = 15 hght(21) = 15 hght(22) = 15 hght(23) = 15 hght(24) = 15 hght(25) = 15 hght(26) = 23 hght(27) = 23 hght(28) = 23 hght(29) = 23 hght(30) = 23 hght(31) = 23 hght(32) = 23 hght(33) = 23 hght(34) = 23 hght(35) = 30 hght(36) = 69 hght(37) = 23 hght(38) = 5 hght(39) = 7 hght(40) = 7 hght(41) = 8 hght(42) = 0 hght(43) = 0 hght(44) = 5 hght(45) = 8 hght(46) = 11 hght(47) = 17 hght(48) = 5 hght(49) = 5 hght(50) = 5 hght(51) = 8 hght(52) = 8 hght(53) = 8 hght(54) = 13 hght(55) = 14 hght(56) = 16 hght(57) = 17 hght(58) = 18 hght(59) = 20 hght(60) = 22 hght(61) = 23 hght(62) = 25 hght(63) = 27 hght(64) = 30 hght(65) = 32 hght(66) = 35 hght(67) = 36 hght(68) = 40 hght(69) = 41 hght(70) = 42 hght(71) = 43 hght(72) = 46 hght(73) = 48 hght(74) = 54 hght(75) = 59 hght(76) = 63 hght(77) = 63 hght(78) = 68 hght(79) = 82 hght(80) = 82 hght(81) = 13 hght(82) = 13 hght(83) = 13 hght(84) = 13 hght(85) = 16 hght(86) = 16 hght(87) = 17 hght(88) = 19 hght(89) = 19 hght(90) = 22 hght(91) = 23 hght(92) = 25 hght(93) = 26 hght(94) = 29 hght(95) = 32 hght(96) = 33 hght(97) = 35 hght(98) = 38 hght(99) = 39 hght(100) = 42 hght(101) = 42 hght(102) = 46 hght(103) = 47 hght(104) = 51 hght(105) = 55 hght(106) = 60 hght(107) = 63 hght(108) = 68 hght(109) = 78 hght(110) = 78 hght(111) = 14 hght(112) = 14 hght(113) = 14 hght(114) = 14 hght(115) = 15 hght(116) = 16 hght(117) = 17 hght(118) = 19 hght(119) = 22 hght(120) = 23 hght(121) = 25 hght(122) = 26 hght(123) = 27 hght(124) = 30 hght(125) = 33 hght(126) = 34 hght(127) = 35 hght(128) = 38 hght(129) = 40 hght(130) = 41 hght(131) = 44 hght(132) = 47 hght(133) = 48 hght(134) = 53 hght(135) = 59 hght(136) = 61 hght(137) = 64 hght(138) = 69 hght(139) = 82 hght(140) = 82 dpth(1) = 23 dpth(2) = 25 dpth(3) = 27 dpth(4) = 29 dpth(5) = 31 dpth(6) = 35 dpth(7) = 39 dpth(8) = 63 dpth(9) = 47 dpth(10) = 79 dpth(11) = 94 dpth(12) = 63 dpth(13) = 16 dpth(14) = 17 dpth(15) = 18 dpth(16) = 20 dpth(17) = 20 dpth(18) = 21 dpth(19) = 22 dpth(20) = 23 dpth(21) = 24 dpth(22) = 27 dpth(23) = 27 dpth(24) = 27 dpth(25) = 27 dpth(26) = 24 dpth(27) = 24 dpth(28) = 24 dpth(29) = 24 dpth(30) = 24 dpth(31) = 24 dpth(32) = 24 dpth(33) = 24 dpth(34) = 24 dpth(35) = 31 dpth(36) = 72 dpth(37) = 24 dpth(38) = 6 dpth(39) = 7 dpth(40) = 7 dpth(41) = 8 dpth(42) = 198 dpth(43) = 99 dpth(44) = 2 dpth(45) = 3 dpth(46) = 4 dpth(47) = 6 dpth(48) = 2 dpth(49) = 2 dpth(50) = 2 dpth(51) = 3 dpth(52) = 3 dpth(53) = 3 dpth(54) = 4 dpth(55) = 5 dpth(56) = 5 dpth(57) = 6 dpth(58) = 6 dpth(59) = 7 dpth(60) = 8 dpth(61) = 8 dpth(62) = 8 dpth(63) = 9 dpth(64) = 10 dpth(65) = 11 dpth(66) = 11 dpth(67) = 10 dpth(68) = 11 dpth(69) = 12 dpth(70) = 13 dpth(71) = 13 dpth(72) = 14 dpth(73) = 15 dpth(74) = 16 dpth(75) = 18 dpth(76) = 19 dpth(77) = 20 dpth(78) = 21 dpth(79) = 25 dpth(80) = 25 dpth(81) = 4 dpth(82) = 4 dpth(83) = 4 dpth(84) = 4 dpth(85) = 6 dpth(86) = 6 dpth(87) = 6 dpth(88) = 5 dpth(89) = 7 dpth(90) = 6 dpth(91) = 7 dpth(92) = 6 dpth(93) = 7 dpth(94) = 8 dpth(95) = 8 dpth(96) = 11 dpth(97) = 11 dpth(98) = 11 dpth(99) = 12 dpth(100) = 11 dpth(101) = 14 dpth(102) = 12 dpth(103) = 15 dpth(104) = 16 dpth(105) = 18 dpth(106) = 16 dpth(107) = 17 dpth(108) = 19 dpth(109) = 25 dpth(110) = 25 dpth(111) = 4 dpth(112) = 4 dpth(113) = 4 dpth(114) = 4 dpth(115) = 5 dpth(116) = 6 dpth(117) = 6 dpth(118) = 7 dpth(119) = 7 dpth(120) = 8 dpth(121) = 8 dpth(122) = 9 dpth(123) = 9 dpth(124) = 11 dpth(125) = 11 dpth(126) = 12 dpth(127) = 11 dpth(128) = 12 dpth(129) = 13 dpth(130) = 13 dpth(131) = 15 dpth(132) = 16 dpth(133) = 15 dpth(134) = 16 dpth(135) = 20 dpth(136) = 17 dpth(137) = 22 dpth(138) = 20 dpth(139) = 25 dpth(140) = 25 return &dA &dA &dA End of GIANT #if XVERSION section #endif #if XVERSION &dA &dA &d@ &dA &d@*P XXII. procedure start_xversion &dA &d@ &dA &d@ Initializing arrays for NEWFONTS &dA procedure start_xversion &dA &dA &d@ First acquire macro definitions from the MACFILE &dA macchange = 0 macfile = DISP_DISK // ":/release/progs/" // MACFILE loop for i = 1 to 8 loop for j = 1 to 100 macros(i,j) = 0 repeat macstrokes(i) = 0 macropnt(i) = 0 repeat line = DISP_DISK // ":/release/progs" open [9,1] line loop getf [9] line .t10 line2 line = line // pad(8) line2 = line2 // pad(1) line = line{1,8} line = trm(line) line = line // "." // line2{1} if line = MACFILE open [8,1] macfile getf [8] line line = line // pad(48) line = line{1,48} if line <> " ESKPAGE MACRO DEFINITION FILE" putc Macro file found, but the header is not correct. &dAIgnoring file&d@. close [8] goto eof9 end getf [8] line loop getf [8] line line = line // " " a = int(line{2..}) if a > 4 and a < 13 a -= 4 lpt = 7 loop for b = 1 to 20 tline = txt(line,[',',32],lpt) d = 16 macros(a,b) = 0 loop for c = 4 to 8 if "0123456789abcdef" con tline{c} macros(a,b) += ((mpt - 1) << d) end d -= 4 repeat repeat while line{lpt} = "," macstrokes(a) = b end repeat eof8: close [8] goto eof9 end repeat eof9: close [9] &dA &dA &d@ Second, initialize variables brought over from ESKPAGE &dA &dA &d@ 1. Shift parameters for music font &dA file = DISP_DISK // ":/musprint/new/mfonts/pos3" open [1,1] file loop for i = 1 to 223 getf [1] .t39 a urpos(i) = a repeat close [1] &dA &dA &d@ 2. Initialize Vertical and Horizontal Parameters &dA notesize = 14 perform init_par &dA &d@ Outputs: eskvpar(.) &dA &d@ eskhpar(.) &dA &d@ eskvpar20 &dA &d@ expar(.) &dA &d@ revmap(.) &dA &d@ sizenum &dA wak(1) = 140 wak(2) = 156 wak(3) = 131 wak(4) = 156 wak(5) = 128 wak(6) = 140 wak(7) = 128 wak(8) = 129 wak(9) = 130 &dA &dA &d@ 3. Cursor &dA curdata(1) = " xxxx " curdata(2) = " xxxxx " curdata(3) = " xxxxxx " curdata(4) = " xxxxxxx " curdata(5) = " xxxxxxxx " curdata(6) = " xxxxxxxxx " curdata(7) = " xxxxxxxxxxx " curdata(8) = " xxxxxxxxxxxxx " curdata(9) = "xxxxxxxxxxxxxxxxxxxxxxxxx " curdata(10) = "xxxxxxxxxxxxxxxxxxxxxxxxxxx" curdata(11) = "xxxxxxxxxxxxxxxxxxxxxxxxxxx" curdata(12) = "xxxxxxxxxxxxxxxxxxxxxxxxx " curdata(13) = " xxxxxxxxxxxxx " curdata(14) = " xxxxxxxxxxx " curdata(15) = " xxxxxxxxx " curdata(16) = " xxxxxxxx " curdata(17) = " xxxxxxx " curdata(18) = " xxxxxx " curdata(19) = " xxxxx " curdata(20) = " xxxx " CURSOR(1) = 2 CURSOR(2) = 0x141c0000 CURSOR(3) = 0 loop for i = 1 to 20 tbstr = pak(curdata(i)) temp = cby(tbstr) temp = temp // zpd(4) CURSOR(i+3) = ors(temp) repeat &dA &dA &d@ 4. Blue lines in display &dA temp = chr(255) gline = dup(temp,360) setup blue_horiz1t,339,1,1,0,0,160,904 setup blue_horiz2t,178,1,1,0,0,160,904 setup blue_horiz3t,126,1,1,0,0,160,904 setup blue_horiz4t,100,1,1,0,0,160,904 setup blue_horiz1b,339,1,1,0,0,160,904 setup blue_horiz2b,178,1,1,0,0,160,904 setup blue_horiz3b,126,1,1,0,0,160,904 setup blue_horiz4b,100,1,1,0,0,160,904 setup blue_vert1v,1,3400,1,0,0,160,904 setup blue_vert2v,1,1810,1,0,0,160,904 setup blue_vert3v,1,1260,1,0,0,160,904 setup blue_vert4v,1,985,1,0,0,160,904 setup blue_vert1r,1,3400,1,0,0,160,904 setup blue_vert2r,1,1810,1,0,0,160,904 setup blue_vert3r,1,1260,1,0,0,160,904 setup blue_vert4r,1,985,1,0,0,160,904 blue_horiz1t{21,339} = gline{1,339} blue_horiz1b{21,339} = gline{1,339} blue_horiz2t{21,178} = gline{1,178} blue_horiz2b{21,178} = gline{1,178} blue_horiz3t{21,126} = gline{1,126} blue_horiz3b{21,126} = gline{1,126} blue_horiz4t{21,100} = gline{1,100} blue_horiz4b{21,100} = gline{1,100} temp = chr(4) blue_vert1v{21,3400} = dup(temp,3400) temp = chr(16) blue_vert1r{21,3400} = dup(temp,3400) temp = chr(8) blue_vert2v{21,1810} = dup(temp,1810) temp = chr(1) blue_vert2r{21,1810} = dup(temp,1810) temp = chr(128) blue_vert3v{21,1260} = dup(temp,1260) temp = chr(64) blue_vert3r{21,1260} = dup(temp,1260) temp = chr(64) blue_vert4v{21,985} = dup(temp,985) temp = chr(2) blue_vert4r{21,985} = dup(temp,985) &dA &dA &d@ 5. Object, Subobject and Superobject definitions &dA obj_def(1) = "Bar line" obj_def(2) = "Clef" obj_def(3) = "Key signature" obj_def(4) = "Time signature" obj_def(5) = "Directive" obj_def(6) = "Symbol" obj_def(7) = "Note" obj_def(8) = "Rest" obj_def(9) = "Grace note" obj_def(10) = "Cue note" obj_def(11) = "Figures" obj_def(12) = "Directive/symbol" obj_def(13) = "Mark (dummy)" super_def(1) = "Beam" super_def(2) = "Tie" super_def(3) = "Slur" super_def(4) = "Tuple/bracket" super_def(5) = "Wedge" super_def(6) = "Dashes" super_def(7) = "Ending" super_def(8) = "Long trill" super_def(9) = "Octave transposition" super_def(10) = "Figure extension" super_def(11) = "Null" sub_def(33) = "Treble clef (top)" sub_def(34) = "Treble clef (bottom)" sub_def(35) = "C-clef" sub_def(36) = "Bass clef" sub_def(37) = "Common time" sub_def(38) = "Alle breve time" sub_def(39) = "Longa note head" sub_def(40) = "Breve note head" sub_def(41) = "Whole note head" sub_def(42) = "White note head" sub_def(43) = "Black note head" sub_def(44) = "time dot" sub_def(45) = "Leger line" sub_def(46) = "Whole rest" sub_def(47) = "Half rest" sub_def(48) = "Quarter rest" sub_def(49) = "Eighth rest" sub_def(50) = "Rest add-on component" sub_def(51) = "Short eighth flag" sub_def(52) = "Short eighth flag" sub_def(53) = "Eighth flag" sub_def(54) = "Eighth flag" sub_def(55) = "Sixteenth flag" sub_def(56) = "Sixteenth flag" sub_def(57) = "Flag add-on component" sub_def(58) = "Flag add-on component" sub_def(59) = "Two space stem unit" sub_def(60) = "Two space stem unit" sub_def(61) = "One space stem unit" sub_def(62) = "One space stem unit" sub_def(63) = "Sharp" sub_def(64) = "Natural" sub_def(65) = "Flat" sub_def(66) = "Double sharp" sub_def(67) = "Square left bracket" sub_def(68) = "Square right bracket" sub_def(69) = "Round left bracket" sub_def(70) = "Round right bracket" sub_def(71) = "Number 0" sub_def(72) = "Number 1" sub_def(73) = "Number 2" sub_def(74) = "Number 3" sub_def(75) = "Number 4" sub_def(76) = "Number 5" sub_def(77) = "Number 6" sub_def(78) = "Number 7" sub_def(79) = "Number 8" sub_def(80) = "Number 9" sub_def(81) = "Staff line character" sub_def(82) = "Four space bar" sub_def(83) = "One space bar" sub_def(84) = "Four space thick bar" sub_def(85) = "One space thick bar" sub_def(86) = "Four space dotted bar" sub_def(87) = "Thick vertical top" sub_def(88) = "Thick vartical bottom" sub_def(89) = "Begin/end hook" sub_def(90) = "Solid horz. line" sub_def(91) = "Dash horz. line" sub_def(92) = "Heavy horz. line" sub_def(93) = "horizontal accent" sub_def(94) = "Accent" sub_def(95) = "Accent" sub_def(96) = "Staccato dot" sub_def(97) = "Stricht" sub_def(98) = "Stricht" sub_def(99) = "- legato" sub_def(100) = ", breath" sub_def(101) = "Fermata" sub_def(102) = "Fermata" sub_def(103) = "./." sub_def(104) = "Solid /" sub_def(105) = "Empty /" sub_def(106) = "Signet sign" sub_def(107) = "Circle + cross" sub_def(108) = "p Piano" sub_def(109) = "m Mezzo" sub_def(110) = "f Forte" sub_def(111) = "s dynamic letter" sub_def(112) = "z dynamic letter" sub_def(113) = "r dynamic letter" sub_def(114) = "Ped." sub_def(115) = "* (end pedal)" sub_def(116) = "Up bow" sub_def(117) = "Down bow" sub_def(118) = "Pedal heel" sub_def(119) = "Pedal toe" sub_def(120) = "Arpegiate" sub_def(121) = "Repeat notes" sub_def(122) = "Harmonic a" sub_def(123) = "Harmonic b" sub_def(124) = "Thumb position" sub_def(125) = "Stem repeater" sub_def(126) = "Stem repeater" sub_def(127) = "Stem repeater" sub_def(161) = "Small treble clef (top)" sub_def(162) = "Small treble clef (bottom)" sub_def(163) = "Small C-clef" sub_def(164) = "Small bass clef" sub_def(165) = "Small common time" sub_def(166) = "Small alle breve time" sub_def(167) = "Small duple time" sub_def(168) = "Small triple time" sub_def(169) = "Small whole note head" sub_def(170) = "Small white note head" sub_def(171) = "Small black note head" sub_def(172) = "Small time dot" sub_def(173) = "Small leger line" sub_def(174) = "Small whole rest" sub_def(175) = "Small half rest" sub_def(176) = "Small quarter rest" sub_def(177) = "Small eighth rest" sub_def(178) = "Small rest add-on component" sub_def(179) = "Small eight + slash" sub_def(180) = "Small eight + slash" sub_def(181) = "Small eighth flag" sub_def(182) = "Small eighth flag" sub_def(183) = "Small sixteenth flag" sub_def(184) = "Small sixteenth flag" sub_def(185) = "Small flag add-on component" sub_def(186) = "Small flag add-on component" sub_def(187) = "Small two space stem unit" sub_def(188) = "Small two space stem unit" sub_def(189) = "Small one space stem unit" sub_def(190) = "Small one space stem unit" sub_def(191) = "Small sharp" sub_def(192) = "Small natural" sub_def(193) = "Small flat" sub_def(194) = "Small double sharp" sub_def(195) = "Small square left bracket" sub_def(196) = "Small square right bracket" sub_def(197) = "Small round left bracket" sub_def(198) = "Small round right bracket" sub_def(199) = "Small number 0" sub_def(200) = "Small number 1" sub_def(201) = "Small number 2" sub_def(202) = "Small number 3" sub_def(203) = "Small number 4" sub_def(204) = "Small number 5" sub_def(205) = "Small number 6" sub_def(206) = "Small number 7" sub_def(207) = "Small number 8" sub_def(208) = "Small number 9" sub_def(209) = "Small staff line character" sub_def(210) = "Plus (+) figure" sub_def(211) = "(x) figure" sub_def(212) = "2+ figure" sub_def(213) = "Sharp figure" sub_def(214) = "4+ figure" sub_def(215) = "5+ figure" sub_def(216) = "6/ figure" sub_def(217) = "7\ figure" sub_def(218) = "Natural figure" sub_def(219) = "Flat figure" sub_def(220) = "(-) figure" sub_def(221) = "Tuple 0" sub_def(222) = "Tuple 1" sub_def(223) = "Tuple 2" sub_def(224) = "Tuple 3" sub_def(225) = "Tuple 4" sub_def(226) = "Tuple 5" sub_def(227) = "Tuple 6" sub_def(228) = "Tuple 7" sub_def(229) = "Tuple 8" sub_def(230) = "Tuple 9" sub_def(231) = "Big upright 8" sub_def(232) = "Little upright 8" sub_def(233) = "Big italic 8" sub_def(234) = "Little italic 8" sub_def(235) = "Big italic 15" sub_def(236) = "tr." sub_def(237) = "~~" sub_def(238) = "Mordent" sub_def(239) = "Shake" sub_def(240) = "Shake from above" sub_def(241) = "Shake from below" sub_def(242) = "Turn" sub_def(243) = "Turn" sub_def(244) = " " sub_def(245) = " " sub_def(246) = " " sub_def(247) = " " sub_def(248) = " " sub_def(249) = " " sub_def(250) = "(blank)" sub_def(251) = "Editorial piano" sub_def(252) = "Editorial mezzo" sub_def(253) = "Editorial forte" sub_def(254) = "Editorial trill" sub_def(255) = " " &dA &dA &d@ 6. Messages, and their locations &dA messages(1) = "g = move by group" messages(2) = "j = move by object" messages(3) = "h = move by super object" messages(4) = "x = move consecutively" messages(5) = "Pointing at:" messages(6) = "Line =" message_row(1) = MSGROW1 message_row(2) = MSGROW1 message_row(3) = MSGROW1 message_row(4) = MSGROW1 &dA &dA &d@ 7. Miscellaneous &dA quote = chr(34) ttext = "" loop for i = 1 to 255 music_con(i) = i repeat music_con(102) = 110 /* forte music_con(109) = 109 /* mezzo music_con(112) = 108 /* piano music_con(114) = 113 /* r music_con(115) = 111 /* s music_con(122) = 112 /* z &dA &dA &d@ 8. Screen fonts, and related parameters &dA line = DISP_DISK // ":/zprogs/apps/newscrxx.fnt" open [1,5] line &dA &dA &d@ Parameters used in estimating size of scaling section after a change &dA perform get_hght_dpth len(gstr) = sze read [1,1] gstr j = 1 loop for i = 1 to len(gstr) step 4 FA(j) = ors(gstr{i,4}) ++j repeat close [1] &dA &dA &d@ 9. Spacing parameters for hyphon and underline characters (text font) &dA file = DISP_DISK // ":/musprint/new/xfonts/tms/fontspac" loop for a1 = 1 to 12 open [1,1] file a2 = mtfont - 29 a3 = XFonts(a1,a2) - 50 a4 = Fspacex(a3) - 1 loop for j = 1 to a4 getf [1] repeat getf [1] line hyphspc(a1) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(a1) = int(line{10,2}) close [1] repeat &dA &dA &d@ 10. Beam generation parameters &dA file = DISP_DISK // ":/musprint/new/beams/beamexs" open [1,1] file loop for i = 1 to 435 getf [1] q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for j = 1 to 12 beamext(i,j) = q(j) repeat repeat close [1] &dA &dA &d@ 11. Tie placement parameters &dA loop for a1 = 1 to 12 a2 = nsizes(a1) file = DISP_DISK // ":/musprint/new/ties/tpar" if a2 < 10 file = file // "0" end file = file // chs(a2) if chr(a2) in [6,14,16,18,21] /* &dA01/01/09&d@ size 16 included here else file = file // "x" end file = file // "/" tiefile(1) = file // "td-ns" tiefile(2) = file // "td-nl" tiefile(3) = file // "tu-ns" tiefile(4) = file // "tu-nl" loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to ( TIE_DISTS ) getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(a1,i,j,k) = q(k) repeat repeat close [1] repeat repeat return #endif run &dA &dA &d@ Explanation of Variables &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ &dA &d@ I. Horizontal distance related &dA &dA &d@ olddist(32) = x-value of last object (.) &dA &d@ bolddist(32) = x-value of last object which was typeset (.) &dA &d@ sp = x co-ordinate of line &dA &d@ obx = object x co-ordinate &dA &d@ sobx = sub-object x co-ordinte &dA &d@ sobx2 = optional second value of sobx for "T" text records &dA &d@ saved_sobx2 = old value of sobx2 for "T" text record &dA &d@ x = x co-ordinate for typesetting &dA &d@ x1,x2 = &dA &d@ pdist = horizontal location along staff line &dA &d@ ldist = absolute horizontal location along current line &dA &d@ point = horizontal location along staff at print time &dA &d@ prev_point = previous value of point on this staff line &dA &d@ point_adv = point - prev_point &dA &d@ oldmpoint = value of point at last bar line &dA &d@ oldmp2 = adjusted value of last bar line (first measure) &dA &d@ dxoff(32) = x offset for directive thrown to next line &dA &d@ tdist(32,2) = new values of olddist for parts in a node &dA &d@ rmarg = temporary right margin (usually hxpar(4)) &dA &d@ delta = distance to make up in line expansion &dA &d@ firstbarflag = 0: first bar on a line; 1: subsequent bars on a line (print loop) &dA &d@ pn_left = amount by which part names need to be moved left to avoid a clash &dA &dA &d@ II. Vertical distance related &dA &dA &d@ psq(32) = preliminary (at start) y co-ordinate of line (.) &dA &d@ sq(32) = y co-ordinate of line (.) &dA &d@ vst(32) = y shift (down) to auxiliary staff line (grand staff) &dA &d@ oby = object y co-ordinate &dA &d@ coby = object y co-ordinate (control) &dA &d@ soby = sub-object y co-ordinate &dA &d@ y = y co-ordinate for typesetting &dA &d@ y1,y2 = &dA &d@ savenoby(32) = save variable for oby &dA &d@ dyoff(32) = y offset for directive thrown to next line &dA &dA &d@ III. Record related &dA &dA &d@ rec = next record in file &dA &d@ crec = record number for proper object-node &dA &d@ drec(32) = record number for directive thrown to next line &dA &d@ saverec = place to save current value of rec while browsing &dA &d@ endbarrec = record number for last bar in line + 1 &dA &dA &d@ IV. Counting and space related &dA &dA &d@ marc = number of objects in a measure &dA &d@ larc = number of objects on the line &dA &d@ larc2 = number of objects on extended line &dA &d@ larr(300,MARR_PARS) = distances between proper object nodes on a line &dA &d@ marr(60,MARR_PARS) = distances between objects in measure &dA &d@ (.,1) = distance from previous node &dA &d@ (.,2) = type of node &dA &d@ 14 = clef &dA &d@ 15 = key &dA &d@ 16 = time &dA &d@ 17 = directive, bar, mult-rest, figure, mark &dA &d@ 18 = controlling bar (?) &dA &d@ (.,3) = time number (576 = quarter note) &dA &d@ (.,4) = space node number (max = 6913) (also called snode) &dA &d@ (.,5) = parts active on this node (snode = 6913 only) &dA &d@ (.,6) = space modification flag: &dA &d@ 0 = O.K. to modify spacing in this measure &dA &d@ 1 = don't modify spacings in this measure &dA &d@ (.,7) = temporary data &dA &d@ tarr(32) = temporary array &dA &d@ tarr2(32) = temporary array &dA &d@ tarr3(32) = temporary array &dA &d@ tarr4(32,4) = temporary array introduced to fixed setckt &dA &d@ tarr5(32,2) = temporary array &dA &d@ adjarr(300,4) = collection of distances to add &dA &d@ adjarc = counter for adjarr &dA &d@ small(300) = list of smallest nodes on a line &dA &d@ scnt = counter for small &dA &d@ small2(300) = list of smallest nodes on a line &dA &d@ scnt2 = counter for small2 &dA &d@ barnum = measure number &dA &d@ oldbarnum = measure at beginning of line &dA &d@ newbarnum = measure number for next line &dA &d@ snode = space node number &dA &d@ csnode = space node number (control) &dA &d@ dincf = distance increment flag &dA &d@ cdincf(32) = cumulative distance increment flag for part (.) &dA &d@ ndincf(32) = next distance increment flag for part (.) &dA &d@ barcount = counter for bars on a particular line &dA &d@ barpar(40,3) = measure parameters, first subscript = barcount &dA &d@ (.,1) = length of measure &dA &d@ (.,2) = node number for terminating bar line &dA &d@ (.,3) = type for terminating bar line &dA &d@ sysbarpar(400,5) = parameters relating to the number and size of measures (bars) per system &dA &d@ (.,1) = number of bars per system &dA &d@ (.,2) = extra space on a system before justification &dA &d@ (.,3) = if > 0, this is the max number of bars allowed on this system &dA &d@ (.,4) = extra space, assuming last measure is removed &dA &d@ (.,5) = sys_jflag for this system &dA &d@ oldsysbarpar(.,.) = saving values of sysbarpar 1 and 2 for going back to a previous solution &dA &d@ (.,1) = number of bars per system &dA &d@ (.,2) = extra space on a system before justification &dA &dA &d@ IV. Type related &dA &dA &d@ jtype.1 = type of object &dA &d@ cjtype.1 = type of object (control) &dA &d@ htype.1 = type of super-object &dA &d@ lbyte.1 = type of line "L" or "l" &dA &d@ ntype = field three in an object record &dA &d@ cntype = field three in an object record (control) &dA &dA &d@ V. Super-object related &dA &dA &d@ supernum = super-object number &dA &d@ supermap(32,N_SUPER) = mapping pointer (N_SUPER simultaneous super-objects) &dA &d@ superpnt(32,N_SUPER) = pointer into superdata storage array &dA &d@ superdata(32,N_SUPER,SUPERSIZE) = information for compiling super-object &dA &d@ supcnt = number of super-objects attached to an object &dA &d@ conttie(32) = continued tie flag. Used for setting accidentals &dA &dA &d@ VI. Beam related &dA &dA &d@ beamdata(MAX_BNOTES,2) = data for typesetting beam &dA &d@ beamcode.6(MAX_BNOTES) = beamcode &dA &d@ bcount = number of notes under a beam &dA &d@ beamfont = font for printing beam &dA &d@ beamt = vertical space between beams &dA &d@ beamh = height parameter for beams &dA &d@ stemchar = character number for stem &dA &d@ stem = stem direction flag &dA &dA &d@ VII. Tie related &dA &dA &d@ sitflag = situation flag for ties &dA &d@ tspan = distance spanned by tie &dA &dA &d@ VIII. Text related &dA &dA &d@ textline.232 = working string for text &dA &d@ ttext.80 = text to typeset &dA &d@ xbyte.10(32) = extension byte (-_,.;:!?) (ten of them) &dA &d@ textflag = text present flag &dA &d@ textlen = length of syllable to typeset &dA &d@ backloc(32) = location of first space beyond last syllable &dA &d@ uxstart(32) = x-coord. of first space beyond last syllable &dA &d@ uxstop(32) = x-coordinate of end of line &dA &d@ nuxstop(32) = &dA &dA &d@ IX. Character related &dA &dA &d@ notesize = size of note &dA &d@ maxnotesize = maximum of all notesizes &dA &d@ mtfont = text font number &dA &d@ z = number of character to typeset &dA &d@ cz = number of character to typeset (control) &dA &dA &d@ X. Parameters &dA &dA &d@ hxpar(25) = fixed horizontal spacing parameters &dA &d@ hpar(32,25) = variable horizontal spacing parameters (32 lines max) &dA &d@ vpar(32,41) = variable vertical spacing parameters &dA &d@ vpar20(32) = 10 times notesize (20 claves) &dA &d@ zak(2,6) = accidental placement parameters &dA &dA &d@ XI. Flags &dA &dA &d@ nflg1 = set of parts in node (bits 31--0: parts 1--32) &dA &d@ rflag(40) = global rest in meas(barcount) (# > 0: distance) &dA &d@ endflag = completion flag &dA &d@ f(32,1) = first record in part (.) &dA &d@ f(32,2) = last record in part(.) &dA &d@ f(32,3) = size of clef and key header for part(.) &dA &d@ f(32,4) = record at new line of music for part(.) (bbrec) &dA &d@ f(32,5) = record at new measure of music for part(.)(brec) &dA &d@ f(32,6) = next record to read in part(.) (rec) &dA &d@ f(32,7) = multiple rest counter for part(.) &dA &d@ f(32,8) = completion flag for part(.) &dA &d@ f(32,9) = vertical displacement of text (0 = no text) &dA &d@ f(32,10) = first temporary multiple rest counter &dA &d@ f(32,11) = second temporary multiple rest counter &dA &d@ f(32,12) = staff flag: 0 = normal staff &dA &d@ = 1 = continuo part (no printing of rests) &dA &d@ = 2 = grand staff (auxiliary stave) &dA &d@ f(32,13) = number of levels of text in this file &dA &d@ f(32,14) = notesize &dA &d@ f(32,15) = line flag: 1 = "L" &dA &d@ 2 = "l" &dA &d@ f(32,16) = trans flag (spaging only) &dA &d@ f(32,17) = instrument number (spaging only) &dA &d@ f2 = general rest in extra measure on line &dA &d@ f4 = end of line flag &dA &d@ f5 = bar spitting flag (for types 9 and 10) &dA &d@ f11 = number of parts &dA &d@ f12 = current part number &dA &d@ f13 = first line flag (zero = first line) &dA &d@ music on line &dA &d@ cflag = set: center object in measure (for whole rests) &dA &dA &d@ XII. Music related &dA &dA &d@ key(32) = operative number of sharps (flats) (.) &dA &d@ clef(32,2) = operative clef (.,virtual staff number) &dA &d@ tcode(32) = time signature code (active, if time signature &dA &d@ changes at the end of a line &dA &dA &d@ XIII. Format related &dA &dA &d@ formatflag = formatting options &dA &d@ 0 = don't use or create a format file &dA &d@ 1 = format file exist, use it &dA &d@ 2 = create a new format file &dA &d@ justflag = last line justify options &dA &d@ 0 = do not justify last line, go with first pass &dA &d@ 1 = justify last line using current line configuration &dA &d@ ( < 2 ) = produce output &dA &d@ 2 = last line is to be right justified &dA &d@ 3 = recompute line configuration &dA &dA &d@ XIV. Added for version 3.0 &dA &dA &d@ table Y = pre-output for page files &dA &d@ table F = pre-output to format file &dA &dA &d@ str outfile = page specific output file (special name for safety) &dA &dA &d@ forp = pointer into table F &dA &d@ forpz = size of pre-existing format file &dA &d@ mainyp = main pointer into Y table &dA &d@ sv_mainyp = saved value of main pointer into Y table &dA &d@ y1p,y2p,y3p = pointers in table Y &dA &dA &d@ XV. Added for extended format files &dA &dA &d@ plarr(300,2) = first two elements of the larr array as read from the format file &dA &d@ cum_larr(300,2) = cumulative horizontal distances from first element of larr array &dA &d@ (.,1) = cumulative distance &dA &d@ (.,2) = distance flag: 0 = determined from PRE_DIST &dA &d@ 1 = determined from rflag(.) e.g., G.P. &dA &d@ cum_larrz = size of cum_larr array (can be bigger than larc) &dA &d@ larr_gen(20000) = larr index (1st dim) which helped &dA &d@ to generate the obx of an object record &dA &d@ plarc = counter for plarr &dA &d@ psysnum = system number &dA &d@ edflag = edit flag: bit 0: 1 = edit always on &dA &d@ bit 1: 1 = selectively edit this system &dA &d@ larrx = a larr index &dA &dA &d@ XVI. Added implementing optional staff lines &dA &dA &d@ rest7 = optional rest flag (used in procedure wholerest) &dA &d@ intersys = inter-system vertical space &dA &d@ firstsys = first system flag &dA &d@ f11out = flag indicating the bottom line of system was removed &dA &d@ mnum = measure number of last system to display &dA &d@ bottom_sq = value of sq for bottom staff (initially sq(f11)) &dA &d@ tf11 = temporary value of f11 (used when removing lines) &dA &d@ tsq(.) = temporary values of sq(.) (used when removing lines) &dA &d@ tvst(.) = temporary values of vst(.) (used when removing lines) &dA &d@ tnotesize(.) = temporary values of notesizes(.) (used when removing lines) &dA &d@ sys_bottom = y-value of system bottom (initially sq(f11) + vst(f11)) &dA &dA &d@ XVII. Added implementing tag records &dA &dA &d@ str abbr.40(.) = abbreviated part names &dA &d@ abbr_cnt = counter into abbr &dA &d@ recflag(100000) = record flags: 0xff: if non-zero, this is pointer to abbr part name &dA &d@ 0xff00: 0 = normal print rules &dA &d@ 1 = tag as type-1 record &dA &d@ 2 = tag as type-2 record &dA &d@ current_recf = current value of rec flag &dA &d@ type1_dflag(32) = type 1 delete flag: initially set to on, then turned off &dA &d@ type2_dflag(32) = type 2 delete flag: initially set to off, then turned on &dA &dA &dA &dA &dA &d@ Variable Vertical Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ vpar(.,1) = one vertical note space &dA &d@ vpar(.,2) = two " " spaces &dA &d@ vpar(.,3) = three " " " &dA &d@ vpar(.,4) = four " " " &dA &d@ vpar(.,5) = five " " " &dA &d@ vpar(.,6) = six " " " &dA &d@ vpar(.,7) = seven " " " &dA &d@ vpar(.,8) = eight " " " &dA &d@ vpar(.,9) = nine " " " &dA &d@ vpar(.,10) = ten " " " &dA &d@ vpar(.,11) = vertical distance below staff line with text &dA &d@ vpar(.,12) = vertical shift for printing two or more beams &dA &d@ vpar(.,13) = not used &dA &d@ vpar(.,14) = vertical distance below staff line without text &dA &d@ vpar(.,15) = vert. shift for printing italic 8 under treble clef &dA &d@ vpar(.,16) = height parameter for beams &dA &d@ vpar(.,17) = decrease in vpar(16) when range of notes exceeds vpar(3) &dA &d@ vpar(.,18) = cutoff of severe up-down pattern under beam &dA &d@ vpar(.,19) = maximum rise in beam character &dA &d@ vpar(.,20) = amount to add to beam height to get stradle &dA &d@ vpar(.,21) = cutoff for shifting beams to middle of next line &dA &d@ vpar(.,22) = fudge factor for two/more slanted beams on staff lines &dA &d@ vpar(.,23) = fudge factor for one slanted beam on staff lines &dA &d@ vpar(.,24) = maximum rise allowed for beam on one staff line &dA &d@ vpar(.,25) = minimum rise allowed for beam crossing two staff lines &dA &d@ vpar(.,26) = minimum rise allowed for beam crossing three staff lines &dA &d@ vpar(.,27) = minimum for sum of two stems under 2-note beam &dA &d@ vpar(.,28) = amount to extend stems in case vpar(27) is not reached &dA &d@ vpar(.,29) = minimum stem length that triggers adding to 16th stem &dA &d@ vpar(.,30) = adjustment for raising 16th beams because of short stems &dA &d@ vpar(.,31) through vpar(34): beam spacing parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ vpar(.,31) = beam thickness &dA &d@ vpar(.,32) = offset between beams (if two or three) &dA &d@ vpar(.,33) = offset between beams (if more than three in staff line) &dA &d@ vpar(.,34) = amount by which a hanging beam exceeds line height &dA &dA &d@ Beam and line parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ Note Beam Beam large Hang Line &dA &d@ size width offset offset delta width &dA &d@ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ &dA &d@ 12 7 10 11 1 1 &dA &d@ 14 8 11 12 1 1 &dA &d@ 16 9 13 14 1 1 &dA &d@ 18 10 14 16 1 1 &dA &d@ 20 11 16 17 1 1 &dA &d@ 22 12 18 19 2 2 &dA &d@ 24 13 19 21 2 2 &dA &d@ 26 14 21 23 2 2 &dA &d@ 28 15 22 24 2 2 &dA &d@ 30 16 24 26 3 2 &dA &dA &dA &d@ Beam and line parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ (actual values) &dA &dA &d@ Note Beam Beam large Hang Line &dA &d@ size width offset offset delta width &dA &d@ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ &dA &d@ 6 3 6 6 1 1 &dA &d@ 14 8 11 12 1 1 &dA &d@ 16 9 13 14 1 1 &dA &d@ 18 10 14 16 1 1 &dA &d@ 21 12 17 18 2 3 &dA &dA &dA &d@ vpar(.,35) = maximum beam slope for short beams &dA &d@ vpar(.,36) = vertical location of level 1 of figures &dA &d@ vpar(.,37) = height of figures &dA &d@ vpar(.,38) = height of tuplet numbers &dA &d@ vpar(.,39) = placement of tuplet numbers above notes or beams &dA &d@ vpar(.,40) = bracket shift, when combined with tuplets &dA &d@ vpar(.,41) = thickness of staff line (1 for notesize = 14, etc.) &dA &dA &dA &dA &d@ Fixed Horizontal Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ hxpar(1) = length of standard beam character &dA &d@ hxpar(2) = shift after key signature &dA &d@ hxpar(3) = left margin for staff lines &dA &d@ hxpar(4) = left margin + length of staff lines &dA &d@ hxpar(5) = increment after key signature for lines 2 ... &dA &d@ hxpar(6) = minimum space taken up by whole measure rest &dA &d@ hxpar(7) = shift after bar line &dA &d@ hxpar(8) = location for starting - or _ on new line (run time set) &dA &d@ hxpar(9) = indent margin for first line &dA &d@ hxpar(10) = distance from beginning of staff line to first character &dA &d@ hxpar(11) = shift forward to print double bar at beginning of line &dA &d@ hxpar(12) = shift following common or cut time signature &dA &d@ hxpar(13) = shift after time signature &dA &d@ hxpar(14) = minimum extra shift after note with stem-up flag (hpar(28) in autoset) &dA &d@ hxpar(15) = maximum value of hpar(.,15): shift after big clef sign &dA &d@ hxpar(16) = maximum value of hpar(.,16) &dA &d@ hxpar(17) = maximum value of hpar(.,17): heavy/light spacing + thickness of light line &dA &d@ hxpar(18) = maximum value of hpar(.,18): shift back to print double dot repeat &dA &d@ hxpar(19) = maximum value of hpar(.,19): shift for large number &dA &d@ hxpar(20) = maximum value of hpar(.,20): half shift for large number &dA &d@ hxpar(21) = maximum value of hpar(.,21): shift to middle of double digit time signature &dA &d@ hxpar(22) = maximum value of hpar(.,22): shift to middle of single digit time signature &dA &dA &d@ Variable Horizontal Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ hpar(.,1) = pseudo distance of continuation tie &dA &d@ hpar(.,2) = overhang of underline past x-position of last note &dA &d@ hpar(.,3) = skip before starting an underline &dA &d@ hpar(.,4) = minimum space between underline and following syllable &dA &d@ hpar(.,5) = horizontal shift for printing small italic 8 under treble clef &dA &d@ hpar(.,6) = shift following sharp or natural in key signature &dA &d@ hpar(.,7) = shift following flat in key signature &dA &d@ hpar(.,8) = width of quarter note, minus thickness of stem &dA &d@ hpar(.,9) = olddist adjustment following common/cut time on new line &dA &d@ hpar(.,10) = shift following time number &dA &d@ hpar(.,11) = shift following double dot or double bar &dA &d@ hpar(.,12) = approximate width of grace note &dA &d@ hpar(.,13) = shift to commom time signature on new line &dA &d@ hpar(.,14) = pseudo distance of continuation slur &dA &d@ hpar(.,15) = shift after big clef sign &dA &d@ hpar(.,16) = thickness of heavy vertical line - thickness of light vertical line + 1 &dA &d@ hpar(.,17) = heavy/light spacing + thickness of light line &dA &d@ hpar(.,18) = shift back to print double dot repeat &dA &d@ hpar(.,19) = shift for large number &dA &d@ hpar(.,20) = half shift for large number &dA &d@ hpar(.,21) = shift to middle of double digit time signature &dA &d@ hpar(.,22) = shift to middle of single digit time signature &dA &d@ hpar(.,23) = right shift of continuo figures placed above notes &dA &d@ &dA &dA &d@ Line and measure arrays &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ larr(.,1) = distance between this proper object node and the &dA &d@ previous proper object node &dA &d@ larr(.,2) = smallest object type for objects in this object node &dA &dA &d@ Type # object &dA &d@ ÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 1 256th note &dA &d@ 2 128th " &dA &d@ 3 64th " &dA &d@ 4 32nd " &dA &d@ 5 16th " &dA &d@ 6 eighth " &dA &d@ 7 quarter " &dA &d@ 8 half " &dA &d@ 9 whole " &dA &d@ 10 breve " &dA &d@ 11 longa " &dA &d@ 12 extended rest &dA &d@ 13 whole measure rest &dA &d@ 14 clef signature &dA &d@ 15 key signature &dA &d@ 16 time signature &dA &d@ 17 other objects,directives &dA &d@ 18 bar line &dA &d@ 21-31 syncopated note &dA &d@ 40 conflicting n-tuple &dA &dA &d@ larr(.,3) = recomputed distance increment flag for this node &dA &d@ larr(.,4) = space node number for this node &dA &d@ larr(.,5) = parts active on this node (for snode = 6913 only) &dA &d@ larr(.,6) = space modification flag: New &dA05/25/03 &dA &d@ 0 = O.K. to modify spacing in this measure &dA &d@ 1 = don't modify spacings in this measure &dA &dA &d@ Space adjustment array &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ adjarr(.,1) = number in larr array &dA &d@ adjarr(.,2) = maximum possible distance to add &dA &d@ adjarr(.,3) = current largest distance for node of this type &dA &d@ adjarr(.,4) = final distance to add to node &dA &dA &dA &dA &d@ Explanation of Variables brought over from ESKPAGE &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ &dA &d@ I. Horizontal distance related &dA &dA &d@ esksp = x co-ordinate of line &dA &d@ obx = object x co-ordinate &dA &d@ sobx = sub-object x co-ordinte &dA &d@ x = x co-ordinate for typesetting &dA &d@ x1,x2 = &dA &d@ postx = post adjustment to x co-ordinate after automatic computation of position &dA &dA &d@ II. Vertical distance related &dA &dA &d@ esksq(32) = y co-ordinate of line (.) &dA &d@ eskvst(32) = y displacement to virtual staff (if present, 0 otherwise) &dA &d@ oby = object y co-ordinate &dA &d@ soby = sub-object y co-ordinate &dA &d@ y = y co-ordinate for typesetting &dA &d@ y1,y2 = &dA &d@ eskdyoff(10) = y offset for directive thrown to next line &dA &d@ posty = post adjustment to y co-ordinate after automatic computation of position &dA &d@ figoff(32) = additional off-set for figured harmony &dA &d@ nsz(32) = notesize for each staff line in a system &dA &d@ govstaff = staff number whose notesize should be used &dA &d@ for printing the left system bar, etc. &dA &d@ savensz = temporary variable for saving notesize &dA &dA &d@ III. Record related &dA &dA &d@ eskrec = next record in file &dA &d@ esksaverec = place to save current value of rec while browsing &dA &dA &d@ IV. Counting and space related &dA &dA &d@ tarr(32) = temporary array &dA &d@ (1) = length of measure &dA &d@ (2) = node number for terminating bar line &dA &d@ (3) = type for terminating bar line &dA &dA &d@ IV. Type related &dA &dA &d@ jtype.1 = type of object &dA &d@ htype.1 = type of super-object &dA &d@ stave_type = type of line: 0 = "L" or 1 = "l" &dA &d@ ntype = field three in an object record &dA &dA &d@ V. Super-object related &dA &dA &d@ supernum = super-object number &dA &d@ esksupermap(50) = mapping pointer (SUPERMAX simultaneous super-objects) &dA &d@ esksuperpnt(50) = pointer into esksuperdata storage array &dA &d@ esksuperdata(50,128) = information for compiling super-object SUPERMAX SUPERSIZE &dA &d@ supcnt = number of super-objects attached to an object &dA &dA &d@ VI. Beam related &dA &dA &d@ beamdata(32,2) = data for typesetting beam MAX_BNOTES &dA &d@ beamcode.6(32) = beamcode MAX_BNOTES &dA &d@ bcount = number of notes under a beam &dA &d@ beamfont = font for printing beam &dA &d@ bthick = thickness of beamfont - 1 &dA &d@ beamt = vertical space between beams &dA &d@ beamh = height parameter for beams &dA &d@ beamfy = y co-ordinate of first note under beam &dA &d@ qwid = width of quarter note &dA &d@ stem = stem direction flag &dA &d@ stemchar = character number for stem &dA &d@ tupldata(7) = data for typesetting tuplet at beam time &dA &d@ tbflag = flag for setting tuplet with beam &dA &d@ beamext(435,12) = parameters for beam extension &dA &d@ eskhpar(59) = white space on either side of repeater beam &dA &dA &d@ VII. Tie related &dA &dA &d@ hd = horizontal displacement of tie from first note &dA &d@ vd = vertical displacement of tie from first note &dA &d@ tiechar = tie character &dA &d@ tpost_x = post adjustment to left x position &dA &d@ tpost_y = post adjustment to y position &dA &d@ tpost_leng = post adjustment to right x position &dA &d@ sitflag = situation flag for ties &dA &d@ tcnt = counter for extending ties &dA &d@ tspan = distance spanned by tie &dA &d@ expar(8) = extension parameters for ties &dA &d@ textend = tie extension character &dA &d@ tiefile(4) = names of the four tie extension files &dA &d@ tiearr(#,4,#,12) = parameters for choosing ties (for three notesizes 14, 21, 6) &dA &d@ eskhpar(60) = length beyond which ties for C5,D5 (tips up) and &dA &d@ A4,G4 (tips down) are no longer constrained by &dA &d@ staff lines &dA &d@ eskhpar(61) = smallest distance between notes for which a tie may be printed &dA &d@ eskhpar(62) = distance increment in tiearr data &dA &d@ eskhpar(63) = last tie glyph number for a complete tie (longer ties are divided) &dA &dA &d@ VIII. Text related &dA &dA &d@ textline.232 = working string for text &dA &d@ ttext.80 = text to typeset &dA &d@ ntext = number of text lines for a particular music line &dA &d@ tlevel = level number for line of text (field 3 of TEXT sub-object) &dA &d@ eskxbyte.1(10) = extension byte (-_,.;:!?) (ten strophies) &dA &d@ eskbackloc(10) = location of first space beyond last syllable &dA &d@ ibackloc(10) = backloc(.) read from L record &dA &d@ eskuxstart(10) = x-coord. of first space beyond last syllable &dA &d@ eskuxstop(10) = x-coordinate of end of underline &dA &d@ buxstop(10) = eskuxstop at bar line &dA &dA &d@ IX. Character related &dA &dA &d@ hyphspc(12) = space for text hyphon &dA &d@ underspc(12) = space for text underline character &dA &d@ urpos(256) = vertical offsets for music font characters (basic units) &dA &d@ pos(256) = vertical offsets for music font characters (notesize included) &dA &d@ notesize = size of note &dA &d@ z = number of character to typeset &dA &d@ z1,z3,z3 = &dA &dA &d@ X. Parameters &dA &dA &d@ eskhpar(63) = horizontal spacing parameters &dA &d@ eskvpar(45) = vertical spacing parameters &dA &d@ wak(9) = character extension values (upper range) &dA &dA &d@ XI. Flags &dA &dA &d@ eskf(32,*) = vertical position (offset) of line * of text &dA &d@ f01 = page number &dA &d@ f03 = page counter &dA &d@ f04 = number of records in table &dA &d@ eskf11 = number of parts &dA &d@ eskf12 = current part number &dA &d@ underflag = execution flag for setunder &dA &dA &d@ XII. Variables related to editing &dA &dA &d@ list_order(.,.) = link information for entries in table &dA &d@ (1) previous entry in table &dA &d@ (2) next entry in table &dA &d@ (3) modified printing flag &dA &d@ 0 = skip record &dA &d@ -1 = use record &dA &d@ (4) >0 = index to alternate record &dA &d@ (5) copy of (3); used to make save command work properly &dA &d@ &dA &d@ pointers(.,.) = pointers relating to objects &dA &d@ (1) pointer back to object in table (record pointer) &dA &d@ (2) second pointer (barlines) &dA &d@ (3) pointer to next object in line (index in pointers array) &dA &d@ (4) pointer to previous object in line (index in pointers array) &dA &d@ (5) pointer to object above (index in pointers array) &dA &d@ (6) pointer to object below (index in pointers array) &dA &d@ (7) pointer to line record (record pointer) &dA &d@ (8) pointer to system record (record pointer) &dA &d@ (9) modified node number &dA &d@ (10) larr index that helped generate obx &dA &d@ &dA &d@ super_pointers(.,.) = pointers relating to super-objects &dA &d@ (1) pointer back to super-object in table (record pointer) &dA &d@ (2) second pointer &dA &d@ (3) pointer into array containing lists of objects (related_objects()) &dA &d@ (4) number of objects related to this super_object &dA &d@ &dA &d@ related_objects(.) = (table) addresses of objects connected to super-objects &dA &d@ &dA &d@ nodelist(.,.) = list of node numbers and corresponding index in pointers array &dA &d@ numbers for a system &dA &d@ (1) node number &dA &d@ (2) index in pointers array &dA &d@ &dA &d@ temp_store_ob(.,.) = list of objects having super objects &dA &d@ (1) object address in table &dA &d@ (2) super-object number &dA &d@ &dA &d@ barlinks(.) = list of bar objects in a system &dA &d@ barlink_cnt = counter into barlinks list &dA &d@ system_rec(.) = pointers to system records in X table &dA &d@ system_cnt = number of systems on page &dA &d@ object_count = number of objects on the page &dA &d@ super_count = number of super-objects on the page &dA &d@ nodenum = object node number &dA &d@ curnode = modified-node-number (includes measure number) &dA &d@ savecurnode = first modified-node-number in a group &dA &d@ xsavecurnode = index in pointers array of first node in group &dA &d@ xbacknode = index in pointers array of first node in previous group &dA &d@ xupnode = index in pointers array of node in line above this group &dA &d@ measnum = measure number in line &dA &d@ linepoint = record number of last line record &dA &d@ syspoint = record number of last system record &dA &d@ trigger = flag for recognizing new measure in line &dA &d@ obcursor = run-time pointer into pointers() array (location of cursor) &dA &d@ supercursor = run-time pointer into super_pointers() array (location of cursor) &dA &dA &dA &dA &dA &d@ Vertical Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ eskvpar(1) = one vertical note space &dA &d@ eskvpar(2) = two " " spaces &dA &d@ eskvpar(3) = three " " " &dA &d@ eskvpar(4) = four " " " &dA &d@ eskvpar(5) = five " " " &dA &d@ eskvpar(6) = six " " " &dA &d@ eskvpar(7) = seven " " " &dA &d@ eskvpar(8) = eight " " " &dA &d@ eskvpar(9) = nine " " " &dA &d@ eskvpar(10) = ten " " " &dA &d@ eskvpar(11) = vertical distance below staff line with text &dA &d@ eskvpar(12) = vertical shift for printing two or more beams &dA &d@ eskvpar(13) = vertical shift for printing ___ &dA &d@ eskvpar(14) = vertical distance below staff line without text &dA &d@ eskvpar(15) = vert. shift for printing italic 8 under treble clef &dA &d@ eskvpar(16) = height parameter for beams &dA &d@ eskvpar(17) = decrease in eskvpar(16) when range of notes exceeds eskvpar(3) &dA &d@ eskvpar(18) = cutoff of wevere up-down pattern under beam &dA &d@ eskvpar(19) = maximum rise in beam character &dA &d@ eskvpar(20) = amount to add to beam height to get stradle &dA &d@ eskvpar(21) = cutoff for shifting beams to middle of next line &dA &d@ eskvpar(22) = fudge factor for two/more slanted beams on staff lines &dA &d@ eskvpar(23) = fudge factor for one slanted beam on staff lines &dA &d@ eskvpar(24) = maximum rise allowed for beam on one staff line &dA &d@ eskvpar(25) = minimum rise allowed for beam crossing two staff lines &dA &d@ eskvpar(26) = minimum rise allowed for beam crossing three staff lines &dA &d@ eskvpar(27) = minimum for sum of two stems under 2-note beam &dA &d@ eskvpar(28) = amount to extend stems in case vpar(27) is not reached &dA &d@ eskvpar(29) = minimum stem length that triggers adding to 16th stem &dA &d@ eskvpar(30) = adjustment for raising 16th beams because of short stems &dA &d@ eskvpar(31) through vpar(34): beam spacing parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ eskvpar(31) = beam thickness &dA &d@ eskvpar(32) = offset between beams (if two or three) &dA &d@ eskvpar(33) = offset between beams (if more than three in staff line) &dA &d@ eskvpar(34) = amount by which a hanging beam exceeds line height &dA &dA &d@ Beam and line parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ Note Beam Beam large Hang Line &dA &d@ size width offset offset delta width &dA &d@ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ &dA &d@ 12 7 10 11 1 1 &dA &d@ 14 8 11 12 1 1 &dA &d@ 16 9 13 14 1 1 &dA &d@ 18 10 14 16 1 1 &dA &d@ 20 11 16 17 1 1 &dA &d@ 22 12 18 19 2 2 &dA &d@ 24 13 19 21 2 2 &dA &d@ 26 14 21 23 2 2 &dA &d@ 28 15 22 24 2 2 &dA &d@ 30 16 24 26 3 2 &dA &dA &d@ eskvpar(35) = maximum beam slope for short beams &dA &d@ eskvpar(36) = vertical location of level 1 of figures &dA &d@ eskvpar(37) = height of figures &dA &d@ eskvpar(38) = height of tuplet numbers &dA &d@ eskvpar(39) = placement of tuplet numbers above notes or beams &dA &d@ eskvpar(40) = bracket shift, when combined with tuplets &dA &d@ eskvpar(41) = default offset increment (height) of text line &dA &d@ eskvpar(42) = amount to shorten stems protruding into beams &dA &d@ eskvpar(43) = size of vertical shift in display mode &dA &d@ eskvpar(44) = width of staff line &dA &d@ eskvpar(45) = placement of accidentals above trills (vpar(53) in AUTOSET) &dA &dA &dA &d@ Horizontal Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ eskhpar(1) = length of standard beam character &dA &d@ eskhpar(2) = length of beam hook character &dA &d@ eskhpar(3) = width of quarter note (approximately) &dA &d@ eskhpar(4) = back shift before concatination character &dA &d@ eskhpar(5) = approximate width of grace note &dA &d@ eskhpar(6) = hyphon spacing parameter (1/3 min distance for two hyp.) &dA &d@ eskhpar(7) = overhang of underline past x-position of last note &dA &d@ eskhpar(8) = left margin for staff lines &dA &d@ eskhpar(9) = left margin + length of staff lines &dA &d@ eskhpar(10) = increment after key signature for lines 2 ... &dA &d@ eskhpar(11) = minimum space taken up by whole measure rest &dA &d@ eskhpar(12) = amount by which a whole measure rest can be enlarged &dA &d@ eskhpar(13) = distance between bar and multiple rest (run time set) &dA &d@ eskhpar(14) = pseudo distance of continuation tie &dA &d@ eskhpar(15) = (no longer used; replaced by ibackloc(.) ) &dA &d@ eskhpar(16) = shift after bar line &dA &d@ eskhpar(17) = minimum space for hyphon &dA &d@ eskhpar(18) = minimum space for underline &dA &d@ eskhpar(19) = skip before starting an underline &dA &d@ eskhpar(20) = minimum space between underline and following syllable &dA &d@ eskhpar(21) = indent margin for first line &dA &d@ eskhpar(22) = not used &dA &d@ eskhpar(23) = not used &dA &d@ eskhpar(24) = not used &dA &d@ eskhpar(25) = not used &dA &d@ eskhpar(26) = not used &dA &d@ eskhpar(27) = not used &dA &d@ eskhpar(28) = not used &dA &d@ eskhpar(29) = thickness of stem &dA &d@ eskhpar(30) = backward shift for printing backward hook &dA &d@ eskhpar(31) = olddist adjustment following common/cut time on new line &dA &d@ eskhpar(32) = shift following time number &dA &d@ eskhpar(33) = thickness of heavy vertical line - thickness of light vertical line + 1 &dA &d@ eskhpar(34) = heavy/light spacing + thickness of light line &dA &d@ eskhpar(35) = shift back to print double dot repeat &dA &d@ eskhpar(36) = shift forward to print double dot repeat &dA &d@ eskhpar(37) = shift forward to print double bar at beginning of line &dA &d@ eskhpar(38) = shift following double dot or double bar &dA &d@ eskhpar(39) = minimum wedge length &dA &d@ eskhpar(40) = length of trill extension character &dA &d@ eskhpar(41) = advance after tr. character &dA &d@ eskhpar(42) = width of 8av character &dA &d@ eskhpar(43) = shift in printing dash character (font dependent) &dA &d@ eskhpar(44) = length of figure line generation character &dA &d@ eskhpar(45) = width of tuplet number &dA &d@ eskhpar(46) = backshift for heavy vertical brace &dA &d@ eskhpar(47) = backshift for bracket &dA &d@ eskhpar(48) = space between double light bar lines + thickness of light line &dA &d@ eskhpar(49) = shift for large number &dA &d@ eskhpar(50) = half shift for large number &dA &d@ eskhpar(51) = shift to middle of double digit time signature &dA &d@ eskhpar(52) = shift to middle of single digit time signature &dA &d@ eskhpar(53) = shift following common or cut time signature &dA &d@ eskhpar(54) = shift after time signature &dA &d@ eskhpar(55) = shift to commom time signature on new line &dA &d@ eskhpar(56) = distance from end of continuation line to bar at end of line &dA &d@ eskhpar(57) = same as above, but for case where line does not continue in next system &dA &d@ eskhpar(58) = size of horizontal shift in display mode &dA &d@ eskhpar(59) = white space on either side of a repeater beam &dA &d@ eskhpar(60) = special case tie length for C5,D5 (tips up) and A4,G4 (tips down) &dA &d@ eskhpar(61) = smallest distance between notes for which a tie may be printed &dA &d@ eskhpar(62) = distance increment in tiearr data &dA &d@ eskhpar(63) = last tie glyph number for a complete tie (longer ties are divided) &dA &dA &dA &d@ Line and measure arrays &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ Type # object &dA &d@ ÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 1 256th note &dA &d@ 2 128th " &dA &d@ 3 64th " &dA &d@ 4 32nd " &dA &d@ 5 16th " &dA &d@ 6 eighth " &dA &d@ 7 quarter " &dA &d@ 8 half " &dA &d@ 9 whole " &dA &d@ 10 breve " &dA &d@ 11 longa " &dA &d@ 12 extended rest &dA &d@ 13 whole measure rest &dA &d@ 14 clef signature &dA &d@ 15 key signature &dA &d@ 16 time signature &dA &d@ 17 other objects,directives &dA &d@ 18 bar line &dA &d@ 21-31 syncopated note &dA &d@ 40 conflicting n-tuple &dA &dA &dA &dA &dA &d@ Explanation of Variables for NEWFONTS &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ nsizes(12) = The 12 available note sizes &dA &d@ only sizes 3 [06], 8 [14], and 11 [21] are currently available &dA &d@ revsizes(24) = The reverse map to nsizes &dA &d@ XFonts(12,19) = The number of 10s and the 6 x 3 (sizes, styles) for each notesize &dA &d@ XFontstr.76(12) = XFont data in string form &dA &d@ Fspacex(90) = index from (TMS font number - 50) to record in fontspac(.) &dA &d@ wedgefont(24) = font number for wedges for each notesize &dA &d@ scfont(24) = fixed pitch font number for each notesize &dA &dA &dA