&dA &dA &d@ &dE ÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿ &dA &d@ &dE ³ MSKPAGE.Z ³ &dA &d@ &dE ÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ &dA &dA &d@ Program to assemble linear i-files &dA &d@ into sets of systems for page specific output &dA &dA &d@ Version 3.0 (rev. 12/04/03) &dA &dA &d@ This program will handle up to thirty-two parts in score format. &dA &d@ The program asks for the location and number of parts. The &dA &d@ program reads these files into a large table. The program &dA &d@ then works its way through the table one measure at a time, &dA &d@ following all the parts and stopping at the next bar line after &dA &d@ the music line gets full. The program then right justifies the &dA &d@ lines. Output is a set of intermediate proof files, one for &dA &d@ each page. &dA &dA &d@ This program is being revised (06/28/93) to accommodate parts &dA &d@ which write to two staves. &dA &dA &d@ Revision &dA11-11-93&d@: Program revised to take into account &dA &d@ attribute type sub-objects (A). This is basically a pass-through &dA &d@ process. &dA &dA &d@ Revision &dA03-13-94&d@: Size of superdata array increased to accommodate &dA &d@ many notes under a beam. Former size of third dimension was 24. This &dA &d@ meant that the maximum number of notes was 12. The third dimension is &dA &d@ now set by the defined variable SUPERSIZE (set below). SUPERSIZE must &dA &d@ be twice the number of notes to be accomodated. Also, it appears that &dA &d@ certain array variables related to the production of beams must have &dA &d@ one of their dimensions increased. The new dimension will be defined &dA &d@ as MAX_BNOTES. &dA &dA &d@ Revision &dA04-25-94&d@: Adding a feature where mskpage will look for a &dA &d@ directory called &dKformats&d@, in which (if it is there) might be found &dA &d@ the answers to the questions mskpage asks about the format of the &dA &d@ full page. &dA &dA &d@ Revision &dA04-26-94&d@: Adding a feature that would let the user specify &dA &d@ that the last line be right justified. &dA &dA &d@ Revision &dA05-04-94&d@: Adding a feature that would allow mixed stem &dA &d@ directions on the same staff. &dA &dA &d@ Revision &dA01-01-95&d@: Program can be used to generate versions for &dA &d@ different size notes. &dA &dA &d@ Revision &dA04-24-95&d@: Program can deal with staff line separations &dA &d@ which are odd (e.g., 17, 19, 21, etc.) &dA &dA &d@ Revision &dA12-19-95&d@: For some reason, there was a really screwball &dA &d@ way of handling clef/key/time compbinations in the procedure setckt. &dA &d@ The result was that keyboard music mixed with other parts would not &dA &d@ print. I have tried to remedy this problem by adding a new variable &dA &d@ tarr4(32,4). Since I don't really understand what was going on, and &dA &d@ since there might (???) have been some reason for the screwball &dA &d@ code, I have written a remedy that appears to be neutral in relation &dA &d@ to how the program probably worked before with single parts. Let's &dA &d@ hope it works! &dA &dA &d@ Revision &dA09-27-96&d@: MSKPAGE gets indigestion when a clef sign follows &dA &d@ a time signature or a key change after a bar line. This is because &dA &d@ the usual order is Clef,Key,Time. I have attempted to fix this by &dA &d@ allowing the combination Clef,Key,Time,Clef. Since I don't know &dA &d@ whether this will introduce new problems, I include these changes &dA &d@ under the conditional compile FIX_CKT. &dA &dA &d@ Revision &dA02-23-97&d@: We would like MSKPAGE to deal with the situation &dA &d@ where a measure has a number over it (used in repeated measures). &dA &d@ Normally, this feature is used only in printing parts, but occasionally &dA &d@ we will want to print two parts on two staves, so MSKPAGE would be &dA &d@ used for this. To keep the problem simple, it has been decided that &dA &d@ the number over a measure will be attached as a word-type sub-object &dA &d@ to the bar line that concludes that measure. The x-offset in the &dA &d@ (continuous) i-file will simply be the backup for printing the number(s); &dA &d@ the actual x-offset will have to be computed by MSKPAGE, based on the &dA &d@ new positions of the bar lines. &dA &d@ &dA &d@ Revision &dA02-25-97&d@: We have added a new type of Sub-Object -- the "silent" &dA &d@ Sub-Object (small k, instead of cap K). The purpose is to allow MSKPAGE &dA &d@ to repeat accidentals on tied notes which cross system breaks. I think &dA &d@ the best way to handle this is to keep the silent Sub-Objects in the &dA &d@ file structure and to "activate" them when the notes are on a new system. &dA &d@ Also, we may want to move the x-position of the Object to the left for &dA &d@ those cases where silent Sub-Objects are not activated. This will remove &dA &d@ the extra space that AUTOSET put there. The amount to move left is &dA &d@ the maximum (negative) x offset of the silent Sub_objects, minus the active &dA &d@ notesize. &dA &d@ &dA &d@ Revision &dA12-04-00&d@: Reducing the horizontal and vertical size of pages &dA &d@ typeset with size 6 notes. &dA &d@ &dA &d@ Revision &dA04-23-03&d@: Limiting vertical travel of beams to +/- vpar(3)+1 &dA &d@ &dA &d@ Revision &dA05-14-03&d@: Implementing a print suggestion for modification of &dA &d@ the first stem length of beam. &dA &d@ &dA &d@ Revision &dA05-25-03&d@: Implementing a print suggestion for preventing mskpage &dA &d@ from altering the spacings it computes in a particular measure, when it &dA &d@ is trying to justify a line. Obviously this must be over-ridden when &dA &d@ there is only one measure in the line. &dA &d@ &dA &d@ Revision &dA09-14-03&d@: Adding a 10th field to Line (L) records. From the &dA &d@ standpoint of mskpage, this field is a dummy, and is always set to 0 by &dA &d@ mskpage. Its purpose is to provide an easy way to edit the height of figured &dA &d@ harmonies in page specific files. The field will be recognized by dskpage &dA &d@ and pskpage. &dA &d@ &dA &d@ Revision &dA11-13-03&d@: Adding a compile option CONTINUO. When this is set &dA &d@ to "1", figured harmony will be placed above, rather than below notes. Also &dA &d@ figures will be shifted slightly to the right. &dA &d@ &dA &d@ Revision &dA12-11-03&d@: Tinkering with the way lines are right justified. The &dA &d@ problem under the current method is that sometimes the longer durations get &dA &d@ "short shrift". Also, in the case where there is text, no attempt is made &dA &d@ to even out the spaces of notes of the same duration. &dA &d@ &dA &d@ Revision &dA12-16-03&d@: Merging MSKPAGE and XMSKPAGE into one source. &dA &d@ &dA &d@ Revision &dA12-17-03&d@: Adding an important feature to the Format file. This &dA &d@ will be the larr(.) numbers for each system. When these numbers are present, &dA &d@ and if the user chooses to use them, MSKPAGE can build on past editing work. &dA &d@ &dA &d@ Revision &dA12-19-03&d@: Dealing with the optional value of sobx in Text records. &dA &d@ Basically, the AUTOSET program provides two values of sobx: a &dEpractical&d@ &dA &d@ &dEvalue&d@ for use when notes are compressed, and an &dEideal value&d@ for use when &dA &d@ MSKPAGE has spread notes out somewhat. MSKPAGE needs to make a final &dA &d@ determination of how to use these values. &dA &d@ &dA &d@ Revision &dA12-24-03&d@: Attempting to implement a print suggestion that causes &dA &d@ a staff line of whole rests (in a part) to be omitted from the system. This &dA &d@ involves working with a new symbol type, type = 7, which is a veriant of &dA &d@ type = 9, a whole measure rest. A complete line of "7's" will cause the &dA &d@ staff line to be omitted from the system. This feature is also implemented &dA &d@ using a value of 10001 for the dincf variable (field 8 in the rest object &dA &d@ record) in the case of "moveable" (whole) rests. &dA &d@ &dA &d@ Revision &dA01-06-04&d@: Adding a new record type: Tags (Indentifier = Y) &dA &d@ Tags come in two types: P and U. The P-type tags tell MSKPAGE to append &dA &d@ an abbreviated part name to each staff line for that part (until cancelled) &dA &d@ The U-type tags help MSKPAGE determine when to delete a staff line from &dA &d@ a system. &dA &d@ &dA &d@ Revision &dA01-18-04&d@: There are still things about MSKPAGE that I don't &dA &d@ understand. One feature that continues to be problematic is the typesetting &dA &d@ of musical directions at the end of measures. The "fix" implemented here is &dA &d@ not a solution, but may help the problem. It is additive, that is, it doesn't &dA &d@ change the situation where things were already working; but it does cause a &dA &d@ few things to work that were definitely not working before. &dA &d@ &dA &d@ Revision &dA01-24-04&d@: An old problem surfaced that needed fixing. The Baroque &dA &d@ representation of long-short in triplet mode was causing the getsmall procedure &dA &d@ to fail. The analysis of the problem was carefully done, and I think the fix &dA &d@ is correct. &dA &d@ &dA &d@ Revision &dA03-05-04&d@: DSKPAGE, on occasion, may be asked to display text. In some &dA &d@ cases, the text may need to be right justified. The best &dA &d@ way to do this is to provide for "in-line" space commands. &dA &d@ Since the charaters 131 to 141 are currently unused (and &dA &d@ un-printable) the idea is to implement the following &dA &d@ (internal) representation: &dA &d@ characters 131 to 139 = add 1 (to 9) dots of space &dA &d@ character 140 = subtract one dot of space &dA &d@ character 141 = subtract two dot of space &dA &d@ It should be stressed that this representation is internal &dA &d@ to DSKPAGE. The screen and printer never see these characters; &dA &d@ nor do they ever appear in a file to be displayed or printed. &dA &d@ The in-line commands that generate these characters are as &dA &d@ follows: (these will appear in files to be displayed/printed) &dA &d@ \! = add one dot of space \& = add seven dots of space &dA &d@ \@ = add two dots of space \* = add eight dots of space &dA &d@ \# = add three dots of space \( = add nine dots of space &dA &d@ \$ = add four dots of space \- = subtract one dot of space &dA &d@ \% = add five dots of space \= = subtract two dots of space &dA &d@ \^ = add six dots of space &dA &dA &d@ Revision &dA03-15-04&d@: Implementing a new system for organizing fonts. For the time &dA &d@ being, we will keep the old system and old fonts around. &dA &d@ Code for the new system will appear at #if NEWFONTS &dA &d@ &dA &d@ Revision &dA04-22-04&d@: The new fonts include several new characters in the upper range &dA &d@ (e.g. notes, accidentals, etc.). This necessitates the rewriting &dA &d@ of certain sections of the text output. Also, the new word-join &dA &d@ character contains its own pre-print backup command, removing &dA &d@ the need to use hpar(4). Also, the way dskpage developed &dA &d@ historically, there were two procedures that set text: &dA &d@ setwords and settext. These have already been combined in &dA &d@ the hardcoded DMUSE version, but need to be combined here &dA &d@ as well. &dA &d@ #define XVERSION 0 /* New &dA12/16/03&d@ #define NEWFONTS 1 #define BEAM_OFFSET 12 #define TIE_OFFSET 25 #define LARGE_BRACK 42 #define SMALL_BRACK 43 /* New &dA03/15/04&d@ #define MEAS_SUGG 1 /* New &dA05/25/03&d@ #define FIX_CKT 1 #define NOTEZ 14 #define M_NUM_FONT 37 /* New &dA01/06/04&d@ #define UP 0 #define DOWN 1 #define NAMELEN 17 #define REPORT 0 #define REPORT2 0 #define SUPERSIZE 128 /* changed &dA12/05/03&d@ from 64 #define MAX_BNOTES 32 #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_PARS 6 #define YES 0 #define NO 1 #define TRUE 0 #define FALSE 1 #define ON 0 #define OFF 1 /* New &dA05/25/03&d@ #define OPT_INST 0 /* New &dA08/24/03&d@ #define CONTINUO 0 /* New &dA11/13/03&d@ *process X &dA &dA &d@ #define statements brought over from ESKPAGE &dA &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 /* changed &dA03/15/04&d@ from 4 to 12 #define TIE_DISTS 200 #define DOT_CHAR 44 #define HOMEDIR "C:\RELEASE\PROGS" #define MACFILE "MSKMAC.K" &dA &dA &dA str file.80,line.280,line2.180,temp.180,temp2.180,temp3.180,temp1.180,bigline.1000 str inlib.100,tline.180,outlib.100 str ttext.80,linepiece.180(5) str jtype.1,htype.1,xbyte.10(32),cjtype.1 str beamcode.6(MAX_BNOTES),syscode.50,superline.180,savesyscode.50 str formatfile.100 int ldist,larr(300,MARR_PARS),marr(60,MARR_PARS),larc,marc,tarr(32) /* New &dA05/25/03 int tarr2(32),tarr3(32),tarr4(32,4),tarr5(32,2) int tdist(32,2),nflg1,rflag(40),barcount,barpar(40,3) 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 /* New &dA12/19/03 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 df int @a,@b,@c,@d,@e,@k,@m,@q,@r int a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 int c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16 int f(32,14),f2,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 superdata(32,8,SUPERSIZE),supermap(32,8),superpnt(32,8) 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 /* New &dA12/19/03 int sitflag,tspan int page,sysh,syslen,sysy,gbar(2),gbarflag,tplace int w(32) int olddist(32),bolddist(32),obx,dvar1,dvar2,dv3,olddv1(32),cdv int oldcdv,cdv_adv,backtxobrec /* New &dA12/19/03 int lpt int firstbarflag int spc(255), curfont int start_beam(2),stop_beam(2) table Z(300000) &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,4) int old_sysbarpar(400,2) int savec int mspace(2000),mcnt int deadspace,lastk int old_extra,average_extra int start_look 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 &dA02/25/97&d@ &dA str temp4.20 int conttie(32) int trec &dA &dA &d@ Variable added to deal with measures that are not fungable space-wise New &dA05/25/03 &dA int adj_space int small2(300),scnt2 int single_meas &dA &dA &d@ Variables added for 3.0 version &dA str outfile.80 int forp,forpz int mainyp,sv_mainyp int y1p,y2p,y3p int pn_left table F(1000) table Y(300000) table T(30000) real rx,ry,rz &dA &dA &d@ Variables added for extended format files &dA int plarr(300,2),cum_larr(300,2),larr_gen(20000),cum_larrz int plarc,psysnum,edflag,larrx,cum_x,barcum_x &dA &dA &d@ Variables added for implementing optional staff lines (&dA12/24/03&d@) &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 (&dA01/06/04&d@) &dA str abbr.20(200) int recflag(100000),abbr_cnt,current_recf int type1_dflag(32),type2_dflag(32) &dA &dA &d@ Variables added for dealing with NEWFONTS &dA03/15/04&d@ &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@ &dE &dA &d@ &dE Variables transferred from ESKPAGE &dA &d@ &dE &dA #if XVERSION str tiefile.80(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) /* &dA03/15/04&d@ spc(.) changed from 3 to 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 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(650000) int activefont str gstr.2800000,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) /* expanded size &dA03/15/04&d@ int incre,textoff int aa,gg,hh str ttline.120 &dA &dA &d@ variables added for macros &dA11/25/03&d@ &dA str macfile.80 int macros(8,100),macstrokes(8),macchange int macropnt(8) #endif &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 /* New &dA12/19/03 &dA &d@ saved_sobx2 = old value of sobx2 for "T" text record /* New &dA12/19/03 &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 /* New &dA12/19/03 &dA &d@ point_adv = point - prev_point /* New &dA12/19/03 &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 New &dA05/25/03 &dA &d@ marr(60,MARR_PARS) = distances between objects in measure New &dA05/25/03 &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@ 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 (&dA12-19-94&d@) &dA &d@ tarr5(32,2) = temporary array (&dA12/11/03&d@) &dA &d@ adjarr(300,4) = collection of distances to add (3rd & 4th dimensions added &dA12/11/03&d@) &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 (when some cannot be used) (&dA05/25/03&d@) &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,4) = 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@ 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@ 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,8) = mapping pointer (8 simultaneous super-objects) &dA &d@ superpnt(32,8) = pointer into superdata storage array &dA &d@ superdata(32,8,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@ 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 &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@ 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@ XII. 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@ XIII. 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@ XIV. 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@ XV. 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@ XVI. 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 mtfont = 31 cdv = 0 /* New &dA12/19/03 backtxobrec = 0 /* New &dA12/19/03 saved_sobx2 = 100 /* New &dA12/19/03 &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@ (tentative values) &dA &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@ 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 New &dA11/13/03 &dA &d@ govstaff = staff number whose notesize should be used New &dA11/13/03 &dA &d@ for printing the left system bar, etc. &dA &d@ savensz = temporary variable for saving notesize New &dA11/13/03 &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@ 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 New &dA08/26/03&d@ &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 (notesizes: 6, 14, 21 --> 3, 8, 11) &dA03/15/04 &dA &d@ underspc(12) = space for text underline character (notesizes: 6, 14, 21 --> 3, 8, 11) &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 (added &dA12/06/03&d@) &dA &d@ barlink_cnt = counter into barlinks list (added &dA12/06/03&d@) &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(.) ) New &dA08/26/03 &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) = distance from beginning of staff line to first character &dA &d@ eskhpar(23) = shift after big clef sign &dA &d@ eskhpar(24) = hor. shift for printing small italic 8 under treble clef &dA &d@ eskhpar(25) = not used &dA &d@ eskhpar(26) = not used &dA &d@ eskhpar(27) = shift after key signature &dA &d@ eskhpar(28) = shift if no key signature or key change &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 &dA03/15/04&d@ &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 #if NEWFONTS &dA &dA &dA &d@ &dA03/15/04&d@ Initializing arrays for NEWFONTS &dA 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 &dA &d@ End of &dA03/15/04&d@ addition &dA &dA End of #if NEWFONTS #endif #if XVERSION &dA Starting #if XVERSION &dA &dA &d@ This code added &dA11/25/03&d@ to acquire macro definitions from the MACFILE &dA macchange = 0 macfile = HOMEDIR // "/" // 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 open [9,1] HOMEDIR 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] &dK &d@ loop for a = 1 to 8 &dK &d@ b = macstrokes(a) &dK &d@ putc ~b stokes for F~(a+4) &dK &d@ loop for c = 1 to b &dK &d@ putc 0x0.x ~macros(a,c) &dK &d@ repeat &dK &d@ repeat &dK &d@ getc &dA &dA &d@ &dA &d@ &dA &d@ &dE &dA &d@ &dE Initialization of variables brought over from ESKPAGE &dA &d@ &dE &dA &dA &d@ 1. Shift parameters for music font &dA #if NEWFONTS file = "c:\musprint\new\mfonts\pos3" #else file = "c:\musprint\param\ex\pos3" #endif 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 putc getting fonts . . . ... #if NEWFONTS open [1,5] "c:\zprogs\apps\newscrxx.fnt" #else open [1,5] "c:\zprogs\apps\scrftsxx.fnt" #endif &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] putc done! &dA &dA &d@ 9. Spacing parameters for hyphon and underline characters (text font) &dA #if NEWFONTS file = "c:\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 #else file = "c:\musprint\param\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(8) = int(line{40,2}) /* &dA03/15/04&d@ ndx changed from 1 to 8 getf [1] line getf [1] line getf [1] line underspc(8) = int(line{10,2}) /* &dA03/15/04&d@ ndx changed from 1 to 8 close [1] file = "c:\musprint\param21\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(11) = int(line{40,2}) /* &dA03/15/04&d@ ndx changed from 2 to 11 getf [1] line getf [1] line getf [1] line underspc(11) = int(line{10,2}) /* &dA03/15/04&d@ ndx changed from 2 to 11 close [1] file = "c:\musprint\param06\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(3) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(3) = int(line{10,2}) close [1] #endif &dA &dA &d@ 10. Beam generation parameters &dA #if NEWFONTS file = "c:\musprint\new\beams\beamexs" #else file = "c:\musprint\param\beamexs" #endif 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 #if NEWFONTS loop for a1 = 1 to 12 a2 = nsizes(a1) file = "c:\musprint\new\ties\tpar" if a2 < 10 file = file // "0" end file = file // chs(a2) if chr(a2) in [6,14,18,21] 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 #else file = "c:\musprint\param\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\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(8,i,j,k) = q(k) /* &dA03/15/04&d@ ndx1 changed from 1 to 8 repeat repeat close [1] repeat file = "c:\musprint\param21\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\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(11,i,j,k) = q(k) /* &dA03/15/04&d@ ndx1 changed from 2 to 11 repeat repeat close [1] repeat file = "c:\musprint\param06\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\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(3,i,j,k) = q(k) repeat repeat close [1] repeat #endif &dA &dA &d@ &dE &dA &d@ &dE End of Initialization of parameters &dA &d@ &dE &dA &dA End of #if XVERSION #endif &dI@ I. Initialization &dI@ &dI@S1 1. Questions regarding input and output files, &dI@ and the presence of a format file. &dI@ 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 outlib = ucs(outlib) putc starting number getc a1 putc number of parts getc f11 &dA &dA &d@ Look for format file &dA formatfile = "" formatflag = 0 i = 0 if a1 = 1 open [1,1] temp loop for i = 1 to 100 getf [1] temp2 if temp2{1} = " " if i = f11 + 1 i = 1000 else i = 100 end end repeat close [1] if i = 1000 if temp con "i-files" temp3 = temp{mpt..} temp = temp{1,mpt-2} if temp3 con ['\','/'] temp3 = temp3{mpt+1..} temp3 = trm(temp3) end open [1,1] temp loop for i = 1 to 100 getf [1] temp2 temp2 = lcs(temp2) // pad(7) if temp2{1} = " " i = 100 end if temp2{1,7} = "formats" i = 1000 end repeat close [1] end end end if i = 1000 temp3 = lcs(temp3) temp = temp // "/formats" open [1,1] temp loop for j = 1 to 100 getf [1] temp2 temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = lcs(temp2) if temp2{1} = " " j = 100 end temp2 = trm(temp2) if temp2 = temp3 j = 1000 end repeat close [1] if j = 1000 formatflag = 1 end formatfile = temp // "/" // temp3 end &dI@F1 &dI@S2 2. Transfering input to table memory and &dI@ initializing track-related variables &dI@ &dA &dA &d@ Transfer source files to X table &dA putc transferring ... k = 0 abbr_cnt = 0 /* New &dA01/06/04&d@ loop for f12 = 1 to f11 current_recf = 0 /* New &dA01/06/04&d@ ++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 vst(f12) = int(line{3..}) /* vertical offset to second staff (or 0) if sub <= len(line) f(f12,9) = int(line{sub..}) /* vertical offset to text line end if sub <= len(line) c1 = sub f(f12,14) = int(line{sub..}) /* note size end if sub <= len(line) if line{sub} <> " " f(f12,14) = 0 sub = c1 end line = line{sub..} line = mrt(line) else line = "" end &dA &dA &d@ New &dA08/24/03&d@ &dA #if OPT_INST if line con "[" line = "" end #endif tput [Z,k] ~line recflag(k) = current_recf /* New &dA01/06/04&d@ /* This code insures that the movement name doesn't get printed twice getf [2] line if line{3} = "D" getf [2] line else line = line // pad(80) ++k tput [Z,k] ~line recflag(k) = current_recf /* New &dA01/06/04&d@ end &dA &dA &d@ This code adjusted &dA12/19/03&d@ to accommodate new text record format &dA c1 = 0 loop getf [2] line line = line // " " if line{1} = "T" c2 = int(line{3..}) if line{sub} = "|" /* New &dA12/19/03&d@ c2 = int(line{sub+1..}) end c2 = int(line{sub..}) if c1 < c2 c1 = c2 end end &dA &dA &d@ New code added &dA01/06/04&d@ 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 ++k tput [Z,k] ~line recflag(k) = current_recf /* New &dA01/06/04&d@ every record is now flagged end &dA &d@ End of &dA01/06/04&d@ addition &dK &d@ ++k &dK &d@ tput [Z,k] ~line 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 /* New &dA01/06/04&d@ &dA &dA &d@ initialize superpnt(.,8), supermap(.,8), superdata(.,8,SUPERSIZE) &dA &d@ drec(.), savenoby(.), uxstop(.), nuxstop(.), dxoff(.) &dA &d@ dyoff(.), uxstart(.), backloc(.), xbyte(.) &dA loop for j = 1 to 8 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)} * ++a1 repeat putc done! &dI@F2 &dI@S3 3. Initialize parametric variables &dI@ &dA &dA &d@ initialization &dA &d@ ÍÍÍÍÍÍÍÍÍÍÍÍÍÍ &dA a = 0 b = 0 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 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 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 &dA &d@ &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) = 6 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 repeat &dA &dA &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 < 21 vpar(f12,41) = 1 end if notesize = 21 vpar(f12,41) = 2 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 &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 &dI@F3 &dI@S4 4. Ask questions about format, about tacit &d@ &dI@ instructions and movement name. &dI@ &dA &dA &d@ &dE ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ» &dA &d@ &dE º Prepare for first line of music º &dA &d@ &dE ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ &dA 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 &dK &d@ open [1,2] formatfile end end &dA &dA &d@ &dA12/17/03&d@ Changing slightly the way existing format files are accessed &dA 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 &dA if formatflag = 1 forp = 1 tget [F,forp] line &dK &d@ getf [1] 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 putc Reduced size? (return = no) getc line line = trm(line) if formatflag = 2 ++forp if line = "" tput [F,forp] Reduced size = no &dK &d@ putf [1] Reduced size = no else tput [F,forp] Reduced size = yes &dK &d@ putf [1] Reduced size = yes end end end if line <> "" hxpar(3) = 520 hxpar(4) = 2270 lowerlim = 2400 toplim = 100 else if maxnotesize = 6 /* added &dA12-04-00&d@ lowerlim = 1250 toplim = 60 else lowerlim = 2900 toplim = 140 end end if formatflag = 1 ++forp tget [F,forp] line .t1 i &dK &d@ getf [1] 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 &dK &d@ putf [1] ~line end end if formatflag = 1 ++forp tget [F,forp] line &dK &d@ getf [1] 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 &dK &d@ putf [1] No tacit instructions else tput [F,forp] ~line &dK &d@ putf [1] ~line end end end tacetline = line justflag = 0 if formatflag = 1 ++forp tget [F,forp] line &dK &d@ getf [1] 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 else /* formatflag = 0 or 2 putc Right justify last line? (return = no) getc line line = trm(line) if formatflag = 2 ++forp if line = "" tput [F,forp] Justify = no &dK &d@ putf [1] Justify = no else tput [F,forp] Justify = yes &dK &d@ putf [1] Justify = yes end end if line <> "" justflag = 2 end end if formatflag = 1 ++forp tget [F,forp] line &dK &d@ getf [1] 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 &dK &d@ putf [1] No movement title else tput [F,forp] ~line &dK &d@ putf [1] ~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 &dK &d@ getf [1] 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 &dK &d@ putf [1] ~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 &dA &dA &d@ Rewriting this section and adding extended format feature &dA12/17/03&d@ &dA ++forp tget [F,forp] bigline &dK &d@ getf [1] 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 * 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 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 &dI@F4 &dI@S5 5. Top of "real-work" loop. This is the point &dI@ to which you return each time you want to try &dI@ a new arrangement of measures. If this is the &dI@ final run, start first page. Set mainyp = 0, &dI@ and reset table Y. &dI@ 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 mnum = 1 sys_count = 1 syscnt = 0 savec = 0 mcnt = 0 deadspace = 0 stopflag = 0 endflag = 0 f4 = 0 adj_space = YES /* New &dA05/25/03&d@ loop for i = 1 to 32 conttie(i) = 0 /* Code added &dA02/25/97&d@ 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 /* added &dA09/22/03&d@ repeat &dA &dA &d@ More initialization necessary (as it turns out) &dA11/16/03&d@ &dA loop for i = 1 to f11 loop for j = 1 to 8 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 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 end if tacetline <> "" 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 &dK &d@ putf [3] X 46 ~x ~sq(1) ~tacetline end loop for i = 1 to f11 sq(i) += 150 repeat end if justflag < 2 ++mainyp tput [Y,mainyp] X 46 575 ~sq(1) ~mvtline &dK &d@ putf [3] X 46 575 ~sq(1) ~mvtline end loop for i = 1 to f11 sq(i) += 120 /* This moves system down to accommodate mvtline repeat &dA &dA &d@ Moving this lowerlim check to &dEafter&d@ final sq(.)'s are determined (&dA12/24/03&d@) &dA &dK &d@ if sq(f11) + vst(f11) > lowerlim &dK &d@ putc Unable to print; too many lines on first page &dK &d@ stop &dK &d@ end &dA sysy = sq(1) sysh = sq(f11) - sq(1) + vpar(f11,8) + vst(f11) bottom_sq = sq(f11) /* New &dA12/24/03&d@ sys_bottom = sq(f11) + vst(f11) /* New &dA12/24/03&d@ &dI@F5 &dI@S6 6. More initialization of variables &dI@ &dA &dA &d@ 3. 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 pdist = 0 larc = 0 barcount = 0 loop for i = 1 to 40 rflag(i) = 0 repeat textflag = 0 barnum = 0 oldbarnum = 0 newbarnum = 0 gbarflag = 0 f13 = 0 &dI@F6 &dI@ II. Processes specific to first page &dI@ * * 4. Start initial system * syslen = hxpar(4) - sp &dA &dA &d@ Process initial clef, key and time signatures (marc advanced) &dA &dI@L 1. Generate entries in marr for clef, key and time &dI@ signatures in that order (snode = 6913) &dI@ marc = 0 perform setckt firstpt = ldist - sp &dA This code added 2-1-93 &dI@S7 2. Transfer marr to larr &dI@ &dA &dA &d@ 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 /* New &dA05/25/03&d@ larr(larc,j) = marr(i,j) repeat repeat #if REPORT putc #endif marc = 0 deadspace = ldist &dA End of 2-1-93 addition &d@ stopflag = 0 goto CF &dI@F7 &dI@L 3. Jump over code that sets up to print pages 2ff. &dI@ Jump to section that begins reading input &dI@ data to construct the next measure (III-5). &dI@ &dA &dA &d@ &dA &d@ &dE &dA &d@ &dE &dA &d@ &dE BEGINNING OF MUSIC LINE LOOP &dA &d@ &dE &dA &d@ &dE &dA &d@ Check to see if there is more music &dA &dI@ III. General music system loop (big loop) &dI@ &dI@S8 1. Check to see if there is more music. &dI@ Jump to process end if not. (FINE) &dI@ CHH: loop for f12 = 1 to f11 rec = f(f12,5) perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line *DB putc ~rec ~line if line{1} = "J" and jtype = "M" and snode = 10000 f(f12,8) = 1 end repeat perform endcheck if endflag = 1 goto FINE end &dA &dA &d@ Starting x and y &dA &dI@F8 &dI@S9 2. Determine location of new system. If no &dI@ space at bottom, close page file and &dI@ open a new one. Reset location parameters. &dI@ &dA &dA &d@ This code modified &dA12/24/03&d@ to use new variables intersys and bottom_sq &dA sq(1) = bottom_sq + intersys &dK &d@ sq(1) = sq(f11) + intersys &dK &d@ if w(1) = 0 &dK &d@ sq(1) = vpar(f11,14) * 3 / 2 + sq(f11) &dK &d@ else &dK &d@ sq(1) = w(f11) + sq(f11) &dK &d@ end &dA sq(1) += vst(f11) * CHA: sp = hxpar(3) loop for i = 2 to f11 if w(1) = 0 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 &dA &dA &d@ Moving this lowerlim check to &dEafter&d@ final sq(.)'s are determined (&dA12/24/03&d@) &dA &dK &d@ if sq(f11) + vst(f11) > lowerlim &dK &d@ if justflag < 2 &dK &d@ open [3,2] outfile &dK &d@ loop for i = 1 to mainyp &dK &d@ tget [Y,i] line &dK &d@ line = trm(line) &dK &d@ putf [3] ~line &dK &d@ repeat &dK &d@ close [3] &dK &d@ perform newpage &dK &d@ end &dK &d@ sq(1) = toplim &dK &d@ goto CHA &dK &d@ end &dA sysy = sq(1) sysh = sq(f11) - sq(1) + vpar(f11,8) + vst(f11) syslen = hxpar(4) - sp bottom_sq = sq(f11) /* New &dA12/24/03&d@ sys_bottom = sq(f11) + vst(f11) /* New &dA12/24/03&d@ &dA &dA &d@ Set system line, clef, key signature &dA &dI@F9 &dI@L 3. Compute space for new clef and key &dI@ perform clefkeyspace deadspace = ldist &dI@S10 4. Initialize music system (line) variables &dI@ (similar to I-5 above) &dI@ 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 &dK &d@ backtxobrec = 0 /* New &dA12/19/03 if justflag < 2 firstsys = FALSE /* New &dA12/24/03 end &dI@F10 &dI@S11 5. Read measures until ldist > hxpar(4), or until end of data.&d@ &dI@ &dI@ Read data one measure at a time. The definition of a &dI@ complete measure is when the space node = 6913. There &dI@ may be several objects in this position, including clef, &dI@ key, and time changes, and also some super-objects. All &dI@ of these must be read and the distances included in the &dI@ "measure". If the last object is not a bar line, the &dI@ next object must be checked and the distance to it used &dI@ as a temporary negative adjustment to the potential &dI@ length of the line (so that there will be space for the &dI@ last object). &dI@ &dI@ When the addition of a measure distance to the total &dI@ distance on a line results in a line overflow, we have &dI@ two choices: (1) we may try to condense the longer line &dI@ to fit, or (2) we may try to expand the shorter line &dI@ (i.e. minus the last measure) to fit. This decision and &dI@ the resulting processes are in section III of the &dI@ process. &dI@ &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: rmarg = hxpar(4) 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 &X dputc rec = ~rec &X putc line = ~line ++rec if line{1,3} = "J S" if "467" con line{5} /* type 7 added &dA12/24/03&d@ * multiple rests and whole rests if mpt = 1 *DB putc T2 Multirest object = ~line 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 &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. 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 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 > rmarg * 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 ++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 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 &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 /* New &dA05/25/03&d@ (five lines) marr(marc,MNODE_TYPE) = 17 marr(marc,SNODE) = n marr(marc,ACT_FLAG) = 0 marr(marc,M_ADJ) = adj_space loop for k = 1 to 32 tdist(k,1) = 0 repeat k = 0 @d = 0 @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. examine stop end end CT: perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if "TCGMSD" con jtype goto CT 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) /* New &dA05/25/03 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 /* New &dA05/25/03 end if i > marr(marc,PRE_DIST) /* New &dA05/25/03 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 &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 /* " " 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 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 &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@ 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). (&dA05/25/03&d@) &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 &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 /* New &dA05/25/03 #if REPORT putc T7 minimum syncopated space = ~@e #endif if marr(marc,PRE_DIST) < @e /* New &dA05/25/03 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 /* New &dA05/25/03 else marr(marc-1,MNODE_TYPE) = 40 /* New &dA05/25/03 end end &dA &dA &d@ 3) Adjust olddist(.) for parts where f(f12,10) = 0 &dA perform adjolddist &dA &d@ &dA &d@ 4) Increment ldist &dA ldist += marr(marc,PRE_DIST) /* New &dA05/25/03 &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 /* New &dA05/25/03&d@ (five lines) marr(marc,MNODE_TYPE) = 18 marr(marc,SNODE) = 6913 marr(marc,ACT_FLAG) = 0xffffffff marr(marc,M_ADJ) = adj_space &dA &dA &d@ New &dA05/25/03&d@ &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 /* New &dA05/25/03&d@ @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 /* New &dA05/25/03&d@ 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 &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) /* New &dA05/25/03&d@ marr(marc,PRE_DIST) = i /* " " end olddist(f12) = dvar1 f(f12,6) = rec &dA &dA &d@ New code &dA05/25/03&d@ &dA if oby >= 1000000 oby /= 1000000 if oby = 1 or oby = 3 adj_space = NO end 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) /* New &dA05/25/03&d@ end repeat ldist += marr(marc,PRE_DIST) /* New &dA05/25/03&d@ * perform showmarr * 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 ++mcnt mspace(mcnt) = ldist if ldist > rmarg goto CK end &dA &dA &d@ Transfer marr to larr &dA loop for i = 1 to marc ++larc #if REPORT2 putc M~marr(i,1) ... #endif loop for j = 1 to MARR_PARS /* New &dA05/25/03&d@ larr(larc,j) = marr(i,j) repeat repeat #if REPORT2 putc #endif &dA &dA &d@ Adjust delta and counters &dA 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 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@ Provisional transfer of marr to larr &dA CK: larc2 = larc loop for i = 1 to marc ++larc2 loop for j = 1 to MARR_PARS /* New &dA05/25/03&d@ larr(larc2,j) = marr(i,j) repeat repeat &dI@F11 &dI@S12 6. Compute new distances for object nodes on a line. This &dI@ is where we determine how to right justify the line. It &dI@ is also where we decide whether or not to "squeeze" &dI@ an extra measure onto the line or not. &dI@ &dA &dA &d@ III. Compute new distances &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@ A. General calculations &dA &dA &d@ Identify shortest duration in extended line and determine quantity &dA &d@ and location of smallest distances &dA &dI@S13 A. General calculations: Identify shortest duration in &dI@ extended line and determine quantity and location of &dI@ smallest distances &dI@ &dA &dA &d@ New Code &dA05/25/03&d@ &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 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@ B. If there is no text, determine shortest adjustable distance &dA &d@ between notes and the number of notes that have this distance. &dA &d@ If an additional measure can be accommodated by decreasing &dA &d@ this distance by x%, then this should be done. &dA &dI@F13 &dI@S14 B. If there is no text, determine shortest adjustable &dI@ distance between notes and the number of notes that &dI@ have this distance. If an additional measure can be &dI@ accommodated by decreasing this distance by x%, then &dI@ this should be done. &dI@ 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 savec = c &dA &dA &d@ 2. solve problem 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 /* New &dA05/25/03&d@ if larr(i,PRE_DIST) > e /* " " b = 1 else goto CPB end --larr(i,PRE_DIST) /* New &dA05/25/03&d@ else if b = 0 goto CPB 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 --c if c = 0 if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 - savec 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 &dI@F14 &dI@S15 If the effort to squeeze an extra measure onto a line &dI@ fails, restore the earlier values of f(.,10), which &dI@ were advanced when we tentatively added the last &dI@ (prospective) measure. &dI@ 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 &dI@F15 &dI@S16 C. Assign delta (extra space) to various nodes within line &dI@ &dI@S17 a. Try to assign delta to multiple measure rests &dI@ or to whole measure rests &dI@ &dA &dA &d@ C. Try to assign delta to multiple measure rests &dA &d@ or to whole measure rests &dA CE: n = 0 #if REPORT2 putc T1 delta = ~delta #endif if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = delta end 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 &dI@F17 &dI@S18 b. Try to assign delta to notes larger than smallest &dI@ &dA &dA &d@ D. Try to assign delta to notes larger than smallest &dA &dA &d@ 1. construct adjarr, compute maximum possible adjustment &dA &dA &dA &d@ New Code &dA05/25/03&d@ &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@ More tinkering &dA12/11/03&d@ &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 &dK &d@ putc &dK &d@ putc using ~e as the shortest distance &dK &d@ loop for a1 = 1 to larc &dK &d@ perform showlarr &dK &d@ repeat &dK &d@ putc &dK &d@ n = 0 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 /* New &dA05/25/03 goto CD end if larr(i,TIME_NUM) > 0 /* New &dA05/25/03 dv3 = larr(i,TIME_NUM) * 10 / df /* " " if dv3 > 10 &dA &dA &d@ Code modification &dA12/11/03&d@ &dA rx = flt(dv3) rx = rx / 10.0 ry = lnx(rx) / lnx(2.0) rz = pow(1.5,ry) rz *= 10.0 dv3 = fix(rz) c = dv3 * e / 10 /* maximum final distance &dK &d@ c = c - larr(i,PRE_DIST) /* maximum distance to add &dA &dK &d@ c = dv3 * e / 10 * 3 &dK &d@ c = c - larr(i,PRE_DIST) / 3 /* New &dA05/25/03 &dA &dA &d@ Case: node is preceded by adjustable distance (larr(i,TIME_NUM) > 0); New &dA05/25/03 &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 /* New Code &dA05/25/03&d@ #if MEAS_SUGG if larr(i,M_ADJ) = YES ++adjarc adjarr(adjarc,1) = i adjarr(adjarc,2) = c adjarr(adjarc,3) = 0 /* New &dA12/11/03&d@ &dK &d@ n += c end #else ++adjarc adjarr(adjarc,1) = i adjarr(adjarc,2) = c adjarr(adjarc,3) = 0 /* New &dA12/11/03&d@ &dK &d@ n += c #endif end end end CD: repeat &dA &dA &d@ Code modification &dA12/11/03&d@ &dA &dA &d@ 2. compute adjarr(.,3) = current largest distance for nodes similar to this one. &dA &dK &d@ loop for i = 1 to adjarc &dK &d@ if adjarr(i,3) = 0 &dK &d@ a = adjarr(i,1) /* larr index for i-th adjarr element &dK &d@ adjarr(i,3) = larr(a,PRE_DIST) &dK &d@ loop for j = i + 1 to adjarc &dK &d@ if adjarr(j,3) = 0 &dK &d@ b = adjarr(j,1) /* larr index for j-th adjarr element &dK &d@ if larr(a,TIME_NUM) = larr(b,TIME_NUM) &dK &d@ c = larr(b,PRE_DIST) &dK &d@ if c > adjarr(i,3) /* c is new maximum for this TIME_NUM &dK &d@ loop for h = 1 to j &dK &d@ b = adjarr(h,1) &dK &d@ if larr(a,TIME_NUM) = larr(b,TIME_NUM) &dK &d@ adjarr(h,3) = c &dK &d@ end &dK &d@ repeat &dK &d@ else &dK &d@ adjarr(j,3) = adjarr(i,3) /* adjarr(i,3) still the maximum &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ repeat &dK &d@ end &dK &d@ repeat &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 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 &dA &d@ &dA &d@ 2. determine distances to add [old code] &dA &dK &d@ if n < delta &dK &d@ n = delta &dK &d@ end &dK &d@ h = delta &dK &d@ loop for i = 1 to adjarc &dK &d@ dvar1 = adjarr(i,2) * h / n &dK &d@ adjarr(i,2) = dvar1 &dK &d@ delta -= dvar1 &dK &d@ repeat &dK &d@ loop for i = 1 to adjarc &dK &d@ if delta = 0 &dK &d@ i = adjarc &dK &d@ else &dK &d@ ++adjarr(i,2) &dK &d@ --delta &dK &d@ end &dK &d@ repeat #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 &dI@F18 &dI@S19 c. Assign distance to smallest notes &dI@ &dI@ &dA &dA &d@ E. Assign distance to smallest notes &dA &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 = distance to subtract &dA a = 0 b = 0 #if REPORT2 putc Assigning ~delta to smallest notes; e = ~e #endif if scnt > 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 /* 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 &dI@F19 &dI@S20 d. Assign remaining distance wherever you can &dI@ &dI@ &dA &dA &d@ F. Assign distance whereever you can &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 &dI@F20 &dI@F16 &dI@F12 &dI@S21 7. Distances are computed. Now it is time to read the &dI@ file the second time and typeset the music &dI@ &dI@S22 A. Compute offsets for bar lines and values of larc &dI@ for bar lines. Also compute values of barpar. &dI@ &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 #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 loop for i = 1 to 300 cum_larr(i,1) = 0 cum_larr(i,2) = 0 repeat &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 " &dK &d@ putf [3] S 0 ~sp ~sysy ~i ~sysh ~f11 "~syscode " end * loop for i = 1 to barcount barpar(i,3) = 0 repeat * putc T9 delta = ~delta * &dK &d@ loop for a1 = 1 to larc &dK &d@ perform showlarr &dK &d@ repeat &dK &d@ putc &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 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) /* &dA12/17/03&d@ 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) /* &dA12/17/03&d@ cum_x = barcum_x /* " *DB putc T17 (~i :~d ,~j ) ... d = 0 end repeat end CG3: if i = barcount /* &dA12/17/03&d@ 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 &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 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 &dI@F22 &dI@S23 B. Loop through parts one at a time and print out. &dI@ Set delta to total number of bars for this line. &dI@ Use barcount as the exit indicator for each part. &dI@ &dI@S24 a. Set up Line record. If this is the first line, &dI@ put objects for instrument names; else, print &dI@ clef, key, time-sig and other information. &dI@ &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,8) &dA &d@ supermap(32,8) &dA &d@ superdata(32,8,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 notesize = f(f12,14) firstbarflag = 0 &dK &d@ backtxobrec = 0 /* New &dA12/19/03 dxoff(f12) = 10000 &dA &dA &d@ Set up Line record. If f13 = 0. put objects for instrument &dA &d@ 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 #if CONTINUO ++mainyp tput [Y,mainyp] L ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) -200 &dK &d@ putf [3] L ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) -200 #else ++mainyp tput [Y,mainyp] L ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 &dK &d@ putf [3] L ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 #endif end * print instrument name 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~j 6913 0 0 &dK &d@ putf [3] 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) &dK &d@ putf [3] W 0 ~y ~temp ~linepiece(k) end y += vpar(f12,6) repeat end end else if justflag < 2 ++mainyp #if CONTINUO tput [Y,mainyp] L ~i ~f(f12,9) ~dyoff(f12) ~uxstart(f12) ~backloc(f12) ~xbyte(f12) ~vst(f12) ~f(f12,14) -200 &dK &d@ putf [3] L ~i ~f(f12,9) ~dyoff(f12) ~uxstart(f12) ~backloc(f12) ~xbyte(f12) ~vst(f12) ~f(f12,14) -200 #else tput [Y,mainyp] L ~i ~f(f12,9) ~dyoff(f12) ~uxstart(f12) ~backloc(f12) ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 &dK &d@ putf [3] L ~i ~f(f12,9) ~dyoff(f12) ~uxstart(f12) ~backloc(f12) ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 #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) 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 c2 += spc(ors(temp{c3})) repeat c4 = 0 if temp2 <> "" loop for c3 = 1 to len(temp2) if temp2{c3} = "_" temp2{c3} = " " end c4 += spc(ors(temp2{c3})) repeat end if c4 > c2 c2 = c4 end c4 = notesize * 3 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 tput [Y,mainyp] J D 0 -~c2 ~c4 2 6913 0 0 c4 >>= 1 ++mainyp tput [Y,mainyp] W 0 -~c4 ~c5 ~temp ++mainyp tput [Y,mainyp] W 0 ~c4 ~c5 ~temp2 end end &dA end perform clefkey end * &dI@F24 &dI@S25 b. Check for multiple rests running over from &dI@ previous line, and initialize certain variables. &dI@ barnum = oldbarnum larc2 = 0 rec = f(f12,6) crec = 0 csnode = 6913 point = pdist prev_point = point /* New &dA12/19/03 point_adv = 0 /* New &dA12/19/03 oldmpoint = point if f13 = 1 oldmp2 = point else oldmp2 = firstpt end &dA &dA &d@ 1) check for multiple rests running over from previous line &dA barcount = 0 if f(f12,11) > 0 rest7 = 0 /* added &dA12/24/03&d@ perform save5 if barcount = delta goto CW end end &dI@F25 &dI@S26 c. Process the data for each part. Compute new &dI@ x-position for all objects. Collect information &dI@ on super objects; these may have to be split &dI@ at the end of line. Determine where to stop &dI@ looking (this has worked out to be a problem &dI@ area for this program). &dI@ &dA &dA &d@ 2) loop through part &dA if justflag < 2 type1_dflag(f12) = ON /* New &dA01/06/04&d@ type2_dflag(f12) = OFF /* New &dA01/06/04&d@ &dK &d@ dputc looping through part ~f12 &dK &d@ getc end CZ: tget [Z,rec] line .t3 jtype &dA &dA &d@ New code added 01/06/04 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 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} /* type 7 added &dA12/24/03 --rec perform save3 /* oby not used here &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 if c9 = 1 uxstop(f12) -= hpar(f12,4) 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 &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 &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 &dK &d@ half_back = oldmpoint - oldmp2 + barpar(barcount,1) / 2 point = oldmpoint + barpar(barcount,1) prev_point = point /* New &dA12/19/03 point_adv = 0 /* New &dA12/19/03 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 /* New &dA12/19/03 perform getcontrol cdv_adv = cdv - oldcdv /* New &dA12/19/03 * putc T21 ~line2 obx = dvar1 - cdv /* differential obx if crec <> a1 prev_point = point /* New &dA12/19/03 i = larc2 + 1 loop for larc2 = i to 300 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 300 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 examine stop &dA &dA &d@ differential obx and point now determined &dA DE: point_adv = point - prev_point /* New &dA12/19/03 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 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 savenoby(f12) = oby * uxstop(f12) = sp + obx + hpar(f12,2) end if jtype = "R" and cflag = 1 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" line2 = "W " // chs(sobx) // " " // chs(soby) // " 0 " line2 = line2 // "(" // chs(z) // ")" // temp tput [Z,c8] ~line2 ++c8 goto SKD2 end end &dK OLD CODE &dK &dK &d@ if jtype = "D" &dK &d@ if ntype = 0 &dK &d@ goto CZ3 &dK &d@ end &dK &d@ if bit(1,ntype) = 1 &dK &d@ goto CZ3 &dK &d@ end &dK &d@ if bit(2,ntype) = 1 and f12 = 1 &dK &d@ goto CZ3 &dK &d@ end &dK &d@ if bit(3,ntype) = 1 and f12 = f11 &dK &d@ goto CZ3 &dK &d@ end &dK &d@ /* skip over directives &dK &d@SKD2: tget [Z,rec] line2 .t3 sobx soby z &dK &d@ if line2{1} = "W" &dK &d@ ++rec &dK &d@ goto SKD2 &dK &d@ end &dK &dA &dK &dA &d@ Need to add some code here &dA10-30-93&d@. The problem is that &dK &dA &d@ in skipping a directive, we might be skipping over a non-zero &dK &dA &d@ distance increment flag (parameter 8 of an object). This doesn't &dK &dA &d@ appear to have caused any problems in my music printing programs, &dK &dA &d@ but it does effect the program that tries to convert page-specific &dK &dA &d@ i-files to Leland's score files. Therefore, we need to check to &dK &dA &d@ see if this directive had a non-zero p8 and add this amount to the &dK &dA &d@ p8 of the next object in line, whatever it might be (provided, &dK &dA &d@ however, that it is not a "floating" rest). &dK &dA &dK &d@ if dincf > 0 &dK &d@ i = 0 &dK &d@L1030: &dK &d@ tget [Z,rec+i] line2 &dK &d@ if line2{1} = "J" &dK &d@ j = int(line2{5..}) /* dummy ntype &dK &d@ j = int(line2{sub+1..}) /* dummy dvar1 &dK &d@ j = int(line2{sub+1..}) /* dummy oby &dK &d@ j = int(line2{sub+1..}) /* dummy z &dK &d@ j = int(line2{sub+1..}) /* dummy snode &dK &d@ k = sub /* delimiter to snode (blank) &dK &d@ j = int(line2{sub+1..}) /* dincf &dK &d@ if j <> 10000 &dK &d@ j += dincf &dK &d@ line2 = line2{1,k} // chs(j) // line2{sub..} &dK &d@ tput [Z,rec+i] ~line2 &dK &d@ goto CZ &dK &d@ end &dK &d@ end &dK &d@ ++i &dK &d@ goto L1030 &dK &d@ end &dK &dA &dK &dA &d@ End of addition &dA10-30-93&d@ &dK &dA &dK &d@ goto CZ &dK &d@ end &dK &dK END OF OLD CODE &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 > 31 &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 &dK &d@ putf [3] 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 Error: Wrong number of superobjects examine stop end &dA &d@ look for previous reference to this superobject loop for k = 1 to 8 if supermap(f12,k) = j goto WA end repeat h = 0 loop for k = 1 to 8 if supermap(f12,k) = 0 h = k k = 8 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 &dA &d@ k (value 1 to 8) = 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 if jtype = "R" &dA &d@ typeset underline (if unset) loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} &dA &dA &d@ check next note for new syllable &dA YR4: if rec < f(f12,2) tget [Z,rec] line ++rec if line{1,3} = "J N" YR1: tget [Z,rec] line ++rec if "KA" con line{1} /* Added &dA11-11-93&d@ goto YR1 end rec = saverec &dA &dA &d@ This code adjusted &dA12/19/03&d@ to accommodate new text record format &dA if line{1} = "T" c9 = int(line{3..}) if line{sub} = "|" /* New &dA12/19/03&d@ c9 = int(line{sub+1..}) end c9 = int(line{sub..}) if c9 = c8 goto YR2 end goto YR4 end goto YR3 end goto YR4 end * YR2: y = sq(f12) + f(f12,9) xbyte(f12){c8} = "*" YR3: end saverec = rec repeat end 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 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] K ~sobx ~soby 44 soby = vpar(f12,5) ++mainyp tput [Y,mainyp] K ~sobx ~soby 44 &dK &d@ putf [3] 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 Code added 2-1-93 &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 jtype = "B" and larc2 <> larc loop for h = larc2 + 1 to larc if larr(h,SNODE) <> 6913 /* New &dA05/25/03&d@ goto C21A end if bit(f12-1,larr(h,ACT_FLAG)) = 1 /* New &dA05/25/03&d@ goto C21A end repeat k = 1 /* bar &dAis&d@ last node on line end &dA End of code added 2-1-93 &d@ 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 terminate program getc examine stop end if endflag = 0 /* skip over directives SKD1: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "W" ++rec goto SKD1 end end 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] ~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 8 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 8 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) &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 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 &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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] J M 0 ~syslen 0 0 6913 0 1 ~n end if superdata(f12,k,6) = 0 * write "first half" of super-object if justflag < 2 ++mainyp tput [Y,mainyp] H ~n E ~a3 ~x1 0 ~y1 ~a1 0 &dK &d@ putf [3] H ~n E ~a3 ~x1 0 ~y1 ~a1 0 end else if justflag < 2 ++mainyp tput [Y,mainyp] H ~n N &dK &d@ putf [3] H ~n N end end * set broken super-object flag superdata(f12,k,5) = 1 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 * create mark for end of dashes (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 &dK &d@ putf [3] 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 &dK &d@ putf [3] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n D ~x1 0 ~y1 ~a1 ~a2 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] H ~n W ~c1 ~c2 ~x1 ~y1 0 ~y2 end goto CL end end end repeat CL: repeat &dA &dA &d@ typeset unset underline &dA loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} uxstop(f12) = i - 10 y = sq(f12) + f(f12,9) &dA &dA &d@ check to see if next note/rest terminates this line &dA rec = f(f12,6) KK2: perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if jtype = "R" &dA &dA &d@ check next note for new syllable &dA KK7: if rec < f(f12,2) tget [Z,rec] line ++rec if line{1,3} = "J N" KK6: tget [Z,rec] line ++rec if "KA" con line{1} /* Added &dA11-11-93&d@ goto KK6 end &dA &dA &d@ This code adjusted &dA12/19/03&d@ to accommodate new text record format &dA if line{1} = "T" c9 = int(line{3..}) if line{sub} = "|" /* New &dA12/19/03&d@ c9 = int(line{sub+1..}) end c9 = int(line{sub..}) if c9 = c8 goto KK1 end goto KK6 end goto KK4 end goto KK7 end goto KK1 * end if jtype = "N" KK3: perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" and jtype = "N" goto KK4 end &dA &dA &d@ This code adjusted &dA12/19/03&d@ to accommodate new text record format &dA if line{1} = "T" c9 = int(line{3..}) if line{sub} = "|" /* New &dA12/19/03&d@ c9 = int(line{sub+1..}) end c9 = int(line{sub..}) if c9 = c8 goto KK1 end end goto KK3 end if snode = 10000 goto KK1 end end goto KK2 KK1: xbyte(f12){c8} = "*" KK4: end repeat 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] ~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 tput [Y,mainyp] ~line &dK &d@ putf [3] ~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) &dK &d@ if line con "lemn" &dK &d@ examine &dK &d@ end trec = rec - 2 /* rec was advanced after getting "T" record TX1: tget [Z,trec] line2 if line2{1} <> "J" and trec > 1 &dK &d@ dputc bad line2 = ~line2 --trec goto TX1 end &dA &dA &d@ Step 2: save current value of backtxobrec and set a new value for backtxobrec &dA c15 = backtxobrec backtxobrec = trec &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 &dK &d@ putf [3] ~line end &dA &dA &d@ End of &dA12/19/03&d@ code re-write &dA loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} x = sp + obx + sobx - hpar(f12,4) if mpt > 1 x -= hpar(f12,4) end if uxstop(f12) > x uxstop(f12) = x end y = sq(f12) + f(f12,9) end repeat &dK &d@ dputc A * 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 8 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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) #if NEWFONTS j = Mbeamfont(notesize) /* covers all 12 notesizes #else if notesize = 6 j = 103 else if notesize = 21 j = 112 else j = notesize / 2 + 101 end end #endif 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] ~superline end &dO &d@ x1 = int(tline) + superdata(f12,k,1) &dO &d@ tline = txt(line,[' '],lpt) &dO &d@ y1 = int(tline) + superdata(f12,k,2) &dO &d@ tline = txt(line,[' '],lpt) &dO &d@ x2 = int(tline) + superdata(f12,k,3) 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] ~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) &dK &d@ putf [3] E ~xbyte(f12) end repeat 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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@ 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" ++c9 c13 = 0 c11 = y3p 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 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 if line2{sub-1} = "(" and line2{sub+1} = ")" line2 = line2{1,sub-2} // line2{sub+2..} else if line2{sub-1} = "[" and line2{sub+1} = "]" line2 = line2{1,sub-2} // line2{sub+2..} else if line2{sub-1} = "{" and line2{sub+1} = "}" line2 = line2{1,sub-2} // line2{sub+2..} else line2 = line2{1,sub-1} // line2{sub+1..} 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 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" c8 = int(line2{3..}) if c9 < tf11 c8 = c8 + tsq(c9) - tsq(c9+1) else dputc Program Error stop end line2 = "L " // chs(c8) // line2{sub..} 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(20) if line2{1,8} = "W 0 0 0 " c8 = M_NUM_FONT line2 = "W 0 0 " // chs(c8) // line2{8..} line2 = trm(line2) tput [Y,c14] ~line2 TKOUT1: ++c14 tget [Y,c14] line2 line2 = line2 // pad(20) if line2{1,9} = "W 0 0 0 (" c8 = int(line2{10..}) c7 = sub + 1 line2 = "W 0 0 " // chs(c8) // line2{sub+1..} tput [Y,c14] ~line2 end if line2{1} = "E" or c14 = mainyp c14 = mainyp else goto TKOUT1 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-5: 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" if "GQNMR" con line{3} if line{3} <> "R" &dK &d@ if c13 = 0 &dK &d@ dputc setting c13 to 1 line = ~line &dK &d@ end c13 = 1 else if line{3,3} <> "R 9" &dK &d@ if c13 = 0 &dK &d@ dputc setting c13 to 1 line = ~line &dK &d@ end c13 = 1 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 if c8 <> 10001 &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 if line{1,3} = "Q R" line = "J " // line{3..} tput [Y,y3p] ~line end if line{1,6} = "J R 9 " 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 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 #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 justflag > 1 putc .t5 MEASURE ~mnum end &dA &dA &d@ New page control code &dA12/24/03&d@ &dA if justflag < 2 c16 = sys_bottom &dK &d@ c16 = sq(f11) + vst(f11) &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 open [3,2] outfile loop for i = 1 to sv_mainyp tget [Y,i] line line = trm(line) putf [3] ~line repeat close [3] &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] loop for mainyp = 1 to c14 tget [T,mainyp] line tput [Y,mainyp] ~line repeat &dA &dA &d@ Step 3: Adjust value of bottom_sq (sq(f11)) &dA bottom_sq -= c13 sys_bottom -= c13 &dK &d@ sq(f11) -= 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 open [3,2] outfile loop for i = 1 to mainyp tget [Y,i] line line = trm(line) putf [3] ~line repeat close [3] end end if justflag > 1 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. 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 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 &dKDEBUG&d@ &dK &dK &d@ examine &dK &dKEND DEBUG&d@ 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 &dK &d@ @g = vpar(f12,1) * 1000 - vpar(f12,8) @g = vpar(f12,2) * 500 - vpar(f12,8) loop for @j = 1 to bcount &dK &d@ beamdata(@j,2) = vpar(f12,1) * 1000 - beamdata(@j,2) 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 &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 obx = hxpar(10) &dA &dA &d@ 1) clef &dA 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 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 &dK &d@ putf [3] J C ~clef(f12,t2) ~obx ~oby ~a5 6913 0 0 ++mainyp tput [Y,mainyp] K 0 0 33 &dK &d@ putf [3] K 0 0 33 ++mainyp tput [Y,mainyp] K 0 0 34 &dK &d@ putf [3] K 0 0 34 if a3 = 1 ++mainyp tput [Y,mainyp] K ~hpar(f12,5) ~vpar(f12,15) 234 &dK &d@ putf [3] 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 &dK &d@ putf [3] J C ~clef(f12,t2) ~obx ~oby ~z 6913 0 0 end end if f(f12,12) <> 2 t2 = 100 else t1 = vst(f12) end repeat 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 &dK &d@ putf [3] J K ~key(f12) ~obx ~t1 ~a3 6913 0 0 end if a3 > 0 a1 = clef(f12,t2) / 10 &dK &d@ y = rem - 1 * notesize t3 = rem - 1 * 2 /* t3 (vertical position) measured in line numbers a1 /= 3 &dK &d@ a2 = 2 - rem * vpar(f12,3) &dK &d@ y -= a2 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 &dK &d@ putf [3] K ~x ~y 63 end &dK &d@ y += zak(1,j) t3 += zak(1,j) x += hpar(f12,6) repeat end &dA &d@ flats if key(f12) < 0 &dK &d@ y += vpar(f12,4) 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 &dK &d@ putf [3] K ~x ~y 65 end &dK &d@ y += zak(2,j) t3 += zak(2,j) x += hpar(f12,7) repeat end end if f(f12,12) <> 2 t2 = 100 else t1 = vst(f12) 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 &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 &dK &d@ putf [3] 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 tput [Y,mainyp] W ~x ~y ~line &dK &d@ putf [3] W ~x ~y ~line 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] J T ~savtcode(f12) ~obx ~y ~z 6913 0 0 end if f(f12,12) = 2 y += vst(f12) if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx ~y ~z 6913 0 0 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 tput [Y,mainyp] J T ~savtcode(f12) ~obx ~vst(f12) ~a3 6913 0 0 &dK &d@ putf [3] J T ~savtcode(f12) ~obx ~vst(f12) ~a3 6913 0 0 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 x = a5 - t1 y = 0 - vpar(f12,2) if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y 1 6913 0 0 &dK &d@ putf [3] J D 0 ~x ~y 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~t2 ~line2 &dK &d@ putf [3] W 0 0 ~t2 ~line2 end /* earlier version: putf [3] W 0 0 31 ~line2 end 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@ 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@ 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 e = a2 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. 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 &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 end goto CKT2 end if "CKT" con jtype #if FIX_CKT if mpt > 1 firstclef = 1 /* K or T encountered else if firstclef = 1 mpt = 4 /* Clef after K or T end end #endif ++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 #if FIX_CKT loop for g = 1 to 4 #else loop for g = 1 to 3 #endif &dA &d@ generate entries in marr if tarr(g) > 0 j = 1 ++marc marr(marc,PRE_DIST) = 0 /* New &dA05/25/03&d@ if g < 4 marr(marc,MNODE_TYPE) = 13 + g /* New &dA05/25/03&d@ else marr(marc,MNODE_TYPE) = 14 /* Clef following Key or Time New end marr(marc,TIME_NUM) = 0 /* New &dA05/25/03&d@ (four lines) marr(marc,SNODE) = 6913 marr(marc,ACT_FLAG) = 0 marr(marc,M_ADJ) = adj_space k = 0 q = 1 /* for constructing marr(marc,ACT_FLAG) New &dA05/25/03 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 &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" and jtype = "CKTC"{g} marr(marc,ACT_FLAG) |= q /* New &dA05/25/03&d@ h = dvar1 - olddist(f12) if h > marr(marc,PRE_DIST) /* New &dA05/25/03&d@ 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) /* New &dA05/25/03&d@ 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 j = 1 rmarg = hxpar(4) - i end 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) /* New &dA05/25/03&d@ end end repeat return &dA &d@ &dA &dA &d@*P&dA 29. 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 &dK &d@ putf [3] J R 9 ~x ~y 46 1 0 0 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 &dK &d@ putf [3] J R 9 ~x ~y 2 1 0 0 ++mainyp tput [Y,mainyp] K 0 0 46 &dK &d@ putf [3] K 0 0 46 ++mainyp tput [Y,mainyp] K 0 ~vst(f12) 46 &dK &d@ putf [3] K 0 ~vst(f12) 46 end return &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 if csnode < 6913 if csnode = snode if cjtype = "B" crec = rec GC1: perform save4 if "NRQFI" con cjtype return end ++crec goto GC1 end return else if csnode < snode crec = rec GC2: perform save4 if "NRQFIB" con cjtype if mpt < 6 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 crec = rec GC3: perform save4 if snode = 6913 if "BCKT" con cjtype return end else if "NRQFIB" con cjtype 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 &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 = b end end NU1: a = a / 10 z = rem + 71 if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y ~z &dK &d@ putf [3] 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp - vpar(f12,3) if superdata(f12,k,6) = 0 a3 = 0 a1 = 0 end if justflag < 2 * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum &dK &d@ putf [3] 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 &dK &d@ putf [3] H ~supernum E ~a3 0 ~x2 ~y1 ~a1 ~a2 end end 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 tr &dA &d@ 2 = tr with no ax &dA &d@ 3 = tr with sharp &dA &d@ 4 = tr with natural &dA &d@ 5 = tr with flat &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from obj1 &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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] ~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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 &dK &d@ putf [3] 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 loop a = point b = oldmpoint + barpar(barcount+1,1) c = f(f12,12) perform wholerest (c) ++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 end repeat while f(f12,11) > 0 return *PX showmarr procedure showmarr putc marr(~marc ,*) .t12 ... loop for j = 1 to MARR_PARS /* New &dA05/25/03&d@ putc .w6 ~marr(marc,j) ... repeat putc return *PX showlarr procedure showlarr putc larr(~a1 ,*) .t12 ... loop for a2 = 1 to MARR_PARS /* New &dA05/25/03&d@ 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.100,line.80 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 #if NEWFONTS &dA &dA &d@ New code &dA03/19/04&d@ &dA open [4,1] "C:\MUSPRINT\NEW\XFONTS\TMS\fontspac" 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 #else if notesize = 14 file = "c:\musprint\param\fontspac" end if notesize = 6 file = "c:\musprint\param06\fontspac" end if notesize = 21 file = "c:\musprint\param21\fontspac" end open [4,1] file t2 = t5 - 1 * 10 #endif 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 #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 &dK &d@ setup msgstr,160,120,1 &dK &d@ setup redmsgstr,160,120,1 setup msgstr,160,60,1 setup redmsgstr,160,60,1 &dK &d@ msgstr{341,160} = gline{1,160} /* line 3 &dK &d@ msgstr{821,160} = gline{1,160} /* line 6 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 &dK &d@ activate msgstr,0,904,1 &dK &d@ activate redmsgstr,0,904,4 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 if jtype = "R" and ntype = 9 and nodenum = 1 and oldrestx <> obx ++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 if jtype = "R" and ntype = 9 and nodenum = 1 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" 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 &dK &dK &d@ calling information &dK &dK &d@ dputc Calling information &dK &d@ loop for @b = 1 to bcount &dK &d@ putc .t10 x = ~beamdata(@b,1) .t20 y = ~beamdata(@b,2) .t30 beamcode = ~beamcode(@b) &dK &d@ repeat &dK &d@ dputc &dK &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 @h = 0 - notesize * 2 / 3 + staff_height - @s if y1 > @h y1 = @h end if y2 > @h y2 = @h end end else if staff_height <> 10000 @h = 11 * notesize / 2 + staff_height + @s if y1 < @h y1 = @h end if y2 < @h y2 = @h end 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 &dK &d@ @g = eskvpar(1) * 1000 - eskvpar(8) - @g @g = eskvpar(2) * 500 - eskvpar(8) - @g loop for @j = 1 to bcount &dK &d@ beamdata(@j,2) = eskvpar(1) * 1000 - beamdata(@j,2) 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 &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 &dK &d@ y1 = eskvpar(1) * 1000 - y1 - bthick - esksq(eskf12) + eskvpar(39) + eskvpar(38) &dK &d@ y2 = eskvpar(1) * 1000 - y2 - bthick - esksq(eskf12) + eskvpar(39) + eskvpar(38) 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 &dKDEBUG&d@ &dK &d@ dputc Calling information &dK &d@ loop for @b = 1 to bcount &dK &d@ putc .t10 x = ~beamdata(@b,1) .t20 y = ~beamdata(@b,2) .t30 beamcode = ~beamcode(@b) &dK &d@ repeat &dK &d@ dputc &dK &d@ getc &dKEND DEBUG&d@ &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 &dK &d@ y = eskvpar(1) * 1000 - y - bthick 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 &dK &d@ y = eskvpar(1) * 1000 - y - bthick 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 &dK &d@ y = eskvpar(1) * 1000 - y - bthick 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 &dK &d@ y = eskvpar(1) * 1000 - y - bthick 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 &dK &d@ y = eskvpar(1) * 1000 - y 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 procedure setmus int sy if z = 0 return end 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 two version: oldfonts and NEWFONTS &dA #if NEWFONTS &dA &d@ &dA &dA &d@*P&dA 6. setwords (with NEWFONTS) &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 pz /* added &dA03/15/04&d@ 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 #else &dA &d@ &dA &dA &d@*P&dA 6. setwords (under oldfonts) &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 pz /* added &dA03/15/04&d@ int t1 &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA &d@ 1 = setwords called form 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..} 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,2} in ['0'..'9'] if "123456789" con textline{3} t1 = mpt else if "123456789" con textline{2} t1 = mpt else t1 = 0 end end t1 += 176 line2 = chr(t1) else if textline{2} in ['0'..'9'] d1 = ors(textline{3}) if textline{2} = "0" d1 += 128 line2 = "" if d1 = 171 scx -= hpar(4) end if chr(d1) in [161..164,167,170,171,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] line2 = line2 // chr(d1) end else if textline{2} = "2" and "Oos" con textline{3} if mpt < 3 line2 = chr(d1+143) // "Oo"{mpt} else line2 = chr(175) end else if textline{2} = "7" and "Yy" con textline{3} line2 = chr(d1+124) // "Yy"{mpt} else d2 = int(textline{2}) d1 += wak(d2) if chr(d1) in [161..164,167,170,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] if textline{3} = "i" line2 = chr(d1) // chr(163) else line2 = chr(d1) // textline{3} end else line2 = textline{3} end end end end else d1 = ors(textline{2}) if textline{3} = "0" d1 += 128 line2 = "" if d1 = 171 scx -= hpar(4) end if chr(d1) in [161..164,167,170,171,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] line2 = line2 // chr(d1) end else if textline{3} = "2" and "Oos" con textline{2} if mpt < 3 line2 = chr(d1+143) // "Oo"{mpt} else line2 = chr(175) end else if textline{3} = "7" and "Yy" con textline{2} line2 = chr(d1+124) // "Yy"{mpt} else if textline{3} in ['1'..'9'] d2 = int(textline{3}) d1 += wak(d2) if chr(d1) in [161..164,167,170,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] if textline{2} = "i" line2 = chr(d1) // chr(163) else line2 = chr(d1) // textline{2} end else line2 = textline{2} end end end end end end end perform lineout if len(textline) > 3 textline = textline{4..} else textline = "" end goto A11 else line2 = textline perform lineout end scf = notesize return #endif &dA &dA &d@ &dA04/22/04&d@ End of division of setwords &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 pz /* added &dA03/15/04&d@ 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..}) &dN &d@ z = fontmap(z) ERROR found &dA08/28/02&d@ &dIOK&d@ 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 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 &dK &d@ procedure setwords &dK &d@ str textline.300 &dK &d@ int t1 &dK &dK &d@ scx = x &dK &d@ scy = y &dK &d@ scf = z &dK &d@ textline = line // " " &dK &dKA&d@11: if textline con "\" &dK &d@ if mpt > 1 &dK &d@ t1 = mpt &dK &d@ line2 = textline{1,mpt-1} &dK &d@ perform lineout &dK &d@ textline = textline{t1..} &dK &d@ end &dK &d@ if textline{2,2} in ['0'..'9'] &dK &d@ if "123456789" con textline{3} &dK &d@ t1 = mpt &dK &d@ else &dK &d@ if "123456789" con textline{2} &dK &d@ t1 = mpt &dK &d@ else &dK &d@ t1 = 0 &dK &d@ end &dK &d@ end &dK &d@ t1 += 176 &dK &d@ line2 = chr(t1) &dK &d@ else &dK &d@ if textline{2} in ['0'..'9'] &dK &d@ d1 = ors(textline{3}) &dK &d@ if textline{2} = "0" &dK &d@ d1 += 128 &dK &d@ line2 = "" &dK &d@ if d1 = 171 &dK &d@ scx -= eskhpar(4) &dK &d@ end &dKi&d@f chr(d1) in [161..164,167,170,171,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] &dK &d@ line2 = line2 // chr(d1) &dK &d@ end &dK &d@ else &dK &d@ if textline{2} = "2" and "Oos" con textline{3} &dK &d@ if mpt < 3 &dK &d@ line2 = chr(d1+143) // "Oo"{mpt} &dK &d@ else &dK &d@ line2 = chr(175) &dK &d@ end &dK &d@ else &dK &d@ if textline{2} = "7" and "Yy" con textline{3} &dK &d@ line2 = chr(d1+124) // "Yy"{mpt} &dK &d@ else &dK &d@ d2 = int(textline{2}) &dK &d@ d1 += wak(d2) &dKi&d@f chr(d1) in [161..164,167,170,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] &dK &d@ if textline{3} = "i" &dK &d@ line2 = chr(d1) // chr(163) &dK &d@ else &dK &d@ line2 = chr(d1) // textline{3} &dK &d@ end &dK &d@ else &dK &d@ line2 = textline{3} &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ else &dK &d@ d1 = ors(textline{2}) &dK &d@ if textline{3} = "0" &dK &d@ d1 += 128 &dK &d@ line2 = "" &dK &d@ if d1 = 171 &dK &d@ scx -= eskhpar(4) &dK &d@ end &dKi&d@f chr(d1) in [161..164,167,170,171,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] &dK &d@ line2 = line2 // chr(d1) &dK &d@ end &dK &d@ else &dK &d@ if textline{3} = "2" and "Oos" con textline{2} &dK &d@ if mpt < 3 &dK &d@ line2 = chr(d1+143) // "Oo"{mpt} &dK &d@ else &dK &d@ line2 = chr(175) &dK &d@ end &dK &d@ else &dK &d@ if textline{3} = "7" and "Yy" con textline{2} &dK &d@ line2 = chr(d1+124) // "Yy"{mpt} &dK &d@ else &dK &d@ if textline{3} in ['1'..'9'] &dK &d@ d2 = int(textline{3}) &dK &d@ d1 += wak(d2) &dKi&d@f chr(d1) in [161..164,167,170,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] &dK &d@ if textline{2} = "i" &dK &d@ line2 = chr(d1) // chr(163) &dK &d@ else &dK &d@ line2 = chr(d1) // textline{2} &dK &d@ end &dK &d@ else &dK &d@ line2 = textline{2} &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ perform lineout &dK &d@ if len(textline) > 3 &dK &d@ textline = textline{4..} &dK &d@ else &dK &d@ textline = "" &dK &d@ end &dK &d@ goto A11 &dK &d@ else &dK &d@ line2 = textline &dK &d@ perform lineout &dK &d@ end &dK &d@ scf = notesize &dK &d@ return &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 &dK &d@ procedure lineout &dK &d@ int t1, t2, t3 &dK &d@ str textline.300 &dK &dKA&d@AA111: if line2 con "!" &dK &d@ t1 = mpt &dK &d@ if t1 > 1 &dK &d@ if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ &dK &d@ textline = line2{1,t1-1} &dK &d@ else &dK &d@ textline = "" &dK &d@ loop for t2 = 1 to t1 - 1 &dK &d@ t3 = ors(line2{t2}) &dK &d@ t3 = music_con(t3) &dK &d@ textline = textline // chr(t3) &dK &d@ repeat &dK &d@ end &dK &d@ perform stringout (textline) &dK &d@ line2 = line2{t1..} &dK &d@ end &dK &d@ if len(line2) > 1 &dK &d@ if "0123456789" con line2{2} &dK &d@ z = int(line2{2..}) &dK &d@ scf = z &dK &d@ if sub <= len(line2) &dK &d@ line2 = line2{sub..} &dA &dA &d@ Code added &dA01/17/04&d@ to remove terminator to font designation field &dA &dK &d@ if line2{1} = "|" &dK &d@ if len(line2) = 1 &dK &d@ return &dK &d@ end &dK &d@ line2 = line2{2..} &dK &d@ end &dK &dA &dK &d@ goto AAA111 &dK &d@ else &dK &d@ return &dK &d@ end &dK &d@ else &dK &d@ if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ &dK &d@ textline = "!" &dK &d@ else &dK &d@ t3 = ors("!") &dK &d@ t3 = music_con(t3) &dK &d@ textline = chr(t3) &dK &d@ end &dK &d@ perform stringout (textline) &dK &d@ line2 = line2{2..} &dK &d@ goto AAA111 &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ &dK &d@ textline = line2 &dK &d@ else &dK &d@ textline = "" &dK &d@ loop for t2 = 1 to len(line2) &dK &d@ t3 = ors(line2{t2}) &dK &d@ t3 = music_con(t3) &dK &d@ textline = textline // chr(t3) &dK &d@ repeat &dK &d@ end &dK &d@ perform stringout (textline) &dK &d@ return &dA &d@ &dA &dA &d@*P&dA 7. settext &dA &d@ &dA &dA &d@ Purpose: Typeset text &dA &dA &d@ Inputs: x = horizontal position of note &dA &d@ y = vertical position of note &dA &d@ ttext = text to typeset &dA &dA &d@ Internal varibles: d1 = temporary variable &dA &d@ d2 = temporary variable &dA &d@ textline = working text string &dA &d@ line2 = text out string &dA &dA &dK &d@ procedure settext &dK &d@ int t1 &dA &dA &d@ New &dA08/31/03&d@ &dIOK&d@ &dA &dK &d@ if ttext = "&" &dK &d@ return &dK &d@ end &dK &dK &d@ scx = x &dK &d@ scy = y &dK &d@ scf = mtfont &dK &d@ textline = ttext // " " &dKA&d@1: if textline con "\" &dK &d@ if mpt > 1 &dK &d@ t1 = mpt &dK &d@ line2 = textline{1,mpt-1} &dK &d@ perform stringout (line2) &dK &d@ textline = textline{t1..} &dK &d@ end &dK &d@ if textline{2,2} in ['0'..'9'] &dK &d@ if "123456789" con textline{3} &dK &d@ t1 = mpt &dK &d@ else &dK &d@ if "123456789" con textline{2} &dK &d@ t1 = mpt &dK &d@ else &dK &d@ t1 = 0 &dK &d@ end &dK &d@ end &dK &d@ t1 += 176 &dK &d@ line2 = chr(t1) &dK &d@ else &dK &d@ if textline{2} in ['0'..'9'] &dK &d@ d1 = ors(textline{3}) &dK &d@ if textline{2} = "0" &dK &d@ d1 += 128 &dK &d@ line2 = "" &dK &d@ if d1 = 171 &dK &d@ scx -= eskhpar(4) &dK &d@ end &dK &d@ line2 = line2 // chr(d1) &dK &d@ else &dK &d@ if textline{2,2} = "2s" &dK &d@ line2 = chr(175) &dK &d@ else &dK &d@ d2 = int(textline{2}) &dK &d@ d1 += wak(d2) &dK &d@ line2 = chr(d1) // textline{3} &dK &d@ end &dK &d@ end &dK &d@ else &dK &d@ d1 = ors(textline{2}) &dK &d@ if textline{3} = "0" &dK &d@ d1 += 128 &dK &d@ line2 = "" &dK &d@ if d1 = 171 &dK &d@ scx -= eskhpar(4) &dK &d@ end &dK &d@ line2 = line2 // chr(d1) &dK &d@ else &dK &d@ if textline{2,2} = "s2" &dK &d@ line2 = chr(175) &dK &d@ else &dK &d@ d2 = int(textline{3}) &dK &d@ d1 += wak(d2) &dK &d@ line2 = chr(d1) // textline{2} &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ perform stringout (line2) &dK &d@ textline = textline{4..} &dK &d@ goto A1 &dK &d@ else &dK &d@ perform stringout (textline) &dK &d@ end &dK &d@ scf = notesize &dK &d@ 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 procedure staff int slen if notesize >= 10 slen = 64 else slen = 32 end &dK &d@ if notesize = 14 &dK &d@ slen = 64 &dK &d@ end &dK &d@ if notesize = 6 &dK &d@ slen = 32 &dK &d@ end &dK &d@ if notesize = 21 &dK &d@ slen = 64 &dK &d@ end if notesize = 21 /* Added &dA11/18/03&d@ to fill holes in lines 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 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 if x = eskhpar(9) 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 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.80 &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 x2 - x1 < a5 /* stock slurs SR5: &dK &d@ a5 = eskvpar(10) - y1 / eskvpar(1) /* height par of 1st note &dK &d@ a6 = eskvpar(10) - y2 / eskvpar(1) /* height par of 2nd note 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 &dK &d@ a7 *= eskvpar(1) 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 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 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 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 = "c:\musprint\bitmap\slurs\c\" end if notesize = 21 line2 = "c:\musprint\bitmap21\slurs\c\" end if notesize = 6 line2 = "c:\musprint\bitmap06\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 &dK &d@ y1 -= eskvpar(1) y1 = (c1 - 1) * eskvpar(2) + eskvpar(1) end c1 = y2 / eskvpar(2) if y2 > eskvpar(1) and rem = 0 &dK &d@ y2 -= eskvpar(1) 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 &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 > 1 ++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, &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 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 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 scx = x scy = y c2 = 0 loop for i = 1 to a3 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@ procedure puttrill int h,t1,t2 x = x1 + esksp y = y1 + esksq(eskf12) h = x1 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 h = x1 + eskhpar(41) 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 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 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 if a3 <= 201 a4 = a3 + 2 / 6 * 6 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 6 + 20 /* font number scx = x scy = y scb = a5 scf = 320 perform charout scf = notesize else if a3 <= 402 a4 = a3 + 5 / 12 * 12 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 12 + 10 * 2 /* font number 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 a4 = a3 + 5 / 12 * 12 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 12 - 5 * 3 + 1 /* font number a6 = a4 - 384 /* y increment to third glyph scx = x scy = y scb = a5 scf = 320 perform charout scy += 192 ++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.100,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 = "c:\musprint\bitmap\slurs\bigslur" end if notesize = 21 file = "c:\musprint\bitmap21\slurs\bigslur" end if notesize = 6 file = "c:\musprint\bitmap06\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}) slen += bulge /* &dAadded 11-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, 2=trill &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from obj1 &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 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 i < pd /* extreme left end outd = flt(i) / flt(pc) + .1 else outd = 0.4 end if notesize = 14 outd += .4 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 outd = flt(j) / flt(pc) + .1 else outd = 0.4 end if notesize = 14 outd += .4 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 if notesize = 21 outd = D - 0.4 * a + 0.4 ind = D - 0.6 * a + 0.6 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 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 x1 = x1 * notesize / 14 x2 = x2 * notesize / 14 y1 = y1 * notesize / 14 y2 = y2 * notesize / 14 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 newout 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) &dA &dA &d@ Code substitution &dA03/05/04&d@: To implement "in-line" spacing for display &dA 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 &dA &dK &d@ k = ors(out{i}) + fontoff &dK &d@ setb gstr,FA,scx,scy,k,1 repeat else loop for i = 1 to len(out) &dA &dA &d@ Code substitution &dA03/05/04&d@: To implement "in-line" spacing for display &dA 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 &dA &dK &d@ k = ors(out{i}) + fontoff &dK &d@ setb red_gstr,FA,scx,scy,k,1 repeat end if con2 > 0 and conx2 < scx + 10 conx2 = scx + 10 end else if con1 = 0 loop for i = 1 to len(out) &dA &dA &d@ Code substitution &dA03/05/04&d@: To implement "in-line" spacing for display &dA 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 &dA &dK &d@ k = ors(out{i}) + fontoff &dK &d@ clearb gstr,FA,scx,scy,k,1 repeat else loop for i = 1 to len(out) &dA &dA &d@ Code substitution &dA03/05/04&d@: To implement "in-line" spacing for display &dA 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 &dA &dK &d@ k = ors(out{i}) + fontoff &dK &d@ clearb red_gstr,FA,scx,scy,k,1 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) 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 &dK &d@ activate msgstr,0,904,1 &dK &d@ activate redmsgstr,0,904,4 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" if "BCKTDSNRGQFIM" con jtype 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" 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 &dK &d@ font = 137 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: &dK &d@ getk k perform pgetk (k) /* New &dA11/25/03&d@ 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 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,0,0,160,904 if wflag4 <> 0 setup red_tstr4,160,910,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 else if wflag2 <> 0 setup red_tstr2,160,1600,1,0,0,160,904 end end if wflag3 <> 0 setup red_tstr3,160,1040,1,0,0,160,904 end activate red_gstr,px,py,4 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 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 &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,0,0,160,904 if wflag4 <> 0 setup red_tstr4,160,910,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 else if wflag2 <> 0 setup red_tstr2,160,1600,1,0,0,160,904 end end if wflag3 <> 0 setup red_tstr3,160,1040,1,0,0,160,904 end activate red_gstr,px,py,4 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 if mpt = 2 &dA &dA &d@ Backup (advance) x-coordinate of text sub-object &dA &dK &d@ b = int(line) &dK &d@ if k = 0x03010f or k = 0x030112 or k = 0x030114 &dK &d@ b -= incre &dK &d@ else &dK &d@ b += incre &dK &d@ end &dK &d@ line = tbyte // " " // chs(b) // line{sub..} &dK &d@ if a > 0 &dK &d@ tput [X2,a] ~line &dK &d@ else &dK &d@ ++trecord_cnt &dK &d@ tput [X2,trecord_cnt] ~line &dK &d@ list_order(g,4) = trecord_cnt &dK &d@ end end 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 if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,4 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,4 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,4 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 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 "KWT" 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 = 3 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 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" 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 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] L ~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 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 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 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 &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 if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,4 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,4 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,4 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 = 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 "WTK" 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" 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 "WTK" 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 "HLSX" 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 "WTK" 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" 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 "WTK" 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 "HLSX" 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 &dK &d@ 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" 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 &dK &d@ 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 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 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 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 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 &dK &d@ font = 137 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 &dK &d@ font = 137 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 &dK &d@ scx = MSGTAB1 &dK &d@ if "gjhx" con cmode &dK &d@ out = messages(mpt) &dK &d@ scy = message_row(mpt) &dK &d@ 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 &dK &d@ scx = MSGTAB1 &dK &d@ if "gjhx" con newcmode &dK &d@ out = messages(mpt) &dK &d@ scy = message_row(mpt) &dK &d@ 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(12) 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 if "SL" not_con line{1} 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) &dK &d@ if con2 > 0 &dK &d@ putc .w6 ~eskrec ~line &dK &d@ examine &dK &d@ end &dK &dK &d@ putc .w6 ~eskrec ~line &dK &d@ examine &dK if "ESLXJKAWTHBk" con line{1} 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..}) 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" &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,21] 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 LTY(4): /* 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 notesize = z perform init_par scf = notesize end goto TOP end tline = txt(line,[' '],lpt) x = int(tline) 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(5): /* 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 if jtype = "R" 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(6): /* 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(7): /* line{1} = "A" goto TOP &dA &dA &d@ W O R D S &dA &d@ ÄÄÄÄÄÄÄÄÄ &dA LTY(8): /* 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(9): /* 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(10): /* 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) if notesize = 6 i = 103 end if notesize = 21 i = 112 end if notesize = 14 i = 108 end 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 perform putslur 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(11): /* 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(12): /* line{1} = "k" 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 &dA &dA &d@ &dA03/15/04&d@ Changing sizenum to range from 1 to 12 &dA if notesize = 6 sizenum = 3 end if notesize = 14 sizenum = 8 end if notesize = 21 sizenum = 11 end &dK &d@ if notesize = 14 &dK &d@ sizenum = 1 &dK &d@ end &dK &d@ if notesize = 21 &dK &d@ sizenum = 2 &dK &d@ end &dK &d@ if notesize = 6 &dK &d@ sizenum = 3 &dK &d@ end &dA &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) = 4 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 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(4) = 3 eskhpar(5) = 13 eskhpar(6) = 80 eskhpar(8) = 200 eskhpar(9) = 2250 eskhpar(12) = 80 eskhpar(17) = 14 eskhpar(19) = 4 eskhpar(20) = 20 eskhpar(21) = 300 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(4) = 1 eskhpar(5) = 6 eskhpar(6) = 34 eskhpar(8) = 85 eskhpar(9) = 1050 eskhpar(12) = 35 eskhpar(17) = 7 eskhpar(19) = 2 eskhpar(20) = 9 eskhpar(21) = 130 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(4) = 5 eskhpar(5) = 19 eskhpar(6) = 110 eskhpar(8) = 200 eskhpar(9) = 2250 eskhpar(12) = 100 eskhpar(17) = 21 eskhpar(19) = 6 eskhpar(20) = 30 eskhpar(21) = 300 eskhpar(29) = 3 eskhpar(30) = 19 eskhpar(33) = 9 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 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 eskhpar(7) = 4 * notesize &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 eskhpar(22) = 6 * notesize / 16 eskhpar(23) = 60 * notesize / 16 eskhpar(24) = 7 * notesize + 2 / 7 &dA &d@ eskhpar(25) = notesize + 1 &dA &d@ eskhpar(26) = 15 * notesize / 16 eskhpar(27) = 0 eskhpar(28) = 0 - 32 * notesize / 16 &dA &d@ eskhpar(29) = 2 * notesize + 8 / 16 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 eskhpar(49) = 24 * notesize / 16 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 if notesize = 21 eskhpar(11) = 250 eskhpar(30) = 22 eskhpar(39) = 50 eskhpar(42) = 76 eskhpar(49) = 32 eskhpar(50) = 16 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 loop for i = 1 to 223 pos(i) = urpos(i) * notesize repeat &dA &dA &d@ Dotted mask (modified &dA10/23/03&d@) &dIOK&d@ &dA &dK &d@ gapsize = 3 * notesize / 4 &dK &d@ cycle = dup("1",gapsize) // dup("0",gapsize) 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 dotted = "" i = 2500 - (2 * gapsize) loop dotted = dotted // cycle repeat while len(dotted) < i #if NEWFONTS &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 &dK &d@ loop for a = 1 to 24 &dK &d@ revmap(a) = revsizes(a) &dK &d@ repeat &dK &dK &d@ loop for a = 1 to 12 &dK DONE AT THE TOP &dK &d@ revmap(100+a) = a + BEAM_OFFSET &dK &dK &d@ repeat &dK &d@ revmap(114) = 13 + BEAM_OFFSET 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) #else &dA &dA &d@ Set screen font map &dA if notesize = 14 revmap(30) = 16 revmap(31) = 1 revmap(32) = 2 revmap(33) = 3 revmap(34) = 4 revmap(37) = 5 revmap(38) = 6 revmap(39) = 7 revmap(44) = 8 revmap(46) = 9 revmap(14) = 10 revmap(01) = 10 /* added &dA01/13/04&d@ revmap(106) = 11 revmap(108) = 12 revmap(300) = 13 revmap(400) = 14 revmap(200) = 17 revmap(320) = 52 end if notesize = 21 revmap(30) = 33 revmap(31) = 18 revmap(32) = 19 revmap(33) = 20 revmap(34) = 21 revmap(37) = 22 revmap(38) = 23 revmap(39) = 24 revmap(44) = 25 revmap(46) = 26 revmap(21) = 27 revmap(01) = 27 /* added &dA01/13/04&d@ revmap(109) = 28 revmap(112) = 29 revmap(300) = 30 revmap(400) = 31 revmap(200) = 17 revmap(320) = 52 end if notesize = 6 revmap(30) = 50 revmap(31) = 35 revmap(32) = 36 revmap(33) = 37 revmap(34) = 38 revmap(37) = 39 revmap(38) = 40 revmap(39) = 41 revmap(44) = 42 revmap(46) = 43 revmap(06) = 44 revmap(01) = 44 /* added &dA01/13/04&d@ revmap(102) = 45 revmap(103) = 46 revmap(300) = 47 revmap(400) = 48 revmap(200) = 17 revmap(320) = 52 end if scf > 0 a = revmap(scf) a = a - 1 / 17 if notesize = 14 a = rem + 1 end if notesize = 21 a = rem + 18 end if notesize = 6 a = rem + 35 end loop for i = 1 to 400 if revmap(i) = a scf = i i = 400 end repeat end #endif 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 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@ C:\MUSPRINT\NEW\XFONTS\TMS\eskpars.z &dA &d@ procedure get_hght_dpth #if NEWFONTS 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 #else &dA &dA &d@ Maximum height of screen fonts above cursor position &dA &d@ (2nd parameter in font header record) &dA hght(1) = 31 hght(2) = 30 hght(3) = 30 hght(4) = 36 hght(5) = 38 hght(6) = 38 hght(7) = 38 hght(8) = 46 hght(9) = 54 hght(10) = 29 + 28 hght(11) = 15 hght(12) = 15 hght(13) = 23 hght(14) = 7 hght(15) = 15 hght(16) = 19 hght(17) = 19 hght(18) = 46 hght(19) = 47 hght(20) = 49 hght(21) = 52 hght(22) = 57 hght(23) = 60 hght(24) = 58 hght(25) = 72 hght(26) = 80 hght(27) = 44 + 42 hght(28) = 15 hght(29) = 15 hght(30) = 69 hght(31) = 8 hght(32) = 6 hght(33) = 19 hght(34) = 16 hght(35) = 13 hght(36) = 12 hght(37) = 12 hght(38) = 15 hght(39) = 16 hght(40) = 16 hght(41) = 16 hght(42) = 19 hght(43) = 23 hght(44) = 13 + 12 hght(45) = 15 hght(46) = 15 hght(47) = 23 hght(48) = 5 hght(49) = 6 hght(50) = 8 hght(51) = 8 hght(52) = 60 &dA &dA &d@ Maximum depth of screen fonts below cursor position (4th - 2nd parameter) &dA dpth(1) = 11 dpth(2) = 12 dpth(3) = 11 dpth(4) = 12 dpth(5) = 14 dpth(6) = 14 dpth(7) = 14 dpth(8) = 17 dpth(9) = 19 dpth(10) = 35 + 28 dpth(11) = 21 dpth(12) = 23 dpth(13) = 24 dpth(14) = 7 dpth(15) = 6 dpth(16) = 7 dpth(17) = 7 dpth(18) = 16 dpth(19) = 17 dpth(20) = 15 dpth(21) = 17 dpth(22) = 19 dpth(23) = 19 dpth(24) = 21 dpth(25) = 24 dpth(26) = 27 dpth(27) = 52 + 42 dpth(28) = 24 dpth(29) = 27 dpth(30) = 72 dpth(31) = 8 dpth(32) = 6 dpth(33) = 7 dpth(34) = 6 dpth(35) = 4 dpth(36) = 4 dpth(37) = 4 dpth(38) = 4 dpth(39) = 5 dpth(40) = 5 dpth(41) = 5 dpth(42) = 6 dpth(43) = 7 dpth(44) = 15 + 12 dpth(45) = 17 dpth(46) = 18 dpth(47) = 24 dpth(48) = 6 dpth(49) = 2 dpth(50) = 3 dpth(51) = 3 dpth(52) = 20 #endif return &dA &dA &dA End of GIANT #if XVERSION section #endif run