╔══════════════════════════════════════╗ ║ MSKPAGE.Z and Related Programs ║ ╚══════════════════════════════════════╝ Program to assemble linear i-files into sets of systems for page specific output Version 4.2 (rev. 04/12/10) This source code is used to generate five programs: mskpage.z xmskpage.z spaging.z mscroll.z scrpage.z Four of these programs are currently in active use, and have the following relationship: Output to pages Scroll output (SCROLL_OUT = 0) (SCROLL_OUT = 1) ┌────────────────────┬────────────────────┐ Regular output, │ mskpage.z │ mscroll.z │ no paramters │ Pars = (0,0) │ Pars = (0,1) │ (SCORE_PARS = 0) │ │ │ ├────────────────────┼────────────────────┤ Include score │ spaging.z │ scrpage.z │ parameters │ Pars = (1,0) │ Pars = (1,1) │ (SCORE_PARS = 1) │ │ │ └────────────────────┴────────────────────┘ Compiling Paramaters (SCORE_PARS, SCROLL_OUT) The mskpage.z and mscroll.z programs are run from score type libraries, e.g., score, skore, parts, etc., in various sizes In contrast, the spaging.z and scrpage.z programs can only be run from the scrcon library. The reason is that these problems rely on extra parameters generated only by autoscr, which puts its output in scrcon. By convention, the output to multiple pages (SCROLL_OUT = 0) should be directed to the library pages within the working library (described above). The output to a single scrolling page (SCROLL_OUT = 1) should be directed to the library spage in the same working library. mskpage and its derivitives take advantage of a format file in the library formats (in the working directory), if one has been created. If extensive work has been done on formatting page output, the interline spacings (system spacings) may have become skewed in various ways that would be undesirable for simple scrolled output. For this reason, there may be a second format library called sformats containing format files for use only with mscroll.z and scrpage.z. Version control ─────────────── 03-25-06 Adding code to construct "@ MVT:", "@ SYSTEM:" "@ SOURCE:", "@ LINE:" and "@ TEXT:" records. 11-12-06 Fixing a small bug 11-20-06 Adding an option for running a "simple test" 11-20-06 Fixing a minor bug related to right justification 02-09-07 Fixing a minor bug related whole rests 10-15-07 Adding a feature that allows a line of music with non floating rests to be removed if capital letters were used to denote the rest type. In this situation the autoset/autoscr program denotes rests with jtype = "r" instead of jtype = "R". Mskpage treats the small r as a flag, and substitutes a capital R in the output file (we hope). 11-02-07 I need to do something about the case where there is a key change at the end of a line 05-06-08 I found an area of mskpage which seems to be incomplete This showed up in a case where a first ending was quite long--spanning two pages, and starting at the beginning of a line, i.e., thrown over from the bar line on the previous page. I think I have written some robust code to deal with this situation, but this code does not deal with the case where an ending neither starts nor ends on a page. Furthermore, this problem may extend to other horizontal lines as well, in which case the algorithm may need to be extended. 06-09-08 Referring to the previous entry, it turns out that mskpage was deficient in dealing with several super-object types extending over more than two systems. I have chosen to fix only one of these cases at this time, namely dashes. The fix requires new code in three places: 1) setting superdata(f12,k,6) = 234567 when an incomplete dashes super-object is encountered at the end of a system. This is a magic number for dashes only. 2) When processing a part on a new system, if superdata(f12,k,6) = 234567, then set superdata(f12,k,7) = 1. This signals an incompelete dashes super-object at the beginning of a system. 3) Mskpage already tries to typeset incomplete (split) super-objects at the end of a system line; the problem was that if the object starting the super-object was not also on that line, then there was no start and therefore no visable super_object. Now, for dashes, if superdata(f12,k,7) = 1, an object mark is placed at the beginning of the line. 4) Of course, superdata(f12,k,6) and superdata(f12,k,7) must now be initialized to zero whenever a new super-object is encountered. I think this type of code will also work for octave transpositions, but not for slurs or wedges. 10-08-08 When typesetting parts, we sometimes want a wider page format. I am introducing a compile variable WIDE, which when set will widen the horizontal limits on systems. 10-08-08 mskpage has the annoying feature of placing the measure numbers where they can get in the way of other things at the beginning of the line. I changed this. Lets see how we like the new code. 10-31-08 I added a feature to autoset, which recognized the subdivision of multiple rests into smaller units. Under normal conditions when making parts, mskpage handles this just fine. But if mskpage is used for comparing parts, this feature caused some measures to be "double counted," thus throwing off the counters and flags. The problem and its "fix" are described in more detail in the code. Like many fixes however, there may be some unwanted side effects. 11-06-08 There is a corner case I don't understand yet. It can result in delta being 0 unexpectedly at a point in the line adjustment loop, which leads to code failure. To avoid this, I include code which terminates the line adjustment loop when delta = 0, but the corner case still exists. 01-01-09 Adding notesize 16 01-01-09 Expanding on the "wide" score feature. The 4th line of the formats file may now contain extra words which can be used to set the horizonal margins of the system. If the word "wide" is found in the line, mskpage looks for two numbers. These are interpreted as the number of dots, left and right, to expand the margins. If no numbers are found, the defaults are 100 and 100 dots. 01-29-09 I have encountered a new problem with object order. When there is a clef change at the end of a measure, and this is preceded by grace notes at the end of that measure, the autoset program does the predictable thing, i.e., set the grace notes first, then the clef change. But mskpage thinks that grace notes at end of a measure can only be followed by more grace notes or by a bar line. I'm not sure what the global "fix" for this problem is; object order has always been problematic in this program. What I propose here is a simple "case fix." I have found a place in the program where a call to getcontrol caused the control record crec to actually back up. Since this, in theory, should never happen, and since this occurs specifically when grace notes at the end of a measure are followed not by a bar line but by an end-of-meausre clef change, I have added some code to negate this backup. For the moment, this seems to fix the problem. Stand by. 01-29-09 Adding a small feature that allows the instrument designation for the grand staff (e.g., Pf) to be placed midway between the the staves 02-01-09 Guess what! We really did run out of super-object capacity. We need to make this bigger. The limit is now N_SUPER. 02-13-09 Well, I found the place where mskpage was misallocating space for multiple rests at the beginning of a system line (parts only). It's fixed now (I think). 03-06-09 There needs to be a way to enter the "wide" command when there is no format file (or when a new format file is being compiled). 11-30-09 Adding the "scrolling" versions of mskpage.z and spaging.z ╔════════════════╗ ║ PAGING ║ ║ ============ ║ ║(rev. 10/04/07) ║ ╚════════════════╝ This program is the second of a set of three programs designed to convert MUSEDATA Stage 2 full-score files into SCORE pmx files. The program was originally based on the 2.2 version (rev. 12/04/00) of mskpage. The current version is merged with mskpage on 10/12/07. The input to the program are non page specific I-files, with additional information attached by the autoscr program. While compiling page files, the paging program has new, additional tasks to perform. It must pass on information from non page specific i-files to page specific i-files which the mskpage program does not have to deal with. The paging program may also provide additional processing that will make scorecon's job easier. In particular, there is a lot of information relating to horizontal and vertical position, which is being generated for the first time by paging and which translates directly into SCORE parameters. Since versatility of size is not a consideration in data conversion, the paging program is designed to operate at one size only, namely, size-14. #define XVERSION 0 #define SCORE_PARS 0 /* (makes spaging.z) #define SCROLL_OUT 0 /* (makes mscroll.z) #define DISP_DISK "j" Program modifications #define ADD112506 1 #define OVERRUN 1 #define BEAM_OFFSET 12 #define TIE_OFFSET 25 #define LARGE_BRACK 42 #define SMALL_BRACK 43 #define MEAS_SUGG 1 #define NOTEZ 14 #define M_NUM_FONT 37 #define UP 0 #define DOWN 1 #define NAMELEN 17 #define MREPORT 0 #define REPORT 0 #define REPORT2 0 #define SHOWLARR 0 #define SUPERSIZE 128 #define MAX_BNOTES 32 #define N_SUPER 16 /* New 02/01/09 #define LIM1 20000 #define INT100 100 #define PRE_DIST 1 #define MNODE_TYPE 2 #define TIME_NUM 3 #define SNODE 4 #define ACT_FLAG 5 #define M_ADJ 6 #define MARR_TEMP 7 #define MARR_PARS 7 #define YES 0 #define NO 1 #define TRUE 0 #define FALSE 1 #define ON 0 #define OFF 1 #define OPT_INST 0 #define CONTINUO 0 #define MAGIC1 300 #define WIDE 0 #define BIG16 1 *process X #define statements brought over from ESKPAGE #define UP 0 #define DOWN 1 #define REPORT3 0 #define SUPERSIZE 128 #define SUPERMAX 50 #define MAX_BNOTES 32 #define LMARG 30 #define RMARG 1200 #define RMARG 1000 #define TMARG 50 #define BMARG 820 #define BMARG 720 #define LMARG2 400 #define RMARG2 800 #define TMARG2 300 #define BMARG2 600 #define MSGTAB1 20 #define MSGTAB2 220 #define MSGTAB3 420 #define MSGTAB4 680 #define MSGTAB5 20 #define MSGTAB5A 140 #define MSGTAB6 600 #define MSGTAB6A 670 #define MSGROW1 20 #define MSGROW2 40 #define MSGROW3 60 #define MSGROW4 80 #define MSGVLOC 0 #define MSGFONTZ 6 #define MSGFONT 34 #define MSGLINOPT 0 #define LMRG1 8 #define LMRG2 4 #define LMRG3 3 #define LMRG4 2 #define TMRG1 146 #define TMRG2 73 #define TMRG3 49 #define TMRG4 37 #define TOP_FLAG 0 #define BOTTOM_FLAG 1000000 #define N_SIZES 12 #define TIE_DISTS 200 #define DOT_CHAR 44 #define MACFILE "mskmac.k" str file.280,out.10000,line.280,line2.180,temp.180,temp2.180,temp3.180,temp1.180 str line3.180 str bigline.1000 str inlib.100,tline.180,outlib.100 str ttext.180,linepiece.180(5) str jtype.1,htype.1,xbyte.10(32),cjtype.1 str beamcode.6(MAX_BNOTES),syscode.80,superline.180,savesyscode.80 str formatfile.200 #if SCROLL_OUT int ldist,larr(30000,MARR_PARS),marr(6000,MARR_PARS),larc,marc,tarr(32) int tdist(32,2),nflg1,rflag(2000),barcount,barpar(2000,3) #else int ldist,larr(300,MARR_PARS),marr(60,MARR_PARS),larc,marc,tarr(32) int tdist(32,2),nflg1,rflag(40),barcount,barpar(40,3) #endif int tarr2(32),tarr3(32),tarr4(32,4),tarr5(32,2) int adjarr(300,4),adjarc,small(300),scnt,pdist,larc2 int textflag,cflag,stopflag int endflag,oldmpoint,dxoff(32),dyoff(32),oldmp2,firstpt,point int prev_point,point_adv int delta,rec,crec,saverec,endbarrec,drec(32) int beamh,beamt,beamfont,stemchar int backloc(32),uxstart(32),uxstop(32) int nuxstop(32) int savenoby(32) int hxpar(25),hpar(32,25),vpar(32,41),zak(2,7),vpar20(32) int a,b,c,d,e,g,h,i,j,k,n,x,y,z int q(12) int df,delta_e /* delta_e New 10/14/07 int @a,@b,@c,@d,@e,@k,@m,@q,@r int a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12,a13,a14 int c1,c2,c3,c4,c5,c6,c7,c8,c9,c10,c11,c12,c13,c14,c15,c16,c17,c18,c19,c20 int q1,q2,q3,q4,q5 int f(32,17),f1,f2,f3,f4,f5,f11,f12,f13 int notesize,mtfont,snode,dincf,supcnt,textlen,maxnotesize int barnum,oldbarnum,newbarnum int cntype,coby,cz,csnode int cdincf(32),ndincf(32),oldcdincf int rmarg,lowerlim,toplim int false_rmarg int superdata(32,N_SUPER,SUPERSIZE),supermap(32,N_SUPER),superpnt(32,N_SUPER) /* N_SUPER is New 02/01/09 int sp,sq(32),vst(32),psq(32) int x1,x2,y1,y2 int bcount,beamdata(MAX_BNOTES,2),bstem(MAX_BNOTES,2) int ntype,stem,key(32),clef(32,2),tcode(32),savtcode(32) int oby,sobx,soby,supernum int sobx2,saved_sobx2 int sitflag,tspan int page,sysh,syslen,sysy,gbar(2),gbarflag,tplace int w(32) int olddist(32),bolddist(32),obx,dvar1,dvar2,dv3,dv4,olddv1(32),cdv int oldcdv,cdv_adv,backtxobrec int lpt int firstbarflag int spc(255), curfont int start_beam(2),stop_beam(2) table X(400000) table Y(400000) table Z(400000) Variables added to enable mskpage to right justify last line str tacetline.180,mvtline.180 int formatflag,justflag int syscnt,maxsystems int sysbarpar(400,5) int old_sysbarpar(400,2) int sav_sysbarpar(400,5) int savec int mspace(2000),mcnt int deadspace,lastk int old_extra,average_extra int start_look int new_start_look int start_sys int sys_count Variables added to enable mskpage to position numbers in the middle of measures. int half_back Variables added to deal with ties that cross system boundaries str temp4.20 int conttie(32) int trec Variable added to deal with measures that are not fungable space-wise int adj_space int small2(300),scnt2 int single_meas Variables added for 3.0 version str outfile.280 int forp,forpz int mainyp,sv_mainyp int y1p,y2p,y3p int pn_left table F(1000) #if SCROLL_OUT table T(300000) #else table T(30000) #endif real rx,ry,rz Variables added for extended format files #if SCROLL_OUT int plarr(30000,2),cum_larr(30000,2),larr_gen(200000),cum_larrz #else int plarr(300,2),cum_larr(300,2),larr_gen(20000),cum_larrz #endif int plarc,psysnum,edflag,larrx,cum_x,barcum_x Variables added for implementing optional staff lines int rest7,intersys,firstsys,f11out,mnum,bottom_sq,tf11 int tsq(32),tvst(32),tnotesize(32),sys_bottom Variables added for implementing tag records str abbr.40(200) int recflag(400000),abbr_cnt,current_recf int type1_dflag(32),type2_dflag(32) int save_type1_dflag(32),save_type2_dflag(32) Variables added for dealing with NEWFONTS 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 Variables added for extended music fonts int dummy(12) int extendoff(12) Variables added for dealing with mid-movement justification int t1,t2,t3,t4,t5,t6,t7 int sys_jflag int new_syscnt(80),new_maxsystems(80),section_cnt int mcnts(5000) int mspace2(20000) int no_action Variables for looking inside directories str dir_contents.20(2000) int dir_size Variables added for dealing with wider margins 01/01/09 table GN(100) Variables added to distinguish between pages and spage output int max_larc Variables added to the paging program (the SCORECON project) 03/25/03 mrest_data(32) = string containing P7 data for mrests while being set header1 = header string for SCORECON I-files header2 = contains composer and source header3 = contains work number and title header4 = contains page number table Y = output table xx(20) = work space str mrest_data.80(32) str header1.180 str header2.180 str header3.180 str header4.80 int xx(20) Variables added for dealing with single line staff str lbyte.1 int stave_type Variables added for dealing "@" records str andata_file.200 str composer_work.80 str @system.120 str @line.50(50) str @sources.200(50) int andata_flag int tq_size Variables added for running a "simple test" 11/20/06 int simple_test Variable added to try to fix an end-of-measure bug 11/25/06 str last_jtype.1 Variable added to throw directives a the end of lines to the following line 11/21/07 int new_direct(100,2) int save_direct(100,2) int new_dircnt int save_dircnt Variables added to fix a problem with P3 data 11/24/07 int p3_fix(100) int p3_fixcnt int p31,p32 int p31a,p32a int sgnp31,sgnp31a int pp3,pp3a table Q(1000) Variables transferred from ESKPAGE #if XVERSION str tiefile.280(4) str textline.232 str tbyte.1,save_jtype.1 str eskxbyte.1(10) str quote.1 str esksyscode.50 int eskdyoff(10),eskbackloc(10),ibackloc(10) int eskuxstart(10),eskuxstop(10),buxstop(10) int eskrec,esksaverec,trec2 int beamfy,qwid,bthick int underflag int pos(256),urpos(256),underspc(12),hyphspc(12) int wak(9),eskhpar(63),eskvpar(45),eskvpar20 int q(12),beamext(435,12),tiearr(N_SIZES,4,TIE_DISTS,12) int eskf(32,10),f01,f03,f04,eskf11,eskf12 int msknotesize int esksuperdata(SUPERMAX,SUPERSIZE),esksupermap(SUPERMAX),esksuperpnt(SUPERMAX) int tupldata(7),tbflag int esksp,esksq(32),eskvst(32) int z1,z2,z3 int d1,d2 int hd,vd,tiechar,tcnt,textend,expar(8) int esksysy,esksysh,esksyslen,sysflag,sysnum,esksysright int barbreak(10,2),brkcnt int addcurve int music_con(255) int ntext,tlevel int postx,posty int tpost_x,tpost_y,tpost_leng /* add 04/20/03 int figoff(32) /* add 09/14/03 int nsz(32) /* add 11/13/03 int govstaff /* add 11/13/03 int savensz /* add 11/13/03 int savesub /* add 11/13/03 int barlinks(1000) /* added 12/06/03 int barlink_cnt /* added 12/06/03 table X(100000) table X2(1000) variables added to make screen display work int FA(750000) int activefont str gstr.3000000,tstr2.260000,tstr3.170000,tstr4.150000 str red_gstr.940000,red_tstr2.260000,red_tstr3.170000,red_tstr4.150000 str blue_horiz1t.400,blue_horiz2t.200,blue_horiz3t.150,blue_horiz4t.130 str blue_horiz1b.400,blue_horiz2b.200,blue_horiz3b.150,blue_horiz4b.130 str blue_vert1v.3500,blue_vert2v.1850,blue_vert3v.1300,blue_vert4v.1020 str blue_vert1r.3500,blue_vert2r.1850,blue_vert3r.1300,blue_vert4r.1020 int xco, yco int xze, yze str zline.80 int curdist int altflag int scx,scy,scf,scb variables added for printing long slurs str longslur.320(250) int slur_edit_flag bstr bt.2500(250) bstr dotted.2500 int gapsize variables added for editing int pointers(2000,10) int nodelist(1000,2) int super_pointers(500,4) int nodelistcnt int object_count,nodenum,measnum int super_count int linepoint,syspoint,curnode,savecurnode int xbacknode,xsavecurnode,xupnode int grand_space,oldrestx int trigger int obcursor,supercursor,relob_cnt,related_objects(2000) int o(8) int oldk,ptoggle str messages.180(40),sub_def.30(255),obj_def.30(15),super_def.30(12) str cmode.1,newcmode.1,rectype.1 str current_line.180,new_line.180 str current_def.180,new_def.180 int message_row(4) int X_point,table_size,SX_point int temp_store_ob(200,2) int system_rec(30),system_cnt int list_order(10000,5) str curdata.30(20) int CURSOR(25) bstr tbstr.800 str curstr.200 str msgstr.20000 str redmsgstr.20000 int xcur, ycur,x2cur,y2cur,acur,bcur str gline.360 int trecord_cnt int con1,con2,con3,con4 int conx1,cony1,conx2,cony2 int hght(140),dpth(140) int incre,textoff int aa,gg,hh str ttline.120 variables added for macros 11/25/03 str macfile.280 int macros(8,100),macstrokes(8),macchange int macropnt(8) #endif Start Program Code trace cum_larr(1,1) trace cum_larr(2,1) trace cum_larr(3,1) trace cum_larr(4,1) trace cum_larr(5,1) trace cum_larr(6,1) trace cum_larr(7,1) trace cum_larr(8,1) used in finding a problem with "double counting" trace marr(1,1) of measures. trace larr(1,1) trace larr(2,1) trace larr(7,1) trace barcount trace larc mtfont = 31 cdv = 0 backtxobrec = 0 saved_sobx2 = 100 perform newfont_init #if XVERSION perform start_xversion #endif #if SCORE_PARS putc putc ╔═════════════════════════════════════════╗ putc ║ MUSEDATA to SCORE conversion process ║ putc ║ ==================================== ║ putc ╚═════════════════════════════════════════╝ putc putc Part II: Building page specific I-files from non page specific I-files putc putc The home directory for this window should be directory putc the OUTPUTS/SCRCON sub-directory the musical work you are putc converting. You should see the I-FILES sub-directroy in putc an F4 listing, and if there is no PAGES sub-directory, you putc should allocate one, as well as the necessary movement putc sub-directories inside PAGES, corresponding to the movements putc in I-FILES. putc putc #endif putc Make page files from intermediate files putc LIBQ1: putc Input Library name? getc inlib inlib = trm(inlib) if inlib = "" goto LIBQ1 end if inlib con ":" or inlib{1} = "/" else getdir line inlib = line // "/" // inlib end temp = inlib inlib = inlib // "/" LIBQ2: putc Output Library name? getc outlib outlib = trm(outlib) if outlib = "" goto LIBQ2 end if outlib con ":" or outlib{1} = "/" else getdir line outlib = line // "/" // outlib end putc starting number getc a1 putc number of parts getc f11 Look for format file and (03/25/06) andata file formatfile = "" formatflag = 0 @a = 0 andata_flag = 0 andata_file = "" @b = 0 #if SCROLL_OUT @c = 0 #endif i = 0 if a1 = 1 perform look_dir (temp) if dir_size = f11 if temp con "i-files" temp3 = temp{mpt..} temp = temp{1,mpt-2} if temp3 con "/" temp3 = temp3{mpt+1..} temp3 = trm(temp3) /* this is a mvt name (usually a number) end perform look_dir (temp) loop for i = 1 to dir_size temp2 = dir_contents(i) temp2 = temp2 // pad(7) if temp2{1,7} = "formats" @a = 1 end if temp2{1,6} = "andata" @b = 1 end #if SCROLL_OUT if temp2{1,8} = "sformats" @c = 1 end #endif repeat end end end For the "scrolling version," look for an sformats library first #if SCROLL_OUT if @c = 1 temp1 = temp // "/sformats" perform look_dir (temp1) j = 0 if dir_size > 0 loop for j = 1 to dir_size temp2 = dir_contents(j) temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = trm(temp2) if temp2 = temp3 j = 10000 end repeat end if j = 10000 /* we found a format file in sformats formatflag = 1 @a = 0 /* so don't use the formats library end formatfile = temp1 // "/" // temp3 end #endif if @a = 1 temp1 = temp // "/formats" perform look_dir (temp1) j = 0 if dir_size > 0 loop for j = 1 to dir_size temp2 = dir_contents(j) temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = trm(temp2) if temp2 = temp3 j = 10000 end repeat end if j = 10000 formatflag = 1 end formatfile = temp1 // "/" // temp3 end Look for "andata" file here (03/25/06) and get data Set up @system and @line(.) strings Don't include andata in score conversions #if SCORE_PARS @b = 0 #endif if @b = 1 temp1 = temp // "/andata" perform look_dir (temp1) j = 0 if dir_size > 0 loop for j = 1 to dir_size temp2 = dir_contents(j) temp2 = temp2 // pad(8) temp2 = temp2{1,8} temp2 = trm(temp2) if temp2 = temp3 j = 10000 end repeat end if j = 10000 andata_flag = 1 end andata_file = temp1 // "/" // temp3 open [5,1] andata_file getf [5] composer_work composer_work = trm(composer_work) loop for j = 1 to 1000 getf [5] temp tput [Q,j] ~temp repeat eof5: close [5] tq_size = j - 1 tget [Q,1] temp @system = "@ SYSTEM: " // composer_work // " -- " // temp{10..} loop for j = 2 to tq_size tget [Q,j] temp if temp{8} = "L" k = int(temp{10..}) if temp con ">" @line(k) = "@ LINE: " // chs(k) // " " // temp{mpt+2..} end end repeat end Transfer source files to X table putc transferring ... k = 0 abbr_cnt = 0 loop for f12 = 1 to f11 current_recf = 0 ++k f(f12,1) = k if a1 < 10 file = inlib // "0" // chs(a1) else file = inlib // chs(a1) end open [2,1] file getf [2] line spaging code #if SCORE_PARS line = line // pad(30) if line{1,15} <> "SCORECON I-FILE" putc putc The i-files you are using were not created by autoscr and cannot putc be read properly by the paging program. The SCRCON and SCORE putc directories are very similar. Be sure you are in the SCRCON directory. putc putc Bye for now. putc stop end header1 = "SCORECON PAGE I-FILE. " // line{19..} getf [2] line header2 = line getf [2] line header3 = line getf [2] line Set line flag f(f12,15) = 1 if line{1} = "l" f(f12,15) = 2 end vst(f12) = int(line{3..}) /* first numerical parameter in top line f(f12,9) = int(line{sub..}) /* second numerical parameter in top line f(f12,14) = int(line{sub..}) /* third numerical parameter in top line f(f12,16) = 50 /* transposition f(f12,17) = 1 /* instrument number line = line{sub..} line = mrt(line) if line con "|" line2 = line{1,mpt-1} /* strip NTRACK data and transposition data line = line{mpt+1..} if line con "TRANS=" f(f12,16) = int(line{mpt+6..}) end if line con "INSTN=" f(f12,17) = int(line{mpt+6..}) end New 08/24/03 #if OPT_INST if line2 con "[" line2 = "" end #endif tput [Z,k] ~line2 end xmskpage code #else Get "@ SOURCE:" record (03/25/06) if there is one if line{1,9} = "@ SOURCE:" line = line // pad(40) if line{11,6} <> " " @sources(f12) = line{11..} else @sources(f12) = "not specified" end getf [2] line else @sources(f12) = "not specified" end Set line flag f(f12,15) = 1 if line{1} = "l" f(f12,15) = 2 end vst(f12) = int(line{3..}) /* vertical offset to second staff (or 0) f(f12,9) = int(line{sub..}) /* vertical offset to text line f(f12,14) = int(line{sub..}) /* note size if sub <= len(line) line = line{sub..} line = mrt(line) /* part name else line = "" end #if OPT_INST if line con "[" line = "" end #endif tput [Z,k] ~line #endif End of split recflag(k) = current_recf 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 end c1 = 0 loop getf [2] line line = line // " " if line{1} = "T" c2 = int(line{3..}) if line{sub} = "|" c2 = int(line{sub+1..}) end c2 = int(line{sub..}) if c1 < c2 c1 = c2 end end Code to deal with Tags if line{1} = "Y" /* This is a tag. Don't store it. if line{3} = "P" /* abbr part name if line{5} = "0" current_recf &= 0xff00 /* turn off abbr flag completely else ++abbr_cnt abbr(abbr_cnt) = line{5..} current_recf &= 0xff00 /* turn off any previous pointer current_recf += abbr_cnt /* and store new pointer end end if line{3} = "U" /* line control code c3 = int(line{5}) if c3 < 0 or c3 > 2 putc Invalid line control code: line = ~line stop end current_recf &= 0x00ff /* turn off any previous control code current_recf += (c3 << 8) /* and store new code end else #if SCORE_PARS if line{1,3} = "J B" if line con "|" line = line{1..mpt-1} /* strip NTRACK data end end #endif ++k tput [Z,k] ~line recflag(k) = current_recf /* Flag every record end repeat eof2: close [2] f(f12,2) = k if c1 = 0 c1 = 1 end f(f12,13) = c1 This code is put in to insure that searches do not extend beyond the end of a particular i-file ++k line = " " /* dummy line, beginning with " " tput [Z,k] ~line recflag(k) = 0 /* rec flag is 0 #if SCORE_PARS initialize superpnt(.,N_SUPER), supermap(.,N_SUPER), superdata(.,N_SUPER,SUPERSIZE) drec(.), savenoby(.), uxstop(.), nuxstop(.), dxoff(.) dyoff(.), uxstart(.), backloc(.), xbyte(.) loop for j = 1 to N_SUPER /* N_SUPER is New 02/01/09 superpnt(f12,j) = 0 supermap(f12,j) = 0 loop for h = 1 to SUPERSIZE superdata(f12,j,h) = 0 repeat repeat drec(f12) = 0 savenoby(f12) = 0 uxstop(f12) = 0 nuxstop(f12) = 0 dxoff(f12) = 0 dyoff(f12) = 0 uxstart(f12) = 0 backloc(f12) = 0 xbyte(f12) = "**********"{1,f(f12,13)} #endif ++a1 repeat putc done! New 11/24/07 We need to fix a disconnect in the score generation process. When autoset generates notes on the same time node but with different obx positions, it puts them out in an unpredictable order. If there is a global x shift, this value is represented with a "P3=" field in the object record, and a "P10=" field in the note head ("K") records. The disconnect occurs when the object with the "unshifted" position does not come first. It appears that mskpage uses the first instance of an object on a time node as the source for the "official" position for that node. This is the position that lines up with other parts having objects at that time position. This doesn't present a problem for Dmuse typesetting, but it does create a problem for with the P3 parameter in score typesetting. Specifically, when the first instance of an object on a time node is NOT the official position, then the P3 value for all objects in this part on this node will NOT match the P3's in the other parts. I propose the following fix, which need only be done by autoscr and which should NOT effect the actual position of things. We need to read through the entire source (Table Z) and look for those places where note/rest objects have a "P3=" field. If this is the first instance of a note/rest object on that time node, then we need to identify all of the note/rest objects on that time node set their "P3=" fields and "P10=" fields in relation to what would be an "unshifted" first object. I apologize in advance for the strungout nature of this code. #if SCORE_PARS a3 = -1 loop for i = 1 to k tget [Z,i] line .t5 a1 a1 a1 a1 a1 line = line // pad(3) if line{1,3} = "J B" a3 = -1 end if line{1,3} = "J N" or line{1,3} = "J R" if a1 = a3 /* make sure a1 is "new" goto FPP03 end a3 = a1 if line con "P3=" /* shifted object at "new" time node p3_fixcnt = 1 p3_fix(1) = i j = i + 1 FPP01: tget [Z,j] line .t5 a2 a2 a2 a2 a2 if line{1} = "J" if a2 = a1 line = line // pad(3) if line{1,3} = "J N" or line{1,3} = "J R" ++p3_fixcnt p3_fix(p3_fixcnt) = j end ++j goto FPP01 else goto FPP02 end end if line{1} = "E" /* emergency exit goto FPP02 end ++j goto FPP01 FPP02: i = j - 1 /* advance "i" if p3_fixcnt = 1 /* "do nothing" case (shouldn't happen) goto FPP03 end p31 = 0 p32 = 0 a4 = p3_fix(1) tget [Z,a4] line .t5 a5 a5 if line con "P3=" /* remove this line = line // " " a6 = mpt a7 = int(line{a6+3..}) a8 = sub line = line{1,a6-1} // line{a8..} line = trm(line) a8 = len(line) if line{a8} = "|" line = line{1,a8-1} line = trm(line) end end tput [Z,a4] ~line a10 = 0 a14 = a4 loop for a8 = 1 to 20 ++a4 tget [Z,a4] line .t3 a9 if line{1} = "K" and line con "|" line = line // " " if a9 = 0 a10 = 1 if line con "P10=" a7 = mpt + 4 if line{a7} = "-" sgnp31 = -1 ++a7 else sgnp31 = 1 end p31 = int(line{a7..}) a6 = sub if line{a6} = "." p32 = int(line{a6+1..}) a6 = sub else p32 = 0 end end end end repeat while line{1} <> "A" if a10 = 0 a4 = a14 loop for a8 = 1 to 20 ++a4 tget [Z,a4] line if line{1} = "K" and line con "|" line = line // " " a10 = 1 if line con "P10=" a7 = mpt + 4 if line{a7} = "-" sgnp31 = -1 ++a7 else sgnp31 = 1 end p31 = int(line{a7..}) a6 = sub if line{a6} = "." p32 = int(line{a6+1..}) a6 = sub else p32 = 0 end end end repeat while line{1} <> "A" and a10 = 0 end if a10 = 0 dputc Program error stop else pp3 = p31 * 100 + p32 end loop for j = 1 to p3_fixcnt a4 = p3_fix(j) tget [Z,a4] line .t5 a6 a6 a7 = a6 - a5 if a7 <> 0 if line con "|" line = line // " P3=" else line = trm(line) line = line // " | P3=" end if a7 < 0 line = line // "-" a7 = 0 - a7 end line = line // chs(a7) tput [Z,a4] ~line end loop for a8 = 1 to 20 ++a4 tget [Z,a4] line if line{1} = "K" and line con "|" line = line // " " if line con "P10=" a13 = mpt a7 = mpt + 4 if line{a7} = "-" sgnp31a = -1 ++a7 else sgnp31a = 1 end p31a = int(line{a7..}) a6 = sub if line{a6} = "." p32a = int(line{a6+1..}) a6 = sub else p32a = 0 end pp3a = p31a * 100 + p32a a11 = (sgnp31a * pp3a) - (sgnp31 * pp3) if a11 = 0 line = line{1,a13-1} // line{a6+1..} line = trm(line) else temp3 = "" if a11 < 0 a11 = 0 - a11 temp3 = "-" end a12 = a11 / 100 a9 = rem temp3 = temp3 // chs(a12) // "." if a9 < 10 temp3 = temp3 // "0" end temp3 = temp3 // chs(a9) line = line{1,a13+3} // temp3 // line{a6..} line = trm(line) end else if line con "P9=" a13 = mpt else if line con "P8=" a13 = mpt else if line con "P7=" a13 = mpt end end end a9 = int(line{a13+3..}) a6 = sub if line{a6} = "." a9 = int(line{a6+1..}) a6 = sub end a11 = 0 - (sgnp31 * pp3) temp3 = "P10=" if a11 < 0 a11 = 0 - a11 temp3 = temp3 // "-" end a12 = a11 / 100 a9 = rem temp3 = temp3 // chs(a12) // "." if a9 < 10 temp3 = temp3 // "0" end temp3 = temp3 // chs(a9) line = line{1,a6} // temp3 // line{a6..} line = trm(line) end tput [Z,a4] ~line end repeat while line{1} <> "A" repeat end end FPP03: repeat loop for i = 1 to k tget [Z,i] line putc .w6 ~i ~line repeat getc #endif End of 11/24/07 addition perform parameter_init Check for snode = 10000 at end of each part 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 Set up mechanism for page specific output perform pageform_init REALWORK: if justflag = 3 loop for i = 1 to maxsystems old_sysbarpar(i,1) = sysbarpar(i,1) old_sysbarpar(i,2) = sysbarpar(i,2) repeat end new_dircnt = 0 /* New 11/21/07 save_dircnt = 0 /* New 11/21/07 mnum = 1 sys_count = 1 syscnt = 0 savec = 0 mcnt = 0 deadspace = 0 stopflag = 0 endflag = 0 f4 = 0 adj_space = YES loop for i = 1 to 32 conttie(i) = 0 repeat loop for i = 1 to f11 f(i,5) = 0 f(i,7) = 0 f(i,8) = 0 f(i,11) = 0 key(i) = 0 initialize superpnt(.,N_SUPER), supermap(.,N_SUPER), superdata(.,N_SUPER,SUPERSIZE) drec(.), savenoby(.), uxstop(.), nuxstop(.), dxoff(.) dyoff(.), uxstart(.), backloc(.), xbyte(.) loop for j = 1 to N_SUPER /* N_SUPER is New 02/01/09 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 #if SCORE_PARS tput [Y,1] X 31 1050 30 ~header1 tput [Y,2] X 31 1090 65 ~header2 tput [Y,3] X 31 1090 100 ~header3 tput [Y,4] X 31 2120 30 Page: 1 mainyp = 4 sv_mainyp = 4 #endif end if tacetline <> "" #if SCORE_PARS i = len(tacetline) i = i * 12 x = 1200 - i /* earlier version: x = 1400 - i if justflag < 2 ++mainyp tput [Y,mainyp] X 46 ~x ~sq(1) ~tacetline end #else if justflag < 2 ++mainyp tput [Y,mainyp] X 46 1200C ~sq(1) ~tacetline end #endif loop for i = 1 to f11 sq(i) += 150 repeat end if justflag < 2 ++mainyp if len(mvtline) > 3 if mvtline{1,3} = "(c)" mvtline = mvtline{4..} tput [Y,mainyp] X 46 1200C ~sq(1) ~mvtline else tput [Y,mainyp] X 46 575 ~sq(1) ~mvtline end else tput [Y,mainyp] X 46 575 ~sq(1) ~mvtline end end loop for i = 1 to f11 sq(i) += 120 /* This moves system down to accommodate mvtline repeat sysy = sq(1) sysh = sq(f11) - sq(1) + vpar(f11,8) + vst(f11) bottom_sq = sq(f11) sys_bottom = sq(f11) + vst(f11) 1. initialize variables ldist = sp loop for f12 = 1 to f11 rec = f(f12,1) + 1 f(f12,4) = rec f(f12,6) = rec f(f12,10) = 0 olddist(f12) = 0 repeat f3 = 0 pdist = 0 larc = 0 barcount = 0 loop for i = 1 to 40 rflag(i) = 0 repeat textflag = 0 barnum = 0 #if SCORE_PARS oldbarnum = 1 /* was 0, now trying 1, which seems to work #else oldbarnum = 0 #endif newbarnum = 0 gbarflag = 0 f13 = 0 2. Start initial system A. Generate entries in marr for clef, key and time signatures in that order (snode = 6913) syslen = hxpar(4) - sp marc = 0 perform setckt firstpt = ldist - sp B. Transfer marr to larr loop for i = 1 to marc ++larc #if REPORT putc M~marr(i,1) ... #endif loop for j = 1 to MARR_PARS larr(larc,j) = marr(i,j) repeat repeat #if REPORT putc #endif marc = 0 deadspace = ldist stopflag = 0 sys_jflag = 0 mcnts(syscnt+1) = mcnt C. Jump over code that sets up to print pages 2ff. Jump to section that begins reading input data to construct the next measure (III-5). goto CF I. General music system loop (big loop) 1. Check to see if there is more music. Jump to process end if not. (FINE) CHH: sys_jflag = 0 mcnts(syscnt+1) = mcnt loop for f12 = 1 to f11 rec = f(f12,5) perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line if line{1} = "J" and jtype = "M" and snode = 10000 f(f12,8) = 1 end repeat perform endcheck if endflag = 1 if justflag > 0 sysbarpar(syscnt,5) = sysbarpar(syscnt,1) end goto FINE end 2. Determine location of new system. Note: We can make a preliminary determination of the vertical size of the new system, but we will not know the final vertical size until we have typeset the system and have performed the the optional removal of "totally resting" lines. sq(1) = bottom_sq + vst(f11) + intersys sp = hxpar(3) loop for i = 2 to f11 if w(1) = 0 /* use default spacings if f(i-1,9) = 0 sq(i) = sq(i-1) + vpar(i-1,14) else sq(i) = sq(i-1) + vpar(i-1,11) end else sq(i) = sq(i-1) + w(i-1) end if f(i-1,12) = 2 sq(i) += vst(i-1) end repeat sysy = sq(1) sysh = sq(f11) - sq(1) + vpar(f11,8) + vst(f11) syslen = hxpar(4) - sp bottom_sq = sq(f11) sys_bottom = sq(f11) + vst(f11) 3. Compute space for new clef and key perform clefkeyspace deadspace = ldist 4. Initialize music system (line) variables hxpar(8) = ldist + hxpar(7) line2 = pad(80) loop for f12 = 1 to f11 uxstart(f12) = hxpar(8) backloc(f12) = hxpar(8) olddist(f12) = bolddist(f12) f(f12,6) = f(f12,5) /* record at new measure of music for part(.) f(f12,4) = f(f12,5) f(f12,10) = f(f12,7) /* multiple rest counter for part(.) repeat pdist = ldist - sp f13 = 1 larc = 0 marc = 0 barcount = 0 loop for i = 1 to 40 rflag(i) = 0 repeat textflag = 0 oldbarnum = barnum stopflag = 0 if justflag < 2 firstsys = FALSE end II. Read measures until ldist > hxpar(4), or until end of data. Read data one measure at a time. The definition of a complete measure is when the space node = 6913. There may be several objects in this position, including clef, key, and time changes, and also some super-objects. All of these must be read and the distances included in the "measure". If the last object is not a bar line, the next object must be checked and the distance to it used as a temporary negative adjustment to the potential length of the line (so that there will be space for the last object). When the addition of a measure distance to the total distance on a line results in a line overflow, we have two choices: (1) we may try to condense the longer line to fit, or (2) we may try to expand the shorter line (i.e. minus the last measure) to fit. This decision and the resulting processes are in section III of the process. We must first establish which parts are active in this measure. This is also a good time to look for the terminating mark in all parts. CF: #if SCROLL_OUT rmarg = 10000000 #else rmarg = hxpar(4) #endif false_rmarg = rmarg f2 = 0 nflg1 = 0xffffffff loop for f12 = 1 to f11 notesize = f(f12,14) if f(f12,10) = 0 /* first temporary multiple rest counter rec = f(f12,6) CR: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1,3} = "J S" and f11 > 1 if "467" con line{5} /* multiple rests and whole rests if mpt = 1 f(f12,10) = snode else f(f12,10) = 1 end CP: perform save3 /* oby not used here &X dputc rec = ~rec &X putc line = ~line if line{1,3} <> "J B" ++rec goto CP end reset olddist(.) to bar line after rest. This reset occurs only for those parts where f(f12,10) (rest-counter) > 0. Note: at the point where we start looking at this part again, i.e. the counter is changing from 1 to 0, we must typeset the concluding bar line and check to see if there are any addition 6913 type nodes, e.g., time or key changes, which would have to be included on 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 sysbarpar(syscnt,5) = barcount end if justflag <> 1 goto CG else dputc ldist = ~ldist dputc barcount = ~barcount dputc delta = ~delta goto CE end end endcheck checks all values of f(.,8); they must be either all 0 or all 1 Check for whole rests in all parts loop for f12 = 1 to f11 if f(f12,10) = 0 goto CC end repeat If no branch, then whole rest is in all parts, 0) check for forced termination if sysbarpar(syscnt+1,3) = barcount and barcount > 0 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 05/25/03 larr(larc,ACT_FLAG) = 0xffffffff /* " " larr(larc,M_ADJ) = adj_space /* " " goto CE end 1) increment ldist, check for overflow ldist += hxpar(6) if ldist > false_rmarg * put in larr entry for terminating bar line ++larc larr(larc,MNODE_TYPE) = 18 larr(larc,ACT_FLAG) = 0xffffffff larr(larc,M_ADJ) = adj_space goto CE end ++mcnt mspace(mcnt) = ldist 2) check to see if this is the last measure of general rest. If so, then we will want to look for additional objects such as clefs, key changes, etc. beyond the terminating bar line. The code to do this is at CCV. 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 3) recompute delta delta = rmarg - ldist 4) advance record pointer and bolddist; decrement f(.,10) loop for f12 = 1 to f11 f(f12,5) = f(f12,6) bolddist(f12) = olddist(f12) --f(f12,10) repeat 5) increment barcount, set empty bar flag for this bar, zero marc ++barcount ++barnum rflag(barcount) = hxpar(6) 6) branch; if delta = 0, go to print, else get next measure if delta = 0 * put in larr entry for terminating bar line ++larc larr(larc,MNODE_TYPE) = 18 /* New 05/25/03 larr(larc,ACT_FLAG) = 0xffffffff /* " " larr(larc,M_ADJ) = adj_space /* " " if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 sysbarpar(syscnt,5) = 0 /* New 05/28/05 end goto CG end goto CF ═════════════════════════════════════════════════════════════════════ At this point we have established that there is at least one active part in the measure. We now have a well-defined task. We must look through the active parts (where f(.,10) = 0) for the object(s) which has (have) the next smallest division number. We are concerned here with objects that need to "line up". These objects we call "proper" objects and include: 1. regular notes, cue notes, figures, isolated objects (NRQFI) 2. bar lines (B) 3. key signatures, time signatures (KT) For purposes of determining position and space, we can skip over those types of objects in a part that do not have to line up, but the distances through these objects to the line-up type objects must be taken into account. The objects that do not have to line up are called "passing" objects and include: 1. clef signs (C) 2. directives (D) 3. grace notes (G) 4. symbols (S) 5. marks (M) Clef signs actually get special treatment. If they follow a bar line and have snode = 6913, they are classified as proper objects; otherwise they are passing objects and their position is determined by the next proper object in the part. Our search will cover all objects with snode < 6913. When snode = 6913, we are at the end of a controlling measure. This situation will be covered later in the program. There is one anomaly which should be mentioned. We may encounter a non-controlling bar line in the middle of our search. In this case, we will generate two nodes with the same snode number. These can be differentiated by the node type (marr(.,MNODE_TYPE)). (05/25/03) 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 Set tarr array for active parts in this measure. Set textflag = 1, if any active parts are parts which contain text. 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 CHECK POINT: When a new node is identified, the distance to that node must be added to all the olddist(.) variables, not just to parts in the node. Then if the next node is generate by part(s) not in this set (the case which we define as syncopation), you won't get some huge distance between these nodes. This, however, leads to another problem. The distance to this next node may become very small, or even negative. We need to set some minimum distance for this node; also, we need to identify this node with a new type, because it will have its own rules for adding distance. The type shall be 20 + note type that would be generated by the increment in divisions, or in the case of tuplets, the type shall be 40. The minimum distance in the case of syncopation shall be determined in the following manner. Spacing of Syncopated Nodes ─────────────────────────── Definition: A node is syncopated when it contains no parts which were also contained in the previous node. To compute the minimum distance to a syncopated node: 1) determine the duration of all of the nodes coming into this node To do this, we will have to look ahead to the next node in every active part and read field 8, the preceding duration parameter. This information can be collected at the time we are putting the objects for the node together, since this process requires that we look at objects up to the point where the node number changes. When this change does occur, the value of dincf will be the duration of this node in this part. 2) the shortest such duration becomes the "controlling duration" 3) the space occupied by the node generating the controlling duration becomes the "controlling space" The space is the advance in the x-coordinate for this node. This we will have to determine at the time the syncopation is discovered. At least we will already know the controlling duration and therefore the part which must be examined. We must look forward to the first proper object which has a new node number. 4) determine the ratio between the duration advance to this node and the controlling duration (always less than 1) The duration advance for a particular node can only be computed by keeping track of the duration advances for all active parts from the previous controlling bar line (bar line with snode = 6913). We must assume that all active parts will have a node at the beginning of the measure, even if it is a rest. 5) the minimum distance is this ratio times the controlling space Note: syncopated nodes should be reasonably rare in the music we are currently working with. @r = 0 loop @q = 0 Find the parts which constitute the next node (less than 6913) in measure. Set tarr2(.) = 1 for these parts. n = 20000 loop for f12 = 1 to f11 notesize = f(f12,14) tarr2(f12) = 0 if tarr(f12) = 0 /* i.e. if part is active and not at end of measure rec = f(f12,6) CTT: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "Q" stopflag = 1 goto CTT end if line{1} = "J" /* this is what you are looking for (next object) if snode < n n = snode loop for i = 1 to f12 tarr2(i) = 0 repeat end if snode = n tarr2(f12) = 1 end if snode = 6913 ++@q tarr(f12) = 1 /* end of measure for this part tarr2(f12) = 0 end goto CSS end goto CTT else ++@q end CSS: repeat Check for end of measure; if so, set value for rflag(barcount) = 0 if @q = f11 a1 = 0 goto CCV /* this is the exit for the measure loop end establish minimum ndincf for active parts coming into this node @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 Determine values of marr for this node ++marc marr(marc,PRE_DIST) = 0 marr(marc,MNODE_TYPE) = 17 marr(marc,SNODE) = n marr(marc,ACT_FLAG) = 0 marr(marc,M_ADJ) = adj_space marr(marc,MARR_TEMP) = 3 /* New 02/09/07 3 = unset */ loop for k = 1 to 32 tdist(k,1) = 0 repeat k = 0 @d = 0 /* WARNING: very tricky code @e = 0 loop for f12 = 1 to f11 notesize = f(f12,14) rec = f(f12,6) if tarr2(f12) = 1 update the cumulative distance increment flag for this part and set marr(marc,TIME_NUM); also check to see accumulation is correct. New 05/25/03 cdincf(f12) += ndincf(f12) if @d = 0 @d = cdincf(f12) marr(marc,TIME_NUM) = @d - oldcdincf /* New 05/25/03 oldcdincf = @d else if @d <> cdincf(f12) putc Error: Problem in accumulation of durations putc Suspected location: part ~f12 measure ~marc in this system putc or possibly bar ~barnum in the music. putc putc To find error, look at durations in stage2 file for this part putc as well as for the top part (which provides the original count). putc Look also for the possible inconsistant use of non-contolling bar putc lines. putc putc A couple of things to note: (1) The bar nubmer given above is putc only approximate. If there is a pickup at the beginning, for putc example, the bar number could be one number too high. Try putc looking at the previous bar. putc putc (2) In most cases, the duration problem will be an obvious encoding putc error; but there is a subtle case which can escape normal detection. putc This is the case where an irest in a part produces an isolated putc node in a part. Isolated means that there in not another object putc in that part at that location. In this case it is necessary to putc ask the autoset to allocate space for this irest, even though it putc is not printed. This is done by using the "P C1:p1" print putc suggestion below the offending irest. This problem is also putc discussed at about line 1550 in the s2-spec.b46 ten documentation putc file. QQ1: putc putc Type $$ to see protions of the i-files which might contain the putc problem. putc Type !! to exit program; Simple <Enter> puts you in examine mode. getc line line = trm(line) if line = "" examine stop end if line = "$$" QQ2: putc Type the number of the part you want to examine. f12 = 0 getc f12 if f12 > 0 and f12 <= f11 rec = f(f12,6) putc Portion of I-file for part ~f12 putc ===================================== loop for i = rec - 10 to rec + 20 tget [Z,i] line putc .w5 ~i ~line repeat putc goto QQ2 else stop end end goto QQ1 end end CT: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if f11 = 1 and jtype = "S" and ntype >= 4 if ntype = 4 marr(marc,MARR_TEMP) = 1 /* multiple rest flag end else if "TCGMSD" con jtype goto CT end end if part with min ndincf is also current, compute controlling space if f12 = @c @e = dvar1 - olddv1(f12) end * olddv1(f12) = dvar1 i = dvar1 - olddist(f12) /* Code added 02/25/97. I think this is where we must correct for for extra distance put in by AUTOSET but not used. 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 End of 02/25/97 addition. Let's hope it works! i could possibly be too small, or negative, if the node is syncopated. We won't be able to compute this until this loop is finished if "CKTDBSFIM" con jtype /* only K,B,F and I are left, actually if mpt < 5 ntype = 13 + mpt else ntype = 17 end end if ntype < marr(marc,MNODE_TYPE) if marr(marc,MNODE_TYPE) = 18 putc ntype = ~ntype marr(~marc ,2) = 18 putc Error: Non-controlling bar line error at ~barnum examine stop end marr(marc,MNODE_TYPE) = ntype if f11 = 1 Code modification 02/09/07: 0 will be "sticky" if ntype = 9 and cflag = 1 marr(marc,MARR_TEMP) = 2 else marr(marc,MARR_TEMP) = 0 end if ntype = 9 and cflag = 1 marr(marc,MARR_TEMP) = 2 end end end if i > marr(marc,PRE_DIST) marr(marc,PRE_DIST) = i end ++k tdist(k,1) = f12 tdist(k,2) = dvar1 If this node is not a non-controlling bar line (ntype = 18), we must look further in this file for additional proper objects (notes, figures, rests, cues) on this node. The purpose is to find the smallest ntype. We must also advance f(f12,6) to the first record beyond the last object in the node. rec will also point beyond the last object in the node and at or before the next object beyond the node f(f12,6) = rec if ntype <> 18 CR2: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line if line{1} <> "J" ++rec goto CR2 end if snode = marr(marc,SNODE) /* New 05/25/03 if "CKTDBSFIM" con jtype if mpt < 5 ntype = 13 + mpt else ntype = 17 end end if ntype < marr(marc,MNODE_TYPE) /* New 05/25/03 marr(marc,MNODE_TYPE) = ntype /* " " Code modification 02/09/07: Be sure to set (marc,MARR_TEMP) to 0, if this is a regular node if f11 = 1 if ntype = 9 and cflag = 1 else marr(marc,MARR_TEMP) = 0 end end End of modification end ++rec f(f12,6) = rec goto CR2 end end goto CS else if line{1} = " " line = trm(line) if line = "" putc A search for Bar line was unsuccessful in part ~f12 . putc Measure number = ~barnum . Try checking durations, especially putc those used in "back" records. putc perform show_Ytable putc putc Program Halted putc stop end end end goto CT end We must also determine the new values for ndincf(.) for notes in this node (for all active parts, if first pass (@r = 0)). CS: if tarr(f12) = 0 if @r = 1 if tarr2(f12) = 0 goto CS2 end else @r = 1 end CR3: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" ndincf(f12) = dincf else goto CR3 end end CS2: repeat Code added 02/09/07: If marr(marc,MARR_TEMP) is unset, set it to 0 if marr(marc,MARR_TEMP) = 3 marr(marc,MARR_TEMP) = 0 end Before going on to the next node, we must: 1) Compute node flag(s) and determine if this node is syncopated or not. * perform showmarr 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 2) If syncopated node, compute minimum value for marr(marc,PRE_DIST). Minimum distance is determined by algorithm described earlier. Also the type for the previous node needs to be recomputed, based on the elapsed duration. If this duration is 576 multiplied or divided by a power of 2, then the newtype will be the type of the duration + 20. Otherwise the type will be 40. if k = 1 * dputc Syncopated node in bar ~barnum @b is controlling duration @c is part with controlling duration if @e > 0, @e is controlling space; otherwise, compute it now if @e = 0 rec = f(@c,6) DS: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if "CGMS" con jtype goto DS end @e = dvar1 - olddv1(@c) else goto DS end end @e is controlling space @e = @e * marr(marc,TIME_NUM) / @b #if REPORT putc T7 minimum syncopated space = ~@e #endif if marr(marc,PRE_DIST) < @e marr(marc,PRE_DIST) = @e end * compute new ntype @c = @b / 9 if rem = 0 loop for @a = 1 to 11 @c >>= 1 repeat while @c > 0 marr(marc-1,MNODE_TYPE) = @a + 20 else marr(marc-1,MNODE_TYPE) = 40 end end 3) Adjust olddist(.) for parts where f(f12,10) = 0 perform adjolddist 4) Increment ldist ldist += marr(marc,PRE_DIST) Proceed to next node repeat Decrease multiple rest counters; save f(.,10) in case ldist > rmarg CCV: loop for f12 = 1 to f11 tarr3(f12) = f(f12,10) if f(f12,10) > 0 --f(f12,10) end repeat Now is the time to deal with nodes with snode = 6913. This includes types G,S,M,C,D,B,K,T (not N,R,Q,F,I). The first proper object-node will always be a type B (bar line). Types B,K,T will generate proper object-nodes. Type C will generate a proper node if it follows the bar line. Look at bar ++marc marr(marc,PRE_DIST) = 0 marr(marc,MNODE_TYPE) = 18 marr(marc,SNODE) = 6913 marr(marc,ACT_FLAG) = 0xffffffff marr(marc,M_ADJ) = adj_space marr(marc,MARR_TEMP) = 0 I think this is the point where we need to set a new value for adj_space. Basically, the normal condition is for adj_space = YES; but if a terminating barline object in one of the active parts has a print suggestion that indicates that the next measure must not have its spaces altered in the line adjustment process, then the adj_space flag must be set to NO. adj_space = YES @d = 0 loop for f12 = 1 to f11 notesize = f(f12,14) if f(f12,10) = 0 if ndincf(f12) > 0 cdincf(f12) += ndincf(f12) if @d = 0 @d = cdincf(f12) marr(marc,TIME_NUM) = @d - oldcdincf else if @d <> cdincf(f12) putc Error: Problem in accumulation at bar line ~barnum examine stop end end end rec = f(f12,6) DT1: perform save3 #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1,3} = "J B" i = dvar1 - olddist(f12) if i > marr(marc,PRE_DIST) marr(marc,PRE_DIST) = i end olddist(f12) = dvar1 f(f12,6) = rec if oby >= 1000000 t1 = oby / 1000000 if t1 = 1 or t1 = 3 adj_space = NO end #if SCROLL_OUT #else if t1 = 10 sys_jflag = barcount + 1 end #endif end else goto DT1 end end repeat Adjust distances loop for f12 = 1 to f11 if f(f12,10) > 0 olddist(f12) += marr(marc,PRE_DIST) end repeat ldist += marr(marc,PRE_DIST) perform showmarr getc Look for clef, key, time signature in 6913 type node perform setckt Check length, branch back, or proceed dputc T02 ldist = ~ldist barcount = ~barcount ++mcnt mspace(mcnt) = ldist dputc mspace(~mcnt ) = ~mspace(mcnt) if ldist > false_rmarg goto CK end Transfer marr to larr New code added 10/31/08 to deal with an obscure situation that arrises from the new feature (for parts) that allows multiple rests to be broken into smaller units. A multiple rest generates a single marr(.,.) entry (a bar line with 0 space), which under normal conditions is transferred to larr(.,.). And normally there would be real musical notes following this barline. However, when a multiple rest is broken into smaller units, a second 0 space barline follows the first. This creates a problem later in the code because this extra bar is "double counted," i.e., it is counted as part of the multiple rest (handled one way), and as a measure with musical notes (handled another way). Put another way, the larr(.,.) array has too many bar lines in it, so the data in the last measure is not processed, causing a misalignment of pointers. The "fix" used here is to skip the tranfer of marr(.,.) to larr(.,.) when marc = 1, and the space parameter of the previous larr(.,.) entry is 0 (as it is for the last bar of a multiple rest). I have not checked to see if there are other situations which produce this condition -- a possible new problem. if marc = 1 and larc > 0 and larr(larc,1) = 0 and larr(larc,2) = 18 goto NO_TRANS end loop for i = 1 to marc ++larc #if REPORT2 putc M~marr(i,1) ... #endif loop for j = 1 to MARR_PARS larr(larc,j) = marr(i,j) repeat repeat #if REPORT2 putc #endif Adjust delta and counters NO_TRANS: /* New label 10/13/08 delta = rmarg - ldist ++barcount ++barnum #if REPORT putc T20 barnum = ~barnum #endif * a1 is set earlier; normal case, a1 = 0, for end of G.P. a1 = hxpar(6) rflag(barcount) = a1 loop for f12 = 1 to f11 if delta = 0 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) end if stopflag = 1 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) end repeat if delta = 0 if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 sysbarpar(syscnt,5) = sys_jflag end goto CG end if sysbarpar(syscnt+1,3) = barcount and barcount > 0 loop for f12 = 1 to f11 bolddist(f12) = olddist(f12) f(f12,5) = f(f12,6) repeat goto CE end if stopflag = 1 goto CCE end marc = 0 goto CF This is where the program jumps back to get another measure At this point, we have added too much music to a line (ldist > false_rmarg) Provisional transfer of marr to larr (to text "squeezing") CK: larc2 = larc loop for i = 1 to marc ++larc2 loop for j = 1 to MARR_PARS larr(larc2,j) = marr(i,j) repeat repeat III. Compute new distances Compute new distances for object nodes on a line. This is where we determine how to right justify the line. It is also where we decide whether or not to "squeeze" an extra measure onto the line or not. larc = number of object-nodes on the line larc2 = number of object-nodes on extended line A. General calculations: Identify shortest duration in extended line and determine quantity and location of smallest distances First, we need to know how many barlines are in this line of music. Specifically, if there is only one, then we must allow space modifications irrespective of whether a print suggestion asked that there be none. 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 B. If there is no text, determine shortest adjustable distance between notes and the number of notes that have this distance. If an additional measure can be accommodated by decreasing this distance by x%, then this should be done. if textflag = 0 * scnt = number of notes with smallest distance b = e * scnt / 15 /* allows for about 6.6% compression c = ldist - rmarg #if REPORT2 putc size = ~e # of nodes = ~scnt ldist = ~ldist putc overdistance = ~c maxcompression = ~b getc #endif if c <= b and c > 0 savec = c Try to accommodate additional measure by compressing shortest notes #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 small(.) contains the node numbers where the distance may be decreased scnt = number of candidate nodes e = shortest distance a = alternation flag for deleting space in type-40 syncopated pairs b = distance subtraction flag c = distance to subtract a = 0 b = 0 loop j = 1 loop for i = 2 to larc if i = small(j) if j < scnt ++j end if larr(i-1,MNODE_TYPE) < 40 if larr(i,PRE_DIST) > e b = 1 else goto CPB end --larr(i,PRE_DIST) else if b = 0 goto CPB end if a = 0 --larr(i,PRE_DIST) else --larr(i-1,PRE_DIST) end end --c if c = 0 /* Success! Go lay out music at CG if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = 0 - savec sysbarpar(syscnt,5) = sys_jflag end goto CG end end CPB: repeat if a = 0 a = 1 else a = 0 end if b = 0 --e #if REPORT2 putc new e = ~e #endif b = 1 else b = 0 end repeat end end Since the effort to squeeze an extra measure onto a line has failed at this point, we must restore the earlier values of f(.,10), which were advanced when we added the bar line to the last (prospective) measure. CCE: loop for f12 = 1 to f11 f(f12,10) = tarr3(f12) repeat --mcnt /* delete length from list If f2 = 1, then we tried unsuccessfully to add an extra measure of general rest. We must now add a larr entry for the terminating bar line if f2 = 1 ++larc larr(larc,MNODE_TYPE) = 18 /* New 05/25/03 larr(larc,ACT_FLAG) = 0xffffffff /* " " larr(larc,M_ADJ) = adj_space /* " " end C. Assign delta (extra space) to various nodes within line. a. Try to assign delta to multiple measure rests or whole measure rests CE: #if REPORT2 putc T1 delta = ~delta #endif if justflag > 0 ++syscnt sysbarpar(syscnt,1) = barcount sysbarpar(syscnt,2) = delta sysbarpar(syscnt,5) = sys_jflag end Look for multiple measure rests if f11 = 1 n = 0 loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 1 ++n end repeat if n > 0 a = delta / n + 1 if a <= MAGIC1 loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 1 if a > delta a = delta end larr(c1,PRE_DIST) += a delta -= a if delta = 0 /* Not necessary goto CG end end repeat goto CG else a = MAGIC1 if a > delta /* should never happen, but just to be safe a = delta end loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 1 larr(c1,PRE_DIST) += a delta -= a end repeat end end end Look for single measure rests if f11 = 1 n = 0 loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 2 ++n end repeat if n > 0 a = delta / n + 1 b = hxpar(6) * 4 / barcount if a > b a = b end loop for c1 = 1 to larc if larr(c1,MARR_TEMP) = 2 if a > delta a = delta end larr(c1,PRE_DIST) += a delta -= a if delta = 0 goto CG end end repeat end end n = 0 loop for j = 1 to barcount if rflag(j) > 0 ++n end repeat if n > 0 a = delta / n + 1 b = hxpar(6) * 2 / barcount if a > b a = b end loop for j = 1 to barcount if rflag(j) > 0 if a > delta a = delta end rflag(j) += a delta -= a if delta = 0 goto CG end end repeat end b. Try to assign delta to notes larger than smallest 1. construct adjarr, compute maximum possible adjustment We need to know how many barlines are in this line of music. Specifically, if there is only one, then we must allow space modifications irrespective of whether a print suggestion asked that there be none. 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 k = ntype for shortest node on line e = smallest standard internode distance Smallest standard internode distance is sometimes not relevent, especially in the case where there is text underlay. Let us also look at the median of the distances for the shortest node on the line j = 0 loop for i = 1 to larc - 1 if larr(i,MNODE_TYPE) = k ++j adjarr(j,1) = larr(i+1,PRE_DIST) end repeat a1 = j loop for i = 1 to a1 - 1 loop for j = i + 1 to a1 if adjarr(i,1) < adjarr(j,1) c = adjarr(i,1) adjarr(i,1) = adjarr(j,1) adjarr(j,1) = c end repeat repeat a1 = a1 + 1 >> 1 h = adjarr(a1,1) if h > (e * 5 / 4) e = h end adjarc = 0 if k > 6 a = k + 1 else a = k end loop for i = 2 to larc if larr(i,MNODE_TYPE) = 18 and larr(i-1,MNODE_TYPE) < a goto CD end if larr(i,TIME_NUM) > 0 dv3 = larr(i,TIME_NUM) * 10 / df if dv3 > 10 Code modification 12/11/03 Note 04/12/10 The code below is ridiculous and absurd and is being replaced by some "magic" numbers that do the same thing. rx = flt(dv3) rx = rx / 10.0 ry = lnx(rx) / lnx(2.0) rz = pow(1.5,ry) rz *= 10.0 dv3 = fix(rz) if dv3 < 80 c18 = dv3 - 10 + 1 c19 = ors("AABBCCDDEEFFFGGHHHIIJJJKKKLLLMMMNNNOOOPPPPQQQRRRRSSSTTTTUUUUVVVVWWWWXX"{c18}) - 55 else if dv3 < 515 c18 = dv3 - 75 / 10 + 1 c19 = ors("!$&(*,.024679;<>@ACDFGIJKMNPQRSUVWYZ[\]_`abc"{c18}) else c19 = dv3 - 515 / 10 + 100 end end dv3 = c19 c = dv3 * e / 10 /* maximum final distance Case: node is preceded by adjustable distance (larr(i,TIME_NUM) > 0); duration preceding node (larr(i,TIME_NUM)) is greater than min. dur. c = amount by which duration may be increased if c > 0 #if MEAS_SUGG if larr(i,M_ADJ) = YES ++adjarc adjarr(adjarc,1) = i adjarr(adjarc,2) = c adjarr(adjarc,3) = 0 end #else ++adjarc adjarr(adjarc,1) = i adjarr(adjarc,2) = c adjarr(adjarc,3) = 0 #endif end end end CD: repeat 2. compute adjarr(.,3) = current largest distance for nodes similar to this one. First, determine maximum PRE_DIST for each TIME_NUM 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 Second, sort by increasing TIME_NUM, smallest first 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 Third, make sure that increasing TIME_NUM has increasing distance 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 Fourth, assign the various maximums to their respective adjarr(.,3) loop for i = 1 to adjarc a = adjarr(i,1) b = larr(a,TIME_NUM) 07/14/04 The code below appears to contain a minor bug. It appears to be possible for tarr5(.,2) = 0, in which case, adjarr(.,3) should also be zero. I think the purpose of the test condition below the loop is to flag the case where no match was found in the loop, in which case adjarr(.,3) would also be zero. We need to have another way to flag this condition. loop for j = 1 to d if tarr5(j,1) = b adjarr(i,3) = tarr5(j,2) end repeat if adjarr(i,3) = 0 putc Program Error stop 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 End of 07/14/04 code change repeat 11/06/08 There is a corner case I don't understand yet. It can result in delta being 0 at this point, which leads to code failure. To avoid this, I include the following code. The problem of the corner case still exists, however. if delta = 0 goto CG end 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 3. determine adjarr(.,4) = distances to add to bring all nodes up to the "largest in class" 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 4. if delta is still > 0, try increasing adjarr(.,4) up to allowed maximum 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 #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 5. add distance loop for i = 1 to adjarc h = adjarr(i,1) larr(h,PRE_DIST) += adjarr(i,4) /* New 12/11/03 #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 c. Assign distance to smallest notes small(.) = node numbers where distance can be added scnt = number of such nodes a = alternation flag for incerting space in type 40 syncopated nodes b = addition flag e = smallest internote distance delta_e = difference between smallest distance and next smallest distance delta = distance to subtract a = 0 b = 0 #if REPORT2 putc Assigning ~delta to smallest notes; e = ~e #endif n = delta_e + 1 / 2 /* New 10/14/07 if n < 3 n = 3 end if scnt > 0 loop for h = 1 to n /* Limit to loop is new 10/14/07 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 05/25/03 if larr(i,PRE_DIST) > e /* " " goto CPE else b = 1 end ++larr(i,PRE_DIST) /* New 05/25/03 else if b = 0 goto CPE end if a = 0 ++larr(i,PRE_DIST) /* New 05/25/03 else ++larr(i-1,PRE_DIST) /* New 05/25/03 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 d. Assign remaining distance wherever you can loop loop for i = 2 to larc if larr(i,TIME_NUM) > 0 /* New 05/25/03 ++larr(i,PRE_DIST) /* " " --delta if delta = 0 goto CG end end repeat repeat ┌────────────────────────────────────────────────────────────┐ │ │ │ Distances are computed. Now it is time to read the │ │ file the second time and typeset the music │ │ │ │ PRINT OUT THE MUSIC │ └────────────────────────────────────────────────────────────┘ Compute offsets for bar lines and values of larc for bar lines barcount = number of bars in a line barpar(.,1) = horizontal length of measure barpar(.,2) = value of larc2 for bar-node at end of measure barpar(.,3) = bar type (ntype) at end of measure CG: 12/17/03 At this point, the larr(larc,.) array is fixed and ready for use. If XVERSION, and if this is the final pass (justflag < 2), and if formatflag = 1, and if the format file contains larr data (forp < forpz), then now is the time to compare the larr data with the larr(larc,.) array just generated. If there is a perfect match up of the MNODE_TYPE elements, then the stored PRE_DIST elements can replace the computed ones. New 11/02/07. We need to correct a "corner" case here. When the last item object in a line is a key change or a time change, the program places this beyond the end of the line. I'm not sure why this happens, and it would be complicated to try to fix. But there is an easy solution here. Simply figure out the space needed, and subtract it from the various larr nodes. While we are at it, the distance between the last bar line and the time change is sometimes excessive. So let's set this to the standard distance as well. Keep an eye on this change, however; there may be exceptions to this fix. j = 0 loop for i = 1 to larc putc .w6 ~i ~larr(i,MNODE_TYPE) ~larr(i,PRE_DIST) j += larr(i,PRE_DIST) repeat if chr(larr(larc,MNODE_TYPE)) in [14..16] i = rmarg - false_rmarg if larr(larc,MNODE_TYPE) = 15 i -= (hxpar(5) / 2) end if larr(larc,MNODE_TYPE) = 16 i -= (hxpar(13) / 2) end putc Space needed here is ~i Total is ~j if larr(larc,PRE_DIST) > hxpar(7) and larr(larc-1,MNODE_TYPE) = 18 g = larr(larc,PRE_DIST) - hxpar(7) putc First remove extra space after bar line g = ~g if g > i g = i end larr(larc,PRE_DIST) -= g i -= g end g = i c = 7 loop loop for h = 2 to larc k = larr(h,PRE_DIST) * i * 10 / j if k < 10 and k > c k = 10 end k /= 10 if rem > 5 ++k end larr(h,PRE_DIST) -= k putc subtracting ~k from node ~h = ~larr(h,PRE_DIST) g -= k if g <= 0 putc Done goto END_CORRECT end repeat --c repeat END_CORRECT: getc end #if XVERSION if justflag < 2 if formatflag = 1 /* there is a format file if forp < forpz /* and it contains larr data tget [F,forp+1] bigline a = int(bigline{4..}) if a <> psysnum + 1 putc The FORMAT file contains a format error. putc System number = ~(psysnum + 1) putc putc Program Halted 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 12/17/03 At this point, the cumulative larr array can be initialized. if endflag = 1 and justflag <> 1 c4 = ldist - sp - pdist else c4 = syslen - pdist end #if SCROLL_OUT loop for i = 1 to 30000 cum_larr(i,1) = 0 cum_larr(i,2) = 0 repeat #else loop for i = 1 to 300 cum_larr(i,1) = 0 cum_larr(i,2) = 0 repeat #endif mspace(mcnt) += deadspace * 100000 #if REPORT2 if justflag > 1 putc sysbarpar(~syscnt ,1) = ~sysbarpar(syscnt,1) putc sysbarpar(~syscnt ,2) = ~sysbarpar(syscnt,2) end #endif if endflag = 1 and justflag <> 1 i = ldist - sp else i = syslen end if justflag < 2 sv_mainyp = mainyp ++mainyp y1p = mainyp tput [Y,mainyp] S 0 ~sp ~sysy ~i ~sysh ~f11 "~syscode " end * loop for i = 1 to barcount barpar(i,3) = 0 repeat * putc T9 delta = ~delta * #if SHOWLARR loop for a1 = 1 to larc perform showlarr repeat putc #endif First handle special case of entire system of rests if larc = 0 cum_x = 0 /* 12/17/03 cum_larrz = 0 /* " loop for i = 1 to barcount cum_x += rflag(i) /* 12/17/03 ++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 Normal case: notes in at least one part in system larc2 = 1 d = 0 cum_x = 0 /* 12/17/03 barcum_x = 0 /* 12/17/03 Handle special case of beginning of piece 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) /* 12/17/03 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 dputc i = ~i rflag = ~rflag(i) barcount = ~barcount if rflag(i) > 0 barpar(i,1) = rflag(i) + d barcum_x += barpar(i,1) /* 12/17/03 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 /* 12/17/03 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 Exit sequence: either you run out of 6913 nodes, or you hit another bar line (i.e. with a multiple rest in between). if c = 1 if larr(j,SNODE) <> 6913 larc2 = j goto CG3 else if larr(j,MNODE_TYPE) = 18 larc2 = j goto CG3 end end end * cum_x += larr(j,PRE_DIST) cum_larr(j,1) = cum_x cum_larr(j,2) = 0 d += larr(j,PRE_DIST) if larr(j,MNODE_TYPE) = 18 and larr(j,SNODE) = 6913 c = 1 barpar(i,2) = j barpar(i,1) = d barcum_x += barpar(i,1) cum_x = barcum_x *DB putc T17 (~i :~d ,~j ) ... d = 0 end repeat end CG3: if i = barcount if rflag(i) > 0 cum_larrz = larc + 1 cum_larr(cum_larrz,1) = cum_x else cum_larrz = larc end end repeat if cum_larr(cum_larrz,1) > c4 dputc Program error, or something else wrong. end c5 = cum_larrz dputc cum_larr(~c5 ,1) = ~cum_larr(c5,1) and c4 = ~c4 *DB putc T17 Reset record pointers, set up second whole measure rest array 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 putc real space = ~sysbarpar(syscnt,2) putc hypothetical space = ~sysbarpar(syscnt,4) If f13 = 0 (and justflag < 2), check to see if part names need to be backed up. Compute pn_left if f13 = 0 and justflag < 2 and f11 > 1 c1 = 0 loop for f12 = 1 to f11 notesize = f(f12,14) rec = f(f12,1) tget [Z,rec] line if line <> "" if line{1} = "!" temp = line{2,2} line = line // pad(4) line = line{4..} else temp = chs(mtfont) end c5 = int(temp) perform spacepar (c5) if len(line) <= NAMELEN line = trm(line) c2 = 0 loop for c3 = 1 to len(line) c2 += spc(ors(line{c3})) repeat if c1 < c2 c1 = c2 end else line = line // " " j = 0 FLL: h = 0 loop for k = 1 to len(line) if line{k} = " " if k > NAMELEN if h > 0 k = h end ++j linepiece(j) = trm(line{1,k}) line = mrt(line{k..}) goto FLL else h = k end end repeat line = trm(line) if len(line) > 0 and j < 5 ++j linepiece(j) = line end loop for k = 1 to j c2 = 0 loop for c3 = 1 to len(linepiece(k)) c2 += spc(ors(linepiece(k){c3})) repeat if c1 < c2 c1 = c2 end repeat end end repeat c2 = maxnotesize << 1 if c1 > hxpar(9) - c2 pn_left = c1 - hxpar(9) + c2 else pn_left = 0 end end Loop through parts one at a time and print out. Set delta to total number of bars for this line. We will use barcount as the exit indicator for each part. There are certain variables which are used only to print parts. The variables and their storage locations are listed below. Variable ────────── superpnt(32,N_SUPER) supermap(32,N_SUPER) superdata(32,N_SUPER,SUPERSIZE) drec(32) savenoby(32) uxstop(32) nuxstop(32) dxoff(32) dyoff(32) uxstart(32) backloc(32) xbyte(32) delta = barcount loop for f12 = 1 to f11 Fixing a bug in the TAKEOUT system 12/22/05 if justflag < 2 type1_dflag(f12) = save_type1_dflag(f12) type2_dflag(f12) = save_type2_dflag(f12) end i = f(f12,15) lbyte = "Ll"{i} notesize = f(f12,14) firstbarflag = 0 dxoff(f12) = 10000 a. Set up Line record. If f13 = 0, put objects for instrument names; else, print clef, key, time-sig and other information. i = sq(f12) - sysy if f13 = 0 xbyte(f12) = "**********"{1,f(f12,13)} if justflag < 2 03/25/06 put in @ LINE record for this line if andata_flag > 0 ++mainyp tput [Y,mainyp] ~@line(f12) end ++mainyp spaging code #if SCORE_PARS x = f(f12,16) y = f(f12,17) tput [Y,mainyp] ~lbyte ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 | TRANS=~x INSTN=~y xmskpage code #else #if CONTINUO tput [Y,mainyp] ~lbyte ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) -200 #else tput [Y,mainyp] ~lbyte ~i ~f(f12,9) 0 0 0 ~xbyte(f12) ~vst(f12) ~f(f12,14) 0 #endif End of split #endif end * print instrument name if f11 > 1 rec = f(f12,1) tget [Z,rec] line if line <> "" if line{1} = "!" temp = line{2,2} line = line // pad(4) line = line{4..} else temp = chs(mtfont) end x = 0 - hxpar(9) - pn_left if len(line) <= NAMELEN y = vpar(f12,6) if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y 1 6913 0 0 end line = trm(line) if justflag < 2 ++mainyp tput [Y,mainyp] W 0 0 ~temp ~line end else y = vpar(f12,9) line = line // " " j = 0 FIXLINE: h = 0 loop for k = 1 to len(line) if line{k} = " " if k > NAMELEN if h > 0 k = h end ++j y -= vpar(f12,3) linepiece(j) = trm(line{1,k}) line = mrt(line{k..}) goto FIXLINE else h = k end end repeat line = trm(line) if len(line) > 0 and j < 5 ++j y -= vpar(f12,3) linepiece(j) = line end spaging code #if SCORE_PARS The nature of score convertion dictates that each line of the instrument designation must have its own object record if justflag < 2 loop for k = 1 to j ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~j 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~temp ~linepiece(k) y += vpar(f12,6) repeat end xmskpage code #else if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~j 6913 0 0 end y = 0 loop for k = 1 to j if justflag < 2 ++mainyp tput [Y,mainyp] W 0 ~y ~temp ~linepiece(k) end y += vpar(f12,6) repeat End of split #endif end end end else if justflag < 2 03/25/06 put in @ LINE record for this line if andata_flag > 0 ++mainyp tput [Y,mainyp] ~@line(f12) end ++mainyp xx(1) = f(f12,9) xx(2) = dyoff(f12) xx(3) = uxstart(f12) xx(4) = backloc(f12) xx(5) = vst(f12) xx(6) = f(f12,14) spaging code #if SCORE_PARS xx(7) = f(f12,16) xx(8) = f(f12,17) tput [Y,mainyp] ~lbyte ~i ~xx(1) ~xx(2) ~xx(3) ~xx(4) ~xbyte(f12) ~xx(5) ~xx(6) | TRANS=~xx(7) INSTN=~xx(8) xmskpage code #else #if CONTINUO tput [Y,mainyp] ~lbyte ~i ~xx(1) ~xx(2) ~xx(3) ~xx(4) ~xbyte(f12) ~xx(5) ~xx(6) -200 #else tput [Y,mainyp] ~lbyte ~i ~xx(1) ~xx(2) ~xx(3) ~xx(4) ~xbyte(f12) ~xx(5) ~xx(6) 0 #endif End of split #endif This code added 01/06/04 to implement abbreviated part names c4 = f(f12,6) c2 = recflag(c4) & 0xff if c2 > 0 temp = abbr(c2) c5 = int(temp) temp = temp{sub..} temp = mrt(temp) New 01/29/09: Adding code to deal with grand staff c7 = 0 temp = temp // pad(4) if temp{1,3} = "(g)" /* special case of grand staff c7 = vst(f12) >> 1 temp = temp{4..} end temp = trm(temp) perform spacepar (c5) if temp con "/" temp2 = temp{mpt+1..} temp = temp{1,mpt-1} else temp2 = "" end c2 = 0 loop for c3 = 1 to len(temp) if temp{c3} = "_" temp{c3} = " " end c2 += spc(ors(temp{c3})) /* 06/04/08 More precise calculation of length if temp{c3,2} = "\0" ++c3 else c2 += spc(ors(temp{c3})) end repeat c4 = 0 if temp2 <> "" loop for c3 = 1 to len(temp2) if temp2{c3} = "_" temp2{c3} = " " end c4 += spc(ors(temp2{c3})) /* 06/04/08 More precise calculation of length if temp2{c3,2} = "\0" ++c3 else c4 += spc(ors(temp2{c3})) end repeat end if c4 > c2 c2 = c4 end c4 = notesize * 3 + c7 /* c7 is New 01/29/09 c3 = maxnotesize << 1 c2 += c3 ++mainyp if temp2 = "" tput [Y,mainyp] J D 0 -~c2 ~c4 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~c5 ~temp else c7 = 0 loop while temp2{1} = " " c7 += spc(32) temp2 = temp2{2..} repeat c6 = c4 >> 1 tput [Y,mainyp] J D 0 -~c2 ~c4 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 -~c6 ~c5 ~temp ++mainyp tput [Y,mainyp] J D 0 -~c2 ~c4 1 6913 0 0 ++mainyp tput [Y,mainyp] W ~c7 ~c6 ~c5 ~temp2 end end end New 05/06/08. If the beginning of an ending superobject has been thrown over to a new page, then a mark for this superobject must be placed at the beginning of the line. clefkey is the best place to do this. The flags will be superdata(.,.,5) and superdata(.,.,7). The magic number 123456 is used to signal an ending superobject, and 2 is the value of superdata(.,.,5) which signals that the ending was thrown over from the previous measure. supernum is used as the flag for clefkey to typeset a mark. supernum = 0 loop for j = 1 to N_SUPER /* N_SUPER is New 02/01/09 if superdata(f12,j,5) = 2 and superdata(f12,j,7) = 123456 supernum = supermap(f12,j) end if superdata(f12,j,6) = 234567 /* New 06/09/08 magic number for dashes superdata(f12,j,7) = 1 /* New 06/09/08 end /* New 06/09/08 repeat End of 05/06/08 addition perform clefkey New code 11/21/07; Typeset directives thrown from previous systme if save_dircnt > 0 and justflag < 2 loop for c12 = 1 to save_dircnt if save_direct(c12,1) = f12 c13 = save_direct(c12,2) tget [Z,c13] line2 .t5 c14 c15 c16 c17 if bit(1,c14) = 1 goto LKJ01 end if bit(2,c14) = 1 goto LKJ01 end if bit(3,c14) = 1 and f12 = f11 goto LKJ01 end goto LKJ02 LKJ01: c11 = c13 - 1 LKJ03: tget [Z,c11] line3 .t5 c18 c19 if line3{1,3} <> "J B" and c11 > 1 --c11 goto LKJ03 end c20 = c15 - c19 /* This is the horizontal offset (I think) line2 = line2{1,4} // chs(c14) // " " // chs(c20) // " " // chs(c16) // " " // chs(c17) // " 6913 0 0" ++c13 tget [Z,c13] line3 dputc ~line2 dputc ~line3 putc ++mainyp tput [Y,mainyp] ~line2 ++mainyp tput [Y,mainyp] ~line3 end LKJ02: repeat end End of 11/21/07 addition end * b. Check for multiple rests running over from previous line. Also initialize certain variables. barnum = oldbarnum larc2 = 0 rec = f(f12,6) crec = 0 csnode = 6913 point = pdist prev_point = point point_adv = 0 oldmpoint = point if f13 = 1 oldmp2 = point else oldmp2 = firstpt end last_jtype = " " /* added 11/25/06 barcount = 0 if f(f12,11) > 0 rest7 = 0 /* added 12/24/03 perform save5 if barcount = delta goto CW end end c. Process the data for each part. Compute new x-position for all objects. Collect information on super objects; these may have to be split at the end of line. Determine where to stop looking (this has turned out to be a problem area for this program). if justflag < 2 type1_dflag(f12) = ON type2_dflag(f12) = OFF dputc looping through part ~f12 getc end CZ: tget [Z,rec] line .t3 jtype c2 c2 c2 c2 snode dputc .w4 ~f12 ~line New code added 01/06/04 to deal with line control flags if justflag < 2 c2 = recflag(rec) >> 8 dputc recflag = ~c2 line = ~line if c2 <> 1 if type1_dflag(f12) = ON dputc turning type1_dflag(~f12 ) OFF end type1_dflag(f12) = OFF end if c2 = 2 if type2_dflag(f12) = OFF dputc turning type2_dflag(~f12 ) ON end type2_dflag(f12) = ON end Fixing a bug in the TAKEOUT system 12/22/05 save_type1_dflag(f12) = type1_dflag(f12) save_type2_dflag(f12) = type2_dflag(f12) end ++rec if line{1} = "Q" goto CZ end Process multiple rests and whole rests if line{1,3} = "J S" and "467" con line{5} and f11 > 1 #if SCORE_PARS if line con "|" mrest_data(f12) = line{mpt..} line = line{1,mpt-1} end #endif --rec perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec a) check for underlines 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 This change found in more recent mskpage uxstop(f12) -= hpar(f12,4) end b) process rest(s) 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 Added 12/24/03 for optional staff lines if ntype = 7 rest7 = 1 end 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" O B J E C T S ───────────── We must compute the new obx for this object. To do this, we will use the information the larr array. We must be reminded at this point about the kinds of nodes which are in the larr array. The larr array locates objects of type N,R,Q,F,I,B,K,T. In addition, type C generates a larr node, if it follows a B type node and has snode = 6913. The value of snode for the larr nodes in a particular measure is always non-decreasing. In general, the value increases with each node. Exceptions are as follows: 1) At the end of a measure, there may be several nodes with snode = 6913. The first of these is always a B type. Those that follow may include C,K, and T types in that order. 2) It can happen that there is a non-controlling bar line in the middle of a measure. In this case, the bar line (B) will have the same larr(.,SNODE) value (05/25/03) as the next node. There can be several proper objects with the same snode value in a node, e.g. F and N types are commonly found together. In this case, the type for the node is the first time encountered in the part. It is important when reading the part to realize that there will not be a new larr node for each proper object encountered. New larr nodes are generated only by: 1) an advance in snode, 2) a type N,R,Q,F,I following a type B, when snode < 6913, 3) a C and/or K and/or T after a type B, when snode = 6913. Grace notes (G), symbols (S), directives (D), and marks (M) will always take their position from the proper object that follows. It still isn't clear to me whether marks or symbols can have their own unique snode number. To sum all of this up, it is very important that the reading and interpreting of objects in the intermediate file not get out of phase with the nodes in larr. If this happens, the positions of objects will become messed up. if jtype = "M" and snode = 10000 putc Error: Unexpected end of file for part ~f12 examine stop end --rec * Get the remaining object related parameters perform save3 /* oby will be used; it will be modified as needed #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line Compute the new obx. Case I: controlling bar line if jtype = "B" and snode = 6913 New 05/25/03 Remove any measure print suggestions here (also 05/28/05) 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 12/19/03 perform getcontrol ++barcount if oby > 0 and barnum < ntype barnum = ntype end f4 = 0 if barcount = delta f4 = 1 endbarrec = rec + 1 end point = oldmpoint + barpar(barcount,1) prev_point = point point_adv = 0 half_back = point - oldmp2 / 2 larc2 = barpar(barcount,2) oldmpoint = point oldmp2 = point obx = 0 /* differential obx goto DE end Case II: everything else a1 = crec oldcdv = cdv perform getcontrol New 01/29/09 Fixing the object order problem. Here we impose the special condition that getcontrol should not be allowed to "back up" when dealing with grace notes at the end of a measure. if a1 > crec and csnode = 6913 if jtype = "G" or jtype = "C" crec = a1 cdv = oldcdv end end cdv_adv = cdv - oldcdv obx = dvar1 - cdv /* differential obx if crec <> a1 prev_point = point i = larc2 + 1 #if SCROLL_OUT max_larc = 30000 #else max_larc = 300 #endif loop for larc2 = i to max_larc point += larr(larc2,PRE_DIST) if larr(larc2,SNODE) = csnode a10 = larr(larc2,MNODE_TYPE) if a10 < 12 or a10 > 20 or a10 = cntype goto DE end end repeat Adding a second filter that relaxes the condition for success (01/18/04) point = prev_point /* since you are trying again, get old value of point loop for larc2 = i to max_larc point += larr(larc2,PRE_DIST) if larr(larc2,SNODE) = csnode a10 = larr(larc2,MNODE_TYPE) if csnode = 6913 and a10 = 18 goto DE end end repeat else goto DE end putc Logical error in finding node in part ~f12 at bar ~barnum putc putc Type $$ to see the section of i-file that generated this error. putc Type !! to exit program, or simple <Enter> to examine code. getc line line = trm(line) if line = "$$" loop for i = rec - 30 to rec + 40 tget [Z,i] line if i = rec putc .w6 ~i ~line else putc .w6 ~i ~line end repeat end putc Type !! to exit program, or simple <Enter> to examine code. getc examine stop differential obx and point now determined DE: point_adv = point - prev_point obx += point ++rec if jtype = "N" and f(f12,9) > 0 /* text only Code added 2-8-93 There was a problem with the continuation line not stopping when it was supposed to after a carry over from a previous measure. The problem occured only when the stopping note was the first in the new bar. I was not able to completely understand the logic of the code using nuxstop, but I was able to determine that the value of nuxstop had been set in the previous system of music and was greater than rmarg. I therefore introduced a new variable called firstbarflag, which is 0 when setting the first bar on a line, and 1 otherwise. I think the problem may occur only when nuxstop > rmarg and firstbarflag = 0. Therefore, in this case I 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 End of code added 2-8-93 #if SCORE_PARS if savenoby(f12) = oby nuxstop(f12) = sp + obx + hpar(f12,2) uxstop(f12) = nuxstop(f12) else uxstop(f12) = nuxstop(f12) nuxstop(f12) = sp + obx + hpar(f12,2) end #else if savenoby(f12) = oby nuxstop(f12) = sp + obx + hpar(f12,2) else nuxstop(f12) = sp + obx + hpar(f12,2) end #endif savenoby(f12) = oby * uxstop(f12) = sp + obx + hpar(f12,2) end if jtype = "R" and cflag = 1 if "Rr" con jtype and cflag = 1 /* New 10/15/07 obx = oldmpoint - oldmp2 + barpar(barcount+1,1) / 2 - notesize + oldmp2 if f(f12,12) = 1 obx = 20000 /* Taking this out 05/25/03 (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 Re-writing this section 12/24/03. The problem is that the old code dealt with suppressing D-type records below the top staff line by simply skipping them. This worked as long as the full score was being printed. But if the top line is taken out for some reason, then "top line" directives are lost. The solution is to suppress D-type records by setting the font in the W-subobjects to zero. This way the directives can be turned back on, if necessary 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 Now, turn off W-subobjects associated with this directive c8 = rec SKD2: tget [Z,c8] line2 .t3 sobx soby z temp if line2{1} = "W" and z <> 0 line2 = "W " // chs(sobx) // " " // chs(soby) // " 0 " line2 = line2 // "(" // chs(z) // ")" // temp tput [Z,c8] ~line2 ++c8 goto SKD2 end end General Object Related Activity 1. Collect super-object information CZ3: line = line{5..} perform strip2 line = trm(line) oby = int(line) Don't fix oby yet, because we may need staff info when constructing tie, slur, beam, tuplet, transpos, dashes, trills or wedges superobjects if oby >= 700 and f(f12,12) = 2 oby -= 1000 /* for superobjects, need oby relative to staff end if justflag < 2 #if CONTINUO if jtype = "F" obx += hpar(f12,23) end #endif ++mainyp 12/17/03 Here is where we determine the larr index which generated the value of "point". We will use larr_gen(.) to pass this information on to pointer(.,10) for this object in the edit section of the program. 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) if mnum > 120 dputc point = ~point pdist = ~pdist j = ~j loop for i = 1 to larc dputc ~cum_larr(i,1) repeat putc 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 tput [Y,mainyp] J ~jtype ~ntype ~obx ~line end perform strip4 lpt = 0 tline = txt(line,[' '],lpt) supcnt = int(tline) if supcnt > 0 loop for i = 1 to supcnt tline = txt(line,[' '],lpt) j = int(tline) if j = 0 putc putc Error: Wrong number of superobjects putc putc This is actually an obscure error that can be caused putc by AUTOSET trying to collapse two parts (I:2) into one. putc We suggest you check source files for duplicated triplets, putc or perhaps other duplicated super-objects (duplicate ties putc and slurs are O.K.) putc putc Another cause could be beam super-object "=" characters putc extending across grace notes. putc putc examine stop end look for previous reference to this superobject loop for k = 1 to N_SUPER /* N_SUPER is New 02/01/09 if supermap(f12,k) = j goto WA end repeat h = 0 loop for k = 1 to N_SUPER /* N_SUPER is New 02/01/09 if supermap(f12,k) = 0 h = k k = N_SUPER /* New 02/01/09 end repeat if h = 0 putc Error: No more superobject capacity examine stop end if not found, then set up reference to this superobject also set superdata(f12,k,5) = 0 for those super-objects which depend on two locations only and which can be split across a line or page break k = h supermap(f12,k) = j superpnt(f12,k) = 1 superdata(f12,k,5) = 0 superdata(f12,k,6) = 0 /* New 06/09/08 superdata(f12,k,7) = 0 /* New 06/09/08 k (value 1 to N_SUPER) = pointer into superdata for this superobject WA: h = superpnt(f12,k) 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 if this object is the last bar in a line, then set last bar flag in superdata if jtype = "B" and h = 1 superdata(f12,k,6) = f4 end repeat end End of General Object-related Activity saverec = rec if jtype = "R" if "Rr" con jtype /* New 10/15/07 loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} xbyte(f12){c8} = "*" end repeat end End of 12/27/05 change (eliminating code that did nothing) if jtype = "B" If this is the first part in which this particular bar line is encountered, then set value of barpar(.,3) and f5 if snode = 6913 and barpar(barcount,3) = 0 if oby >= 700 and f(f12,12) = 2 oby -= 1000 end barpar(barcount,3) = oby f5 = 0 #if SCROLL_OUT ++mainyp tput [Y,mainyp] w 0 -60 38 ~ntype #endif end if rec = endbarrec sobx = 0 if oby >= 700 /* oby -= 1000 /* Added 04/03/94 end /* if oby > 8 f5 = 2 ABX1: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "K" if z = 44 if sobx < 0 f5 |= 0x04 else f5 |= 0x01 end else if z > 88 line2 = trm(line2) if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end end end ++rec goto ABX1 end end if oby = 10 and f5 > 3 sobx = 0 - hpar(f12,16) - hpar(f12,17) - hpar(f12,18) soby = vpar(f12,3) if justflag < 2 ++mainyp tput [Y,mainyp] K ~sobx ~soby 44 soby = vpar(f12,5) ++mainyp tput [Y,mainyp] K ~sobx ~soby 44 end end if larc2 = larc and sobx > 0 bolddist(f12) = bolddist(f12) + sobx + hpar(f12,11) end end oby = 0 end if snode = 6913 Code added 8-24-93 It can happen that there are one or more grace notes before a controlling barline in this part. In this case, snode will be = 6913, but the grace note(s) DO NOT generate a larr node. Therefore these proper objects must not be considered as candidates for the end of the line. if jtype = "G" goto CZ end End of code added 8-24-93 i = point + sp dputc larc = ~larc larc2 = ~larc2 length = ~i max = ~hxpar(4) In determining whether this node is the last node in the line for this part, we must consider the case where there was a clef change or time change or key change at the end of the line and where this change occurred in some parts but not in others. For this purpose, we have introduced a fifth element in the larr array, which is 0 for nodes <> 6913 and is a flag for active parts for nodes = 6913 (bit 0 corresponds to part 1). If the current node is a bar line, but is not the last node, and if all remaining nodes are of the type, snode = 6913, and none of these nodes has the current part as active, then this is the last node on the line, EVEN THOUGH LARC <> LARC2! k = 0 if larc2 <> larc and f4 = 1 q1 = rec loop for h = larc2 + 1 to larc if larr(h,SNODE) <> 6913 goto C21A end if bit(f12-1,larr(h,ACT_FLAG)) = 1 goto ABX16 /* goto secondary test end repeat k = 1 goto C21A /* This is a test 10/12/07 ABX16: /* secondary test tget [Z,q1] line2 .t5 q2 q2 q2 q2 q2 ++q1 if line2{1} <> "J" goto ABX16 /* keep looking for a "J" end if q2 = 6913 goto C21A /* set k = 1 if not 6913 end k = 1 /* bar is last node on line end C21A: if larc2 = larc or k = 1 check to see of the current record = the control record if not then this is not the last record in the line h = saverec - 1 if h <> crec if not last record in line, look for time directive or clef sign 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 9-29-93 but not thoroughly tested goto CZ end putc Error: Unexplained non-controlling object at end of line putc This error can sometimes result from a mistake in one of the putc source files. Essentially, MSKPAGE found an object at the putc end of a measure that it did not expect to find. For example, putc word objects such as "Da Capo" may occur at the end of a measure, putc but letter dynamics (symbols) should not. In one case I ran putc across recently, a word musical direction (B,C,or D) was mistakenly putc encoded as a letter dynamic (G). This generated a symbol at putc the end of a measure, which caused MSKPAGE to fail at this point. putc Enter $$ to see the relevant portion of the i-file putc Enter !! to terminate program getc line2 line2 = trm(line2) if line2 = "$$" loop for k = crec - 30 to crec + 30 tget [Z,k] line2 if k = h putc .w6 ~k ~line2 .t60 Unexplained object else if k = crec putc .w6 ~k ~line2 .t60 End of measure else putc .w6 ~k ~line2 end end repeat putc putc Enter !! to terminate program getc end examine stop end 11/21/07 Expanding this section to allow directives to be cast to the next line (using c12, c13) if endflag = 0 /* skip over directives SKD1: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "W" ++rec goto SKD1 end end if endflag = 0 c12 = 0 if jtype = "D" /* skip over directives and store data for next line c13 = rec - 1 SKD1: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "W" c12 = 1 ++rec goto SKD1 end end if c12 = 1 ++new_dircnt new_direct(new_dircnt,1) = f12 new_direct(new_dircnt,2) = c13 end end End of 11/21/07 expansion goto CZ end look for sub-objects to typeset k = 0 ABX2: tget [Z,rec] line2 .t3 sobx soby z if line2{1} = "W" /* code added 02-23-97 if justflag < 2 tget [Z,rec-1] line2 if line2{1,3} = "J B" /* then this WORD is a centered number tget [Z,rec] line2 line2 = line2{3..} h = int(line2) line2 = line2{sub..} line2 = mrt(line2) h -= half_back line2 = "W " // chs(h) // " " // line2 end ++mainyp tput [Y,mainyp] ~line2 end ++rec goto ABX2 end /* end of 02-23-97 addition if line2{1} = "K" h = sobx if z = 63 h += hpar(f12,6) end if z > 63 and z < 66 h += hpar(f12,7) end if z > 36 and z < 39 h += hpar(f12,9) end if z > 70 and z < 81 h += hpar(f12,10) end line2 = trm(line2) if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end if h > k k = h end ++rec goto ABX2 end if line2{1} = "A" /* Added 11-11-93 if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end ++rec goto ABX2 end if k > 0 bolddist(f12) += k end check for super-objects at this point in the file loop tget [Z,rec] line ++rec temp = line{1} if temp = "H" superline = trm(line) lpt = 3 tline = txt(line,[' '],lpt) line structure = supernum htype . . . supernum = int(tline) get superdata for this superobject loop for k = 1 to N_SUPER /* N_SUPER is New 02/01/09 if supermap(f12,k) = supernum goto WB2 end repeat putc Error: No refererce to superobject ~supernum in previous objects examine stop * k = index into superdata WB2: htype = txt(line,[' '],lpt) perform save1 supermap(f12,k) = 0 end repeat while temp = "H" --rec look for incomplete superobjects and underlines f(f12,6) = rec f(f12,5) = rec #if REPORT putc part = ~f12 barnum = ~barnum NEXTREC = ~rec #endif loop for k = 1 to N_SUPER /* N_SUPER is New 02/01/09 if supermap(f12,k) = 0 goto CL end rec = f(f12,6) 1) look for object that terminates this super-object get x and y coordinates of this object loop perform save3 /* want vstaff info; (raw oby) #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if snode = 10000 putc Error: No terminating object for super-object ~supermap(f12,k) putc putc This error occurred in part number ~f12 of the score at putc approximately measure number ~(barnum - 1) . The first step would be putc to look in the stage2 source file for this part. Be sure to look putc in the right file; it's name may not be the same as it's order putc in the score. putc putc If you do not find any obvious error in the stage2 source file, putc you should look in the i-file which generated this error. The putc super-object number is given above. Load the i-file into a putc screen and do a search for that specific number. It will turn putc up somewhere as a super-object (one of the last numbers in an putc object line). You can then determine the object to which this putc super-object is attached and the exact measure in which it is putc first referenced. This should give you some clue as to what putc kind of super-object it was and why the terminating object was putc missing. putc putc The location of the error may be related to location of the putc super-object only indirectly. For example, a beam on some grace putc notes (a super_object) might be open and closed properly, but if putc a (much) later grace note has an "=" in column 26 (i.b46 e.b46 , super- putc object not properly started), then mskpage may try to re-open putc the earlier super-object -- hence a much lower super-object putc number than would be expected at the error location. I actually putc had a case where the given location was near the beginning of a putc file, but the coding error was near the end of a previous file! putc putc If you still cannot find an error in the source file, the problem putc may be in the software. Make a bug report and include a copy putc of the relevant source file. putc putc Enter !! to terminate program. getc examine stop end x = dvar1 - bolddist(f12) y = oby perform strip8 lpt = 0 tline = txt(line,[' '],lpt) n = int(tline) if n > 0 loop for a1 = 1 to n tline = txt(line,[' '],lpt) a2 = int(tline) if a2 = supermap(f12,k) goto WC /* Object found end repeat end end repeat 2) look for superobject (beyond object) WC: loop perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" and snode = 10000 putc Error: Missing superobject ~supermap(f12,k) , possible extra beam code examine stop end if line{1} = "H" lpt = 3 tline = txt(line,[' '],lpt) n = int(tline) if supermap(f12,k) = n htype = txt(line,[' '],lpt) if htype = "B" putc Error: Beam extends over control bar line examine stop end Incomplete Tie (section re-coded 05/28/03 to fix suggestions for incomplete ties) if htype = "T" sub = lpt y1 = int(line{sub..}) x1 = int(line{sub..}) x2 = int(line{sub..}) c1 = int(line{sub..}) c2 = int(line{sub..}) c3 = int(line{sub..}) sitflag = int(line{sub..}) tspan = rmarg - sp - x1 if justflag < 2 * create mark for end of tie ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n * create "first half" of super-object ++mainyp tput [Y,mainyp] H ~n T ~y1 ~x1 0 ~c1 ~c2 0 ~sitflag 0 end * * * By setting supermap(k) = 0 at this point, you will cause superdata to be collected on only the terminating note of the tie. In this case, superpnt(.) will be 2 instead of 4, and the program will know to typeset a small end-tie. * * * conttie(f12) = 1 /* Code added 02/25/97 supermap(f12,k) = 0 goto CL end Incomplete Slur if htype = "S" tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) a3 = int(tline) x1 = a3 + superdata(f12,k,1) tline = txt(line,[' '],lpt) a4 = int(tline) y1 = a4 + superdata(f12,k,2) if y1 > 700 y1 -= 1000 /* correct for vstaff flag end tline = txt(line,[' '],lpt) x2 = int(tline) + rmarg + x - sp tline = txt(line,[' '],lpt) a5 = 0 if y > 700 y -= 1000 /* correct for vstaff flag a5 = 1000 /* and add vstaff offset to location flag end y2 = int(tline) + y * compute second height as a percentage of total change a2 = x2 - x1 a1 = rmarg - sp - x1 * 20 / a2 y2 = y2 - y1 * a1 / 20 + y1 x2 = rmarg - sp y2 += a5 * set broken super-object flag if y2 = 0 y2 = 1 end superdata(f12,k,5) = y2 /* include virtual staff flag if justflag < 2 * create mark for end of slur ++mainyp tput [Y,mainyp] J M 0 ~syslen ~y2 0 6913 0 1 ~n * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n S ~sitflag ~a3 ~a4 0 0 0 0 0 end goto CL end Incomplete figure continuation lines if htype = "F" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) x2 = rmarg - sp * set broken super-object flag superdata(f12,k,5) = 1 if justflag < 2 * create mark for end of figure continuation lines ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n F ~a3 ~x1 0 0 end goto CL end Incomplete octave transposition if htype = "V" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(f12,k,2) /* tline = txt(line,[' '],lpt) a1 = 0 x2 = rmarg - sp a4 = x2 - x1 * set broken super-object flag superdata(f12,k,5) = 1 * create mark for end of octave transposition (mindful of virtual staff possibility) if justflag < 2 if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n V ~a3 ~x1 0 ~y1 0 end goto CL end Incomplete ending if htype = "E" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) a2 = 0 x2 = rmarg - sp * create mark for end of incomplete ending if justflag < 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end 05/06/08 superdata(.,.,5) has been designated as the flag from a split ending In earlier verious of mskpage, it had only one non-zero value, namely 1 Now it has three possible non-zero values: 1 = normal split. (I believe this may no longer be used) 2 = split where the ending starts at the beginning of the page 3 = signals that the ending was started on a previous page superdata(.,.,7) is used to flag this superobject as an ending (magic number) if superdata(f12,k,6) = 0 or superdata(f12,k,5) = 2 /* New 05/06/08 * write "first half" of super-object if justflag < 2 ++mainyp tput [Y,mainyp] H ~n E ~a3 ~x1 0 ~y1 ~a1 0 end * set broken super-object flag to 3 superdata(f12,k,5) = 3 else if justflag < 2 ++mainyp tput [Y,mainyp] H ~n N end * set broken super-object flag to 2 superdata(f12,k,5) = 2 end * set broken super-object flag superdata(f12,k,5) = 1 superdata(f12,k,7) = 123456 /* New 05/06/08 goto CL end Incomplete dashes if htype = "D" tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) x2 = rmarg - sp * set broken super-object flag superdata(f12,k,5) = 1 superdata(f12,k,6) = 234567 /* New 06/09/08 magic number for dashes if justflag < 2 New code 06/09/08 If this is a page length set of dashes, put in a mark for the beginning if superdata(f12,k,7) = 1 x1 = hxpar(8) - sp if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~n end x1 = 0 end End of 06/09/08 Code Now create mark for end of dashes (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" (or "full length") super-object ++mainyp tput [Y,mainyp] H ~n D ~x1 0 ~y1 ~a1 ~a2 end goto CL end Incomplete Long Trill if htype = "R" tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) x2 = rmarg - sp tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(f12,k,2) * set broken super-object flag superdata(f12,k,5) = 1 * create mark for end of long trill (mindful of virtual staff possibility) if justflag < 2 if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n R ~a1 ~x1 0 ~y1 end goto CL end Incomplete Wedge if htype = "W" tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) /* + superdata(f12,k,1) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = rmarg - sp tline = txt(line,[' '],lpt) y2 = int(tline) * compute second spread if c1 < c2 if c1 = 0 a1 = c2 - 1 / 2 c2 = c2 * 3 / 4 else a1 = c2 end else if c2 = 0 c2 = c1 / 2 a1 = c1 * 3 / 4 else a1 = c1 end end * set broken super-object flag if a1 = 0 a1 = 1 end superdata(f12,k,5) = a1 * create mark for end of wedge (mindful of virtual staff possibility) if justflag < 2 if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~syslen 1000 0 6913 0 1 ~n else ++mainyp tput [Y,mainyp] J M 0 ~syslen 0 0 6913 0 1 ~n end * write "first half" of super-object ++mainyp tput [Y,mainyp] H ~n W ~c1 ~c2 ~x1 ~y1 0 ~y2 end goto CL end end end repeat CL: repeat loop for c8 = 1 to f(f12,13) if "_,.;:!?" con xbyte(f12){c8} xbyte(f12){c8} = "*" end repeat End of 12/27/05 code change (to remove code that did nothing) 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" S U B - O B J E C T S ───────────────────── tget [Z,rec-1] line2 line2 = trm(line2) if justflag < 2 if conttie(f12) = 1 /* (somewhat tricky solution) line2{1} = "K" /* Code added 02/25/97 end ++mainyp tput [Y,mainyp] ~line2 end goto CZ end if line{1} = "A" /* Added 11-11-93 A T T R I B U T E S ─────────────────── tget [Z,rec-1] line2 line2 = trm(line2) if justflag < 2 ++mainyp tput [Y,mainyp] ~line2 end goto CZ end if line{1} = "W" W O R D S ───────── line = trm(line) if justflag < 2 tget [Z,rec-2] line2 /* added 02-23-97 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 02-23-97 addition ++mainyp #if SCROLL_OUT line{1} = "w" #endif tput [Y,mainyp] ~line end goto CZ end if line{1} = "T" T E X T (This code re-organized 12/19/03 to deal with optional sobx2) ─────── Step 1: determine object record to which this text belongs dputc Text record as read = ~line from position ~(rec-1) trec = rec - 2 /* rec was advanced after getting "T" record TX1: tget [Z,trec] line2 if line2{1} <> "J" and trec > 1 --trec goto TX1 end Step 2: save current value of backtxobrec and set a new value for backtxobrec Correcting a Bug found 11/12/06 c15 = backtxobrec backtxobrec = trec if c15 <> backtxobrec c15 = backtxobrec backtxobrec = trec end End of 11/12/06 Correction Step 3: gather information from current line 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 " " Step 4: Determine if the opportunity exists to improve the placement of text We now have the following information at this point: point_adv = amount by which the x-pointer has advanced to produce this "group" of objects cdv_adv = amount by which the x-pointer in the source i-file advanced to produce this note object If point_adv is significantly (?) bigger than cdv_adv (i.e., there is now ample space to the left of this note), AND sobx2 is smaller (i.e., more negative) than sobx (i.e., the ideal position of the text is to the left of the practical position), then we can use sobx2 in place of sobx in positioning the text. Also, if point_adv is significantly (?) bigger than cdv_adv (i.e., there is now ample space to the left of this note), AND the sobx2 from the previous note containing text was larger (i.e., less negative) than the sobx for that note (i.e., the ideal position of the text is to the right of the practical position for the previous note), then we should try to go back to the previous text record(s) and replace the sobx with a saved_sobx2. To do this, we will need a valid back pointer to note object which generated previous text records, and the saved_sobx2 value. c10 = point_adv - cdv_adv if c10 > 0 dputc c10 = ~c10 (extra distance between this and last note with text) Step 5: c10 > 0. Try to determine how best to use this "extra" space. Step 5a: determine value of sobx (c11) for previous note with text if c15 > 0 trec = c15 + 1 TX2: tget [Z,trec] line2 .t3 c11 if line2{1} <> "T" 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 Step 5b: determine benefit to moving previous text to the right (c12) --> if saved_sobx2 <> 100 and saved_sobx2 > c11 /* benefit to moving text --> c12 = saved_sobx2 - c11 else c12 = 0 end Step 5c: determine benefit to moving current text to the left (c13) <-- if sobx2 <> 100 and sobx2 < sobx c13 = sobx - sobx2 /* a positive number in this scheme else c13 = 0 end Step 5d: determine how to distribute extra distance. c14 = c12 + c13 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 Step 6: Move the horizontal position of text as appropriate Step 6a: if c12 > 0, move previous text position(s) to the right --> 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..} dputc New (previous) text record = ~line2 end ++trec tget [Z,trec] line2 repeat while "KTk" con line2{1} end Step 6b: if c13 > 0, move current text position to the left <-- if c13 > 0 sobx -= c13 dputc position of current text moved from ~(sobx + c13) to ~sobx end end Step 7: Save current value of sobx2 saved_sobx2 = sobx2 Step 8: Reconstitute this "T" text line without sobx2 and recompute lpt line = "T " // chs(sobx) // " " // chs(soby) // tline dputc return line = ~line to position ~(rec-1) tput [Z,rec-1] ~line Step 9: Recompute lpt 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) Step 10: if justflag < 2, store line in Y table if justflag < 2 ++mainyp tput [Y,mainyp] ~line end End of 12/19/03 code re-write 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 * 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" S U P E R - O B J E C T S ───────────────────────── superline = trm(line) lpt = 3 tline = txt(line,[' '],lpt) * line structure = supernum htype . . . supernum = int(tline) * get superdata for this superobject loop for k = 1 to N_SUPER /* N_SUPER is New 02/01/09 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" structure of tie superobject: 4. vertical position of tied note 5. horiz. displacement from 1st note 6. horiz. displacement from 2nd note 7. vacent 8. vacent 9. vacent 10. sitflag 11. recalc flag 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) determine first note location (x1,y1) and tspan 1. Normal case if superpnt(f12,k) = 5 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end tspan = superdata(f12,k,3) + x2 - x1 end 2. Continued tie if superpnt(f12,k) = 3 x1 = superdata(f12,k,1) + x2 - hpar(f12,1) tspan = hpar(f12,1) if justflag < 2 * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum * create "second half" of super-object ++mainyp tput [Y,mainyp] H ~supernum T ~y1 0 ~x2 0 0 0 ~sitflag 0 end end supermap(f12,k) = 0 conttie(f12) = 0 /* Code added 02/25/97 goto CZ end if htype = "B" structure of beam superobject: slope vertoff font# #obs bc(1) ... tline = txt(line,[' '],lpt) @k = int(tline) tline = txt(line,[' '],lpt) @m = int(tline) temp2 = line{lpt..} temp2 = mrt(temp2) tline = txt(line,[' '],lpt) beamfont = int(tline) j = Mbeamfont(notesize) /* covers all 12 notesizes if beamfont = j stemchar = 59 beamh = vpar(f12,16) beamt = vpar(f12,32) else stemchar = 187 beamh = vpar(f12,16) * 4 / 5 beamt = vpar(f12,32) * 4 + 3 / 5 end tline = txt(line,[' '],lpt) bcount = int(tline) if bcount > MAX_BNOTES j = MAX_BNOTES putc At the present time, this program can only accommodate ~j notes putc under one beam. To increase this capacity, the parameters: MAX_BNOTES putc and SUPERSIZE will need to be increased. putc putc Program Halted putc stop end j = 1 loop for i = 1 to bcount beamdata(i,1) = superdata(f12,k,j) beamdata(i,2) = superdata(f12,k,j+1) temp = txt(line,[' '],lpt) temp = rev(temp) e = 6 - len(temp) beamcode(i) = temp // "00000"{1,e} j += 2 repeat * print beam perform setbeam supermap(f12,k) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] H ~supernum ~htype ~@k ~@m ~temp2 end goto CZ end if htype = "S" structure of slur superobject: 4. sitflag 5. extra horiz. displ. from obj-1 6. extra vert. displ. from obj-1 7. extra horiz. displ. from obj-2 8. extra vert. displ. from obj-2 9. post horiz. displ. 10. post vert. displ. 11. stock slur number tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) y1 = superdata(f12,k,5) if y1 = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end else tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) a3 = int(tline) x2 = a3 + superdata(f12,k,3) x1 = hxpar(8) - sp - notesize a1 = x2 - x1 if a1 < hpar(f12,14) a2 = hpar(f12,14) - a1 x1 -= a2 end tline = txt(line,[' '],lpt) y2 = int(tline) /* + superdata(f12,k,4) * create mark at beginning of line (mindful of virtual staff possibility) if justflag < 2 if y1 > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum y1 -= 1000 else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of super-object ++mainyp tput [Y,mainyp] H ~supernum S ~sitflag 0 ~y1 ~a3 ~y2 0 0 0 end end supermap(f12,k) = 0 goto CZ end if htype = "F" structure of figcon super-object: 4. figure level 5. horiz. disp. from obj1 6. horiz. disp. from obj2 tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) if justflag < 2 if superdata(f12,k,5) = 0 ++mainyp tput [Y,mainyp] ~superline x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum * create "second half" of super-object ++mainyp tput [Y,mainyp] H ~supernum F ~a3 0 ~x2 0 end end supermap(f12,k) = 0 goto CZ end if htype = "X" structure of tuplet super-object: 4. situation flag 5. tuplet number 6. horiz. disp. from obj1 7. vert. disp. from obj1 8. horiz. disp. from obj2 9. vert. disp. from obj2 10. associated beam super-number if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end supermap(f12,k) = 0 goto CZ end For the rest of the superbjects, please see code at procedure save1 perform save1 supermap(f12,k) = 0 goto CZ end CW: if barnum > newbarnum newbarnum = barnum end * mark end of line if justflag < 2 ++mainyp tput [Y,mainyp] E ~xbyte(f12) end repeat New 11/21/07 loop for c12 = 1 to new_dircnt save_direct(c12,1) = new_direct(c12,1) save_direct(c12,2) = new_direct(c12,2) repeat save_dircnt = new_dircnt new_dircnt = 0 barnum = newbarnum Check to see that multiple rest flags are equal *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 @F26 @F23 @F21 @S27 8. Typeset bar lines @ Typeset bar lines if gbarflag = 1 if justflag < 2 ++mainyp tput [Y,mainyp] B ~gbar(2) ~gbar(1) 0 end gbarflag = 0 end obx = pdist /* + sp loop for barcount = 1 to delta obx += barpar(barcount,1) a8 = barpar(barcount,3) if barcount = delta if a8 = 9 a8 = 5 end if a8 = 10 a8 = 6 end end if justflag < 2 ++mainyp tput [Y,mainyp] B ~a8 ~obx 0 end repeat @F27 @S28 9. At this point you have completed the typsetting @ of a complete system. Now is the time to look for @ optional staff lines (i.e., staff line that are @ flagged to be taken out if they contain nothing @ but rests. @ Code added for running a "simple_test" 11/20/06 if simple_test = 1 goto NO_TAKEOUT end End of 11/20/06 addition At this point you have completed the typesetting of a complete system New code (12/24/03) added to implement optional staff lines 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 putc putc I-code for next system putc loop for y3p = y1p to y2p tget [Y,y3p] line putc .w5 ~y3p ~larr_gen(y3p) ~line repeat putc getc c9 = 0 c10 = 0 c11 = 0 c12 = 0 c13 = 0 loop for y3p = y1p to y2p tget [Y,y3p] line if line{1} = "S" c10 = y3p end if line{1} = "L" or line{1} = "l" /* "l" added 12/18/05 ++c9 c13 = 0 c11 = y3p 03/25/06 Dealing with possible @ LINE record if andata_flag > 0 tget [Y,y3p-1] temp temp = temp // pad(60) if temp{1,7} = "@ LINE:" --c11 end end end if line{1} = "E" dputc type1_dflag(~c9 ) = ~type1_dflag(c9) type2_dflag(~c9 ) = ~type2_dflag(c9) getc c12 = y3p if c13 = 0 or type1_dflag(c9) = ON or type2_dflag(c9) = ON /* modified 01/06/04 if c13 = 0 Step E-1: Modify System line dputc sysy = ~sysy dputc c9 = ~c9 tsq(c9) = ~tsq(c9) tsq(c9+1) = ~tsq(c9+1) c15 = ~c15 tget [Y,c10] line2 dputc line2 = ~line2 sub = 3 c8 = int(line2{sub..}) /* 0 c8 = int(line2{sub..}) /* system x c8 = int(line2{sub..}) /* system y c8 = int(line2{sub..}) /* system length c6 = sub c8 = int(line2{sub..}) /* system height if tf11 = 1 putc putc You have reached a point in this program where the code below will putc fail. While not all cases of this situation have been identified, putc it is known that this situation will arise the follow conditions hold: putc putc (1) You are typesetting a part (not a score) putc (2) You are using the C0:y<#> control flag to turn lines off putc putc In this situation, you must turn off the multiple measure feature, putc which is automatically (and silently) turned on when parts are being putc compiled by autoset. Use the print suggestion: P C0:m0 putc in all relevent stage2 files. I hope this works for you (and me). putc putc Program Halted putc end if c9 < tf11 c14 = tsq(c9+1) - tsq(c9) else c14 = tsq(tf11) - tsq(tf11-1) c14 += 4 * tnotesize(tf11) /* staff line thickness for tf11 c14 -= 4 * tnotesize(tf11-1) /* staff line thickness for tf11-1 if tvst(tf11) > 0 c14 += tvst(tf11) /* 2nd line for tf11 end if tvst(tf11-1) > 0 c14 -= tvst(tf11) /* 2nd line for tf11-1 end end c8 -= c14 /* takeout on this "pass" c16 += c14 /* cumulative total takeout c7 = int(line2{sub..}) /* number of parts --c7 line2 = line2{1,c6} // chs(c8) // " " // chs(c7) // line2{sub..} 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} dputc temp = ~temp line2 = line2 // " " MTK: if line2{sub-1} = "(" and line2{sub+1} = ")" line2 = line2{1,sub-2} // line2{sub} // line2{sub+2..} --sub goto MTK end if line2{sub-1} = "[" and line2{sub+1} = "]" line2 = line2{1,sub-2} // line2{sub} // line2{sub+2..} --sub goto MTK end if line2{sub-1} = "{" and line2{sub+1} = "}" line2 = line2{1,sub-2} // line2{sub} // line2{sub+2..} --sub goto MTK end line2 = line2{1,sub-1} // line2{sub+1..} if line2 con "[" if line2{mpt+1} = "]" if mpt = 1 dputc Program Error stop else line2 = line2{1,mpt-1} // line2{mpt+2..} end end end if line2 con "{" if line2{mpt+1} = "}" if mpt = 1 dputc Program Error stop else line2 = line2{1,mpt-1} // line2{mpt+2..} end end end dputc new line2 = ~line2 dputc tput [Y,c10] ~line2 Step E-2: Eliminate the records between c11 and c12; also adjust all Line records loop for c14 = c11 to c12 tget [Y,c14] line putc ~line repeat c15 = c12 - c11 + 1 loop for c14 = c12 + 1 to y2p tget [Y,c14] line2 if line2{1} = "L" or line2{1} = "l" /* "l" added 12/18/05 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..} line2 = line2{1} // " " // chs(c8) // line2{sub..} /* Modified 12/18/05 end tput [Y,c14-c15] ~line2 repeat mainyp -= c15 Step E-4: If c9 = 1, turn on the measure numbers for the new top line and turn on any "top line" directives that might be present in the line if c9 = 1 loop for c14 = c11 to mainyp tget [Y,c14] line2 line2 = line2 // pad(40) if line2{1,2} = "W " c8 = int(line2{2..}) /* x offset c8 = int(line2{sub..}) /* y offset c7 = sub /* c7 -> space before font number c8 = int(line2{sub..}) if c8 = 0 /* directive has been "turned off" c17 = sub /* c17 -> space after font number if line2{c17+1} = "(" c8 = int(line2{c17+2..}) /* proper font is in () if c8 <> 0 c17 = sub + 1 /* c17 -> space after ")" else c8 = M_NUM_FONT end else c8 = M_NUM_FONT end line2 = line2{1,c7} // chs(c8) // line2{c17..} tput [Y,c14] ~line2 end else if line2{1} = "E" /* Exit loop c14 = mainyp end end repeat end Step E-5: Adjust tsq(.), tvst(.), tnotesize(.), bottom_sq, tf11, type1_dflag, type2_dflag, to match with system of 1 fewer lines. 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 01/06/04 type2_dflag(c8-1) = type2_dflag(c8) /* " " repeat end --tf11 bottom_sq = tsq(tf11) Step E-5a: Adjust elements of larr_gen array for records beyond c12 loop for c14 = c12 + 1 to y2p larr_gen(c14-c15) = larr_gen(c14) larr_gen(c14) = 0 repeat Step E-6: Circle back to top of process; look for more lines to take out goto TAKEOUT end end This "J" section looks for legitimate musical notation in the line; sets c13 = 1, if found. if line{1} = "J" if "GQNMR" con line{3} if "GQNMRr" con line{3} /* New 10/15/07 if "GQNRr" con line{3} /* New 10/28/07 if line{3} <> "R" if line{3} <> "R" and line{3} <> "r" /* New 10/15/07 if c13 = 0 dputc setting c13 to 1 line = ~line end c13 = 1 else if line{3,3} <> "R 9" if line{3,3} <> "R 9" and line{3,3} <> "r 9" /* New 10/15/07 if line{3} <> "r" /* New 10/15/07 if c13 = 0 dputc setting c13 to 1 line = ~line end c13 = 1 end else sub = 7 c8 = int(line{sub..}) /* obx c8 = int(line{sub..}) /* oby c8 = int(line{sub..}) /* pcode c8 = int(line{sub..}) /* "1" c8 = int(line{sub..}) /* inctype dputc sub = ~sub line = ~line if c8 <> 10001 if c8 <> 10001 and line{3} <> "r" /* New 10/15/07 if c13 = 0 dputc setting c13 to 1 line = ~line end c13 = 1 end end end end end putc ~line repeat getc Cleanup Section: Fix all "stray" Q records and 10001 inctypes loop for y3p = y1p to y2p tget [Y,y3p] line if line{1,3} = "Q R" if line{1,3} = "Q R" or line{1,3} = "Q r" /* New 10/15/07 line = "J " // line{3..} line = "J R " // line{5..} /* New 10/15/07 tput [Y,y3p] ~line end if line{1,6} = "J R 9 " if line{1,6} = "J R 9 " or line{1,6} = "J r 9 " /* New 10/15/07 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 dputc ~line line = "J R 9 " // chs(c8) // " " // chs(c9) // " " // chs(c10) // " 1 0" // line{sub..} dputc ~line tput [Y,y3p] ~line end end /* New 10/15/07 if line{1,3} = "J r" line = "J R " // line{5..} /* New 10/15/07 tput [Y,y3p] ~line end repeat Cleanup, part II: Re-set bottom of system if c16 > 0 sys_bottom -= c16 sq(f11) -= c16 end end End of 12/24/03 addition NO_TAKEOUT: #if XVERSION At this point you have completed the typesetting of a complete system Now is the time to look at that system and decide what, if any, horizontal modifications need to be made. Note: This code can be executed here irrespective of whether the system fits on this page or whether it must be advanced to a new page. if justflag < 2 y2p = mainyp putc putc I-code for next system putc loop for y3p = y1p to y2p tget [Y,y3p] line putc ~line repeat getc 12/17/03 At this point, the decision must be made whether to enter the edit module. If psysnum = 0, and there is a format file (formatflag = 1), and it contains larr data (forp < forpz), we need to ask the user whether page generation should proceed automatically or whether some re-editing is desired. This will determine bit-0 of edflag. if psysnum = 0 if formatflag = 1 and forp < forpz putc putc The Format file contains page specific data putc Enter "y" or "Y" 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 12/17/03 At this point, we can re-constitute the PRE_DIST values from the cum_larr(.,.) array 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 12/17/03 The larr(larc,.) array is now in its final form (all editing that is going to be done has been done). If formatflag = 1, the values in larr(.,.) need to be copied back into the format file (via bigline). If formatflag = 2, a new line entry for the emerging format file needs to be generated from larr(.,.). ++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 @F28 @S29 10. Now we have the final sq(.)'s and we can check to @ see of we have "overrun" the bottom of the page. @ If so, we need to start a new page and reset the @ height of the system to top of the page. If this @ is the first system on the first page, and we have @ overrun the bottom, the program needs to report @ this condition and HALT. @ Report on progress #if MREPORT if justflag > 1 putc .t5 measure ~mnum end #endif New page control code 12/24/03 if justflag < 2 c16 = sys_bottom Step 0: Report on progress 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 Step 1: Setup new page and tranfer all but the last system perform newpage #if SCORE_PARS perform process_and_transfer (sv_mainyp) #else perform output_page (sv_mainyp) #endif Step 2: Move last system to top of table; fix system line. There will be a new value of mainyp 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] spaging code #if SCORE_PARS tput [Y,1] X 31 100 3020 ~header1 tput [Y,2] X 31 100 3055 ~header2 tput [Y,3] X 31 1200 3055 ~header3 tput [Y,4] X 31 2120 3020 Page: ~(page + 1) mainyp = 4 sv_mainyp = 4 Step 3: Load last system into top of Y table. Increment mainyp loop for c10 = 1 to c14 tget [T,c10] line ++mainyp tput [Y,mainyp] ~line repeat xmskpage code #else Step 3: Load last system into top of Y table. Increment mainyp loop for mainyp = 1 to c14 tget [T,mainyp] line tput [Y,mainyp] ~line repeat End of split #endif Step 4: Adjust value of bottom_sq (sq(f11)) bottom_sq -= c13 sys_bottom -= c13 end end @F29 @S30 11. If task is not complete, jump to top of general @ music system loop @ if endflag = 1 goto FINE end goto CHH * @F30 @ IV. End of program @ @S31 Normal exit @ @ FINE: if justflag < 2 if mainyp > 0 perform newpage #if SCORE_PARS perform process_and_transfer (mainyp) #else perform output_page (mainyp) #endif end end if justflag > 1 #if MREPORT #else putc #endif New code 05/28/05 for mid-movement justification t1 = 0 t2 = 1 start_sys = 0 start_look = 1 dputc First: Look at the complete set of sysbarpar data putc ========================================================== loop for i = 1 to syscnt putc For system ~i : putc --------------------------------------------- putc sysbarpar(~i ,1) = ~sysbarpar(i,1) putc sysbarpar(~i ,2) = ~sysbarpar(i,2) putc sysbarpar(~i ,3) = ~sysbarpar(i,3) putc sysbarpar(~i ,4) = ~sysbarpar(i,4) putc sysbarpar(~i ,5) = ~sysbarpar(i,5) putc repeat putc Done putc getc dputc Second: If sysbarpar(.,5) > sysbarpar(.1), fix it New code 10/15/07 to fix a corner case. I actually think there may be more to it than this, but this fix is a start. loop for i = 1 to syscnt if sysbarpar(i,5) > sysbarpar(i,1) sysbarpar(i,5) = 0 end repeat dputc Second: Look at the complete set of sysbarpar data again putc =============================================================== loop for i = 1 to syscnt putc For system ~i : putc --------------------------------------------- putc sysbarpar(~i ,1) = ~sysbarpar(i,1) putc sysbarpar(~i ,2) = ~sysbarpar(i,2) putc sysbarpar(~i ,3) = ~sysbarpar(i,3) putc sysbarpar(~i ,4) = ~sysbarpar(i,4) putc sysbarpar(~i ,5) = ~sysbarpar(i,5) putc repeat putc Done putc getc new_start_look = 1 loop for i = 1 to syscnt dputc sysbarpar(~i ,1) = ~sysbarpar(i,1) dputc sysbarpar(~i ,5) = ~sysbarpar(i,5) putc if sysbarpar(i,5) > 0 ++t1 if start_sys = 0 if sysbarpar(i,5) < sysbarpar(i,1) new_syscnt(t1) = i if new_maxsystems(t1) = 0 new_maxsystems(t1) = i end start_sys = t1 start_look = t2 else if i = syscnt start_sys = t1 start_look = t2 new_syscnt(t1) = syscnt if new_maxsystems(t1) = 0 new_maxsystems(t1) = syscnt end end end dputc new_syscnt(~t1 ) = ~new_syscnt(t1) dputc new_maxsystems(~t1 ) = ~new_maxsystems(t1) dputc start_sys = ~start_sys dputc start_look = ~start_look t2 = i + 1 end getc end HERE: repeat if t1 < 2 goto OLD_JUST end section_cnt = t1 putc Execute New Just mspace(mcnt) += deadspace * 100000 j = 1 loop for i = 1 to mcnt if mspace(i) > 100000 k = mspace(i) / 100000 mspace(i) = rem mspace2(i) = rem loop for h = j to i mspace(h) -= k repeat loop for h = i to j + 1 step -1 mspace(h) -= mspace(h-1) repeat j = i + 1 else mspace2(i) = mspace(i) end repeat putc 1... loop for i = 1 to mcnt putc .w6 ~mspace(i) ... j = i / 10 if rem = 0 putc putc .w6 ~i ... end repeat putc putc loop for t1 = start_sys to section_cnt dputc .w6 ~t1 ~section_cnt ~new_syscnt(t1) if no_action = t1 no_action = 0 goto NEXT_JUST end j = 0 k = 0 loop for i = start_look to new_syscnt(t1) j += sysbarpar(i,2) ++k repeat if k > 0 average_extra = j / k else goto REALWORK /* New 11/23/07 Another cluge. end if new_syscnt(t1) > new_maxsystems(t1) putc We have inadvertantly overstepped our target size for section ~t1 ++sysbarpar(lastk,3) new_start_look = lastk + 1 start_look = lastk + 1 if old_extra < 2 * average_extra or lastk >= new_syscnt(t1) - 1 putc We must go back to a previous solution for this section. no_action = t1 goto REALWORK justflag = 1 goto REALWORK end j = 1000000 k = 0 loop for i = start_look to new_syscnt(t1) if old_sysbarpar(i,2) < j k = i j = old_sysbarpar(i,2) end repeat if j = 1000000 putc No more situations can be found to improve the layout for putc this section. We must use the present configuration. goto NEXT_JUST 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 t2 = new_syscnt(t1) t4 = mcnts(t2) + 1 dputc Statistics for section ~t1 dputc 1) Last System in section is system ~t2 dputc 2) Current number of bars on this system is ~sysbarpar(t2,1) dputc 3) The bar that is supposed to end this system is bar ~sysbarpar(t2,5) dputc 4) Locations of barlines on this system: loop for t3 = 1 to sysbarpar(t2,1) dputc .w4 Bar ~t3 at ~mspace2(t4) units ++t4 repeat t3 = sysbarpar(t2,5) + mcnts(t2) t3 = rmarg - mspace2(t3) sysbarpar(t2,4) = t3 dputc 5) Potential extra space on line = ~t3 dputc 6) Actual extra space on line = ~sysbarpar(t2,2) getc Step 1: if sysbarpar(t2,2) < 0, then automatically move measure to next system if sysbarpar(t2,2) < 0 putc The current configuration has too many bars on the last line of putc of this section. We must move the final bar forward to the next section. k = t2 putc System ~k is the one affected. We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end putc Currently there are ~sysbarpar(t2,1) bars on the last system in putc section ~t1 , and ~sysbarpar(t2,2) units of extra space on the line. old_extra = sysbarpar(t2,2) Step 2: if number of bars is currect and distribution is average, then this section is finished if sysbarpar(t2,1) <= sysbarpar(t2,5) if sysbarpar(t2,2) < average_extra putc It turns out that this is less than the average for all of the putc systems in this section. In this case, we should not try to putc reconfigure the systems, but should go with the present configuration. goto NEXT_JUST justflag = 1 goto REALWORK end end Step 3: if number of bars is currect and this section has only one system, them this section is finished if sysbarpar(t2,1) <= sysbarpar(t2,5) if t1 = 1 j = new_syscnt(t1) else j = new_syscnt(t1) - new_syscnt(t1-1) end if j = 1 putc This section consists of only a single line. We will justify. putc goto NEXT_JUST justflag = 1 goto REALWORK end end Step 4: Look at option of throwing a measure from the previous system onto last system of this section. j = 0 loop for t4 = 1 to t2 - 1 j += sysbarpar(t4,1) repeat if j > 0 putc Throwing a measure from the previous system onto the last line putc would add ~mspace(j) units to the line. end Step 4a: Do if only if the average can be improved if (average_extra > sysbarpar(t2,2)) or (j = 0) putc Currently, the computed average_extra space = ~average_extra , and this putc is greater than the number of extra units ~sysbarpar(t2,2) on the putc last system, so moving forward a measure will not improve the situation. else Step 4b: Do if only if added space fits if mspace(j) > t3 putc As it turns out, the amount of space ~mspace(j) added to the putc to the last system exceeds the available space ~t3 so putc no forward movement is possible at this time. else Step 4c: Look backward through systems for the one with the least extra space (since we are going to be increasing this space) h = mspace(j) j = 1000000 k = 0 g = start_look if new_start_look > g g = new_start_look end loop for i = start_look to t2 - 1 loop for i = g to t2 - 1 if sysbarpar(i,4) < j a4 = abs(sysbarpar(i,2) - sysbarpar(t2,2)) a5 = abs(sysbarpar(i,4) - sysbarpar(t2,2) + h) if a4 > a5 k = i j = sysbarpar(i,4) end end repeat Step 4d: Only if j <> 1000000 has a prospect been found if j <> 1000000 putc System ~k is the best system from which to advance a measure. putc We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end end end Step 5: If there are extra measures on the last system, then move one of these into the next section. if sysbarpar(t2,1) > sysbarpar(t2,5) t6 = sysbarpar(t2,1) - sysbarpar(t2,5) putc Section ~t1 has ~t6 extra bars in the last line. We need to throw one putc these to the next section. k = t2 putc System ~k is the one affected. We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 goto REALWORK end Step 6: Follow normal procedure putc Normal procedure being followed putc Currently there are ~sysbarpar(t2,1) bars on the last system in putc section ~t1 , and ~t3 units of extra space on the line. old_extra = sysbarpar(t2,2) if sysbarpar(t2,2) < average_extra putc It turns out that this is less than the average for all of the putc systems in this section. In this case, we should not try to putc reconfigure the systems, but should go with the present configuration. goto NEXT_JUST justflag = 1 goto REALWORK end if t1 = 1 j = new_syscnt(t1) else j = new_syscnt(t1) - new_syscnt(t1-1) end if j = 1 putc This section consists of only a single line. We will justify. putc goto NEXT_JUST justflag = 1 goto REALWORK end j = 0 loop for t4 = 1 to t2 - 1 j += sysbarpar(t4,1) repeat putc Throwing a measure from the previous system onto the last line putc would add ~mspace(j) units to the line. if mspace(j) > sysbarpar(syscnt,2) putc Since this is more than we can use, we must go with the present putc configuration for this section. We will justify the current last line. putc goto NEXT_JUST justflag = 1 goto REALWORK else h = mspace(j) j = 1000000 k = 0 g = start_look if new_start_look > g g = new_start_look end loop for i = start_look to t2 - 1 loop for i = g to t2 - 1 if sysbarpar(i,4) < j a4 = abs(sysbarpar(i,2) - sysbarpar(t2,2)) a5 = abs(sysbarpar(i,4) - sysbarpar(t2,2) + h) if a4 > a5 k = i j = sysbarpar(i,4) end end repeat if j = 1000000 putc No more situations can be found to improve the layout. We must use the putc present configuration for this section. We will justify the current putc last line. goto NEXT_JUST 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 goto REALWORK end NEXT_JUST: if new_maxsystems(t1+1) = 0 new_maxsystems(t1+1) = new_syscnt(t1+1) end repeat justflag = 1 goto REALWORK End of 05/28/05 code for mid-movement justification OLD_JUST: j = 0 loop for i = 1 to syscnt j += sysbarpar(i,2) repeat average_extra = j / syscnt if justflag = 3 and syscnt > maxsystems putc We have inadvertantly overstepped our target size. ++sysbarpar(lastk,3) start_look = lastk + 1 if old_extra < 2 * average_extra or lastk >= syscnt - 1 putc We must go back to a previous solution. 11/20/06 Restore sysbarpar parameters from a solution that worked loop for i = 1 to maxsystems sysbarpar(i,1) = sav_sysbarpar(i,1) sysbarpar(i,2) = sav_sysbarpar(i,2) sysbarpar(i,3) = sav_sysbarpar(i,3) sysbarpar(i,4) = sav_sysbarpar(i,4) sysbarpar(i,5) = sav_sysbarpar(i,5) repeat End of 11/20/06 Addition justflag = 1 goto REALWORK end j = 1000000 k = 0 loop for i = start_look to maxsystems if old_sysbarpar(i,2) < j k = i j = old_sysbarpar(i,2) end repeat if j = 1000000 putc No more situations can be found to improve the layout. We must putc use the present configuration. We will justify the current last line. justflag = 1 goto REALWORK end putc We will try advancing a measure from system ~k justflag = 3 lastk = k sysbarpar(k,3) = old_sysbarpar(k,1) - 1 goto REALWORK end mspace(mcnt) += deadspace * 100000 j = 1 loop for i = 1 to mcnt if mspace(i) > 100000 k = mspace(i) / 100000 mspace(i) = rem loop for h = j to i mspace(h) -= k repeat loop for h = i to j + 1 step -1 mspace(h) -= mspace(h-1) repeat j = i + 1 end repeat #if REPORT2 loop for i = 1 to mcnt putc .w6 ~mspace(i) ... j = i / 10 if rem = 0 putc end repeat putc #endif if justflag = 2 maxsystems = syscnt end putc Currently there are ~sysbarpar(syscnt,1) bars on the last putc system and ~sysbarpar(syscnt,2) units of extra space on the line. old_extra = sysbarpar(syscnt,2) if sysbarpar(syscnt,2) < average_extra putc It turns out that this is less than 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 11/20/06 Saving sysbarpar parameters from a solution that worked loop for i = 1 to maxsystems sav_sysbarpar(i,1) = sysbarpar(i,1) sav_sysbarpar(i,2) = sysbarpar(i,2) sav_sysbarpar(i,3) = sysbarpar(i,3) sav_sysbarpar(i,4) = sysbarpar(i,4) sav_sysbarpar(i,5) = sysbarpar(i,5) repeat End of 11/20/06 Addition j = mcnt - sysbarpar(syscnt,1) if j = 0 putc Single line. We will justify. justflag = 1 goto REALWORK end putc Throwing a measure from the previous system onto the last line putc would add ~mspace(j) units to the line. if mspace(j) > sysbarpar(syscnt,2) putc Since this is more than we can use, we must go with the present putc configuration. We will justify the current last line. justflag = 1 goto REALWORK else h = mspace(j) j = 1000000 k = 0 loop for i = start_look to syscnt - 1 if sysbarpar(i,4) < j a4 = abs(sysbarpar(i,2) - sysbarpar(syscnt,2)) a5 = abs(sysbarpar(i,4) - sysbarpar(syscnt,2) + h) if a4 > a5 k = i j = sysbarpar(i,4) end end repeat if j = 1000000 putc No more situations can be found to improve the layout. We must putc use the present configuration. We will justify the current last line. justflag = 1 goto REALWORK end putc System ~k is the best system from which to advance a measure. putc We will recalculate with this change. justflag = 3 lastk = k sysbarpar(k,3) = sysbarpar(k,1) - 1 end goto REALWORK end putc Total pages = ~page in ~outlib #if XVERSION 12/17/03 The program has now completed its task. If formatflag > 0, we need to store the F-table in the (new or updated) format file. 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 This code added 11/25/03 to store changes in the Save Macro file 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 #endif stop End of processing music data @F31 @ V. Procedures. @ @ ╔═════════════════════════════════════════════════╗ ║ ║ ║ P R O C E D U R E S ║ ║ ║ ╚═════════════════════════════════════════════════╝ *P 1. setbeam Purpose: Determine the first stem length and slope of the beam. Inputs: bcount = number of notes under beam beamdata(.,1) = x-position of note beamdata(.,2) = y-position of note beamcode(.) = beam code f12 = staff number beam code = 6 digit number (string) 0 = no beam 1 = continue beam 2 = begin beam 3 = end beam 4 = forward hook 5 = backward hook 6 = repeater 7 = begin repeated beam 8 = end repeated beam 100000's digit = eighth level beams 10000's digit = 16th level beams 1000's digit = 32nd level beams 100's digit = 64th level beams 10's digit = 128th level beams 1's digit = 256th level beams @k = stem direction for first note under beam, plus possible modification to first stem length. (New 05/14/03) If @k < 100, no modifications present If 100 < @k < 10000, @k = @k / 100. Lengthen stem length (up or down) by @k/10 interline distance (vpar(2)) If @k > 10000, @k = @k / 10000. Shorten stem length (up or down) by @k/10 interline distance (vpar(2)) @m = stem direction flags for notes under beam (or 0 or 1 = all same as @k) beamfont = font for printing beam stemchar = character number for stem beamh = height parameter for beams beamt = vertical space between beams (normally vpar(.,32)) Outputs: @k = length of first stem (positive = stem up) @m = slope of beam Internal variables: @b = y-intercept of beam @f = temporary variable @g = temporary variable (related to @@g) @h = temporary variable @i = temporary variable @j = temporary counter @k = |@m| @n = temporary variable @q = temporary counter @s = temporary variable @t = temporary variable @u = temporary variable @@b = vertical range of note set @@g = top of staff line @@n = temporary variable @@q = temporary variable (x1,y1) = temporary coordinates (x2,y2) = temporary coordinates xbeam(6) = temporary flags concerning whether a secondary beam is above or below the "backbone" bstem(.,2) = stem flags for notes under a beam 1 = stem direction 2 = mimumum stem length to top of "backbone" beam max_pslope = maximum positive slope, based on length New 04/23/03 max_nslope = maximum negative slope, based on length 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 04/23/03 max_pslope = vpar(f12,3) * hxpar(1) / t1 + 1 max_nslope = 0 - max_pslope stem = @k & 0x01 /* New code 05/14/03 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 Deal with situation where stems go up and down ────────────────────────────────────────────── if @m > 1 Get stem directions 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 Determine number of "backbone" beams @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 Determine "thickness" of backbone @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 Determine minimum length of stem (to top of backbone) 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 compute minimum "free" length if @b < 4 bstem(@j,2) = vpar(f12,10 - @b) / 2 else bstem(@j,2) = vpar(f12,3) end add length running thought extra beams 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: Determine number of staves involved @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 Case 1: notes span two staves (grand staff) @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 Program Halted putc stop end putc Abnormal case 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. Find "level" for backbone @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 @s = "highest" note below the beam (stem up) @u = "lowest" note above the beam (stem down) @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 Program Halted 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 Program Halted 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 Program Halted 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 05/14/03 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 I am going to try a different technique for setting mixed beams. They don't happen very often, so I am going to try "brute force", which will take longer, but should yield more accurate results. Basically, I will test every slope from -8 to +8 and all legal levels. 1. Determine "highest" pivot point @@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 2. For each "vertical" position, try all slopes; find the "best" one ffm = LIM1 /* 04/23/03 moved this line north of lable NEXT_VERT_POS: fm = LIM1 minsum = LIM1 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 04/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 3. Now evaluate the control function for the lengths in this "vertical" position if minsum < xminsum xminsum = minsum @h = @@g ffm = fm end ++@@g goto NEXT_VERT_POS 4. Check to see of vertical position has been found 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 END OF New METHOD @k = leng if stem_mod <> 0 /* New code 05/14/03 if @k > 0 @k += stem_mod else @k -= stem_mod end end @m = fm #if REPORT putc ~@k ~@m #endif return else Case 2: notes are on one stave if beamdata(1,2) > 700 loop for @j = 1 to bcount beamdata(@j,2) -= 1000 repeat end Check to see if "up-down" distribution of notes allows beam to be drawn putc Beam with mixed stem directions on a single staff. I am going to try including the situations: 1-up/many-down and many-up/1-down in the case. 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 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 if @s < max_pslope and @j + @h < 14 /* NOT changed 04/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 if @s > max_pslope /* NOT changed 04/23/03 @s = max_pslope 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 05/14/03 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. Find "level" for backbone @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 @s = "highest" note below the beam (stem up) @u = "lowest" note above the beam (stem down) @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 Program Halted 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 Program Halted 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 Program Halted 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 05/14/03 if @k > 0 @k += stem_mod else @k -= stem_mod end end @m = 0 #if REPORT putc ~@k ~@m #endif return end end End of situation where stems go up and down Check for situation where notes span two staves (grand staff) 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 If @j = 10000 and stem = 0 (up), then beam will be relative to top staff if stem = 1 (down), then beam will be relative to bottom staff Otherwise, beam will be relative to staff that notes are on 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 Reverse if stem down @g = 0 if stem = 1 @g = vpar(f12,2) * 500 - vpar(f12,8) loop for @j = 1 to bcount beamdata(@j,2) = vpar(f12,2) * 500 - beamdata(@j,2) repeat end @@g = @g * determine slope and pivot of beam @q = 0 x1 = 50000 y1 = 50000 @t = 6 @b = 0 @h = 0 /* changes in absolute height @f = 0 @i = beamdata(1,2) identify: @q = 6 - smallest note type under beam (x1,y1) = position of note closest to beam (x2,y2) = position of note next closest to beam @b = y coordinate of note furthest from beam 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 Check point one: (x1,y1); (x2,y2); @b set @@b = @b - y1 Formula for initial stem length note @q y1-@n ─────── ────── ─────── 8th: 0 beamh 16th: 1 beamh + (1 * notesize / 4) 32th: 2 beamh + (4 * notesize / 4) 64th: 3 beamh + (7 * notesize / 4) 128th: 4 beamh + (10 * notesize / 4) 256th: 5 beamh + (13 * notesize / 4) 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 Comment: @m is (2*hxpar(1)) times slope between two notes nearest the beam @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 Comment: @k is (2*hxpar(1)) times slope between outside notes Formula: slope = (@m + @k) / 6 provided |@m| must be equal to or less than |@k| @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 04/23/03 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 set reduce slant if end note are closer than vpar(f12,6) @h = beamdata(bcount,1) - beamdata(1,1) if @h <= vpar(f12,6) and @k > vpar(f12,35) @k = vpar(f12,35) end shorten shortest stem, if gradual slope and large vertical range and relatively high note @h = bcount + 1 if @h > 5 @h = 5 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 @m = hxpar(1) * slope of beam @n = y coordinate of pivot point (on highest note) of first beam @k = absolute value of @m @g = y coordinate of top of staff line (x1,y1) = coordinate of note closest to beam (highest note) (x2,y2) = coordinate of second closest note to beam (2nd highest note) @q = 6 - smallest note type number (number of beams - 1) @t = 6 - largest note type number @@n = @n ++@q @@q = @q Check point two: @q = number of beams, current slope = @m Adjust @m and @n so that beams will fall properly on staff lines Case I: @m = 0 CSI: if @m = 0 @f = @q - 1 * notesize + @n if @f >= @g Adjust flat beam height @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 Case II: @m <> 0 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 @j = starting point of top beam @i = stopping point of top beam @f = average height of beam (second beam if always 2 or more) @s = fudge factor @g = @@g @h = @g @g -= notesize if @q > 2 @g -= notesize end if @f > @g Adjust slanted beam height 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 @h = rise/fall of beam @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 Deal with special case of two note beam compute sum of stem lengths and increase if too short if bcount = 2 @f = @q - 1 * beamt + y1 - @n + y2 - @n - @h if @f < vpar(f12,27) @n -= vpar(f12,28) end end Adjust so that middle of beam falls on/between staff lines @n = 100 - beamfont / 2 + @n end * CSIII: dv3 = @m * @b dv3 = @n * hxpar(1) - dv3 Check point three: beam slope = @m; y intercept (times hxpar(1)) = dv3 Post adjustment: sometimes the stems of sixteenths are too short. This will be the case when (y2-@n) - ((@q-1)*beamt) < xxx where xxx is some number. In this case, we should raise the beam by some small amount, yyy. --@q @j = 0 - @q * beamt + y2 - @n if @j < vpar(f12,29) dv3 -= vpar(f12,30) * hxpar(1) end In the case where bcount = 4, compare sum of the first two notes verses the last two notes. If the direction is different from the slope, then the slope should be zero. 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: @m = hxpar(1) * slope of beam dv3 = y-intercept of top of beam (times hxpar(1)) y1 = @m * beamdata(1,1) + dv3 / hxpar(1) y2 = beamdata(1,2) @k = abs(y2 - y1) Now check for beam with excessive "vertical" travel 04/23/03 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 End of code added 04/23/03 if stem = 1 @m = 0 - @m /* reverse slope if stem down @k = 0 - @k end if stem_mod <> 0 /* New code 05/14/03 if @k > 0 @k += stem_mod else @k -= stem_mod end end return *P 2. newpage Purpose: Increment page number; construct outfile string Input: page = old page number procedure newpage page = page + 1 if page < 10 outfile = outlib // "/0" // chs(page) else outfile = outlib // "/" // chs(page) end return *P 12a. clefkeyspace Purpose: Compute space for new clef and key Operation: Create entry for global double bar, if f5 is set. Inputs: Staff locations: (sp,sq(.)) Clef code: clef(.,.) Key code: key(.) Time code: tcode(.) f5: double bar flag Outputs: ldist,gbarflag,gbar(if f5 is set),tcode,savtcode tplace Internal variables: a1,a2,a3,a4,a5 procedure clefkeyspace gbarflag = 0 ldist = sp + hxpar(10) 1) clef ldist = ldist + hxpar(15) 2) key signature a9 = ldist a5 = ldist loop for f12 = 1 to f11 notesize = f(f12,14) x = ldist sharps if key(f12) > 0 x = hpar(f12,6) * key(f12) + x end 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 3) time change 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 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) /* 05-27-94 I'm not sure why this is necessary, but it is. end end tcode(f12) = 10000 repeat if ldist < a5 ldist = a5 end 4) store info for double bar if left over from last line 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 *P 12b. clefkey Purpose: Create object entries for clef, key and time signature Operation: Also typeset measure number. Also typeset a mark object object for an ending superobject, if the ending starts at the beginning of the line. The flag for this is the variable supernum. If this is positive, then this is the superobject number of the ending superobject. New 05/06/08 Inputs: Staff locations: (sp,sq(.)) Clef code: clef(.,.) Key code: key(.) Time code: savtcode(.) Internal variables: a1,a2,a3,a4,a5 Clef is defined as a two dimensional array, and if f(f12,12) = 2 then the clef, key, and maybe the time signature need to be duplicated on the auxiliary staff. procedure clefkey str line2.80 int t1,t2,t3 int tenor int clef_obx /* New 10/08/08 obx = hxpar(10) 1) clef if lbyte = "l" /* New condition 12/18/05 goto NO_CLEF end t1 = 0 loop for t2 = 1 to 2 /* max 2 staves at this time a1 = clef(f12,t2) / 10 a2 = rem a3 = a1 / 3 a4 = rem if a4 = 0 z = 33 else z = 34 + a4 end oby = a2 - 1 * notesize + t1 clef_obx = obx /* New 10/08/08 if a4 = 0 a5 = 2 if a3 = 1 a5 = 3 end if justflag < 2 ++mainyp tput [Y,mainyp] J C ~clef(f12,t2) ~obx ~oby ~a5 6913 0 0 ++mainyp tput [Y,mainyp] K 0 0 33 ++mainyp tput [Y,mainyp] K 0 0 34 if a3 = 1 ++mainyp tput [Y,mainyp] K ~hpar(f12,5) ~vpar(f12,15) 234 end end else if justflag < 2 ++mainyp tput [Y,mainyp] J C ~clef(f12,t2) ~obx ~oby ~z 6913 0 0 end end if f(f12,12) <> 2 t2 = 100 else #if SCORE_PARS t1 = 1000 /* was vst(f12) #else t1 = vst(f12) #endif end repeat NO_CLEF: obx = obx + hpar(f12,15) 2) key signature a9 = obx a3 = abs(key(f12)) t1 = 0 loop for t2 = 1 to 2 /* max 2 staves at this time tenor = 0 if clef(f12,t2) = 12 tenor = 1 end if justflag < 2 ++mainyp tput [Y,mainyp] J K ~key(f12) ~obx ~t1 ~a3 6913 0 0 end if a3 > 0 a1 = clef(f12,t2) / 10 t3 = rem - 1 * 2 /* t3 (vertical position) measured in line numbers a1 /= 3 a2 = 2 - rem * 3 t3 -= a2 x = 0 sharps if key(f12) > 0 loop for j = 1 to a3 if tenor = 0 or t3 >= 0 y = t3 + 20 * notesize / 2 - vpar20(f12) else y = t3 + 27 * notesize / 2 - vpar20(f12) /* exception for tenor clef end if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y 63 end t3 += zak(1,j) x += hpar(f12,6) repeat end flats if key(f12) < 0 t3 += 4 loop for j = 1 to a3 y = t3 + 20 * notesize / 2 - vpar20(f12) if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y 65 end t3 += zak(2,j) x += hpar(f12,7) repeat end end if f(f12,12) <> 2 t2 = 100 else #if SCORE_PARS t1 = 1000 /* was vst(f12) #else t1 = vst(f12) #endif end repeat 3) write time change obx = tplace a5 = obx deal with time directive or segno thrown to new line if dxoff(f12) < 10000 rec = drec(f12) * perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line if jtype <> "D" putc Error: Unexplained object thrown to next line examine stop end if z < 33 if f12 = 1 if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~obx 0 1 6913 0 0 end ++rec tget [Z,rec] line lpt = 3 tline = txt(line,[' '],lpt) x = int(tline) + dxoff(f12) tline = txt(line,[' '],lpt) y = int(tline) + dyoff(f12) line = line{lpt+1..} if justflag < 2 ++mainyp #if SCROLL_OUT tput [Y,mainyp] w ~x ~y ~line #else tput [Y,mainyp] W ~x ~y ~line #endif end end else if justflag < 2 if bit(2,ntype) = 1 and f12 = 1 x = a9 + dxoff(f12) y = dyoff(f12) ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~z 6913 0 0 end if bit(3,ntype) = 1 and f12 = f11 x = a9 + dxoff(f12) y = dyoff(f12) ++mainyp tput [Y,mainyp] J D 0 ~x ~y ~z 6913 0 0 end end end dxoff(f12) = 10000 end write time change, if present if savtcode(f12) < 10000 a1 = savtcode(f12) / 100 a2 = rem a3 = 0 if a1 = 1 and a2 = 1 a3 = 1 end if a1 = 0 and a2 = 0 a3 = 2 end * if a3 > 0 obx = obx + hpar(f12,13) y = vpar(f12,6) z = 36 + a3 if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx ~y ~z 6913 0 0 end if f(f12,12) = 2 #if SCORE_PARS y += 1000 /* was vst(f12) #else y += vst(f12) #endif if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx ~y ~z 6913 0 0 end end else obx = a5 + hpar(f12,21) a3 = 4 if a2 < 10 a3 = 3 if a1 < 10 obx = a5 + hpar(f12,22) end end if a1 < 10 --a3 end if justflag < 2 ++mainyp tput [Y,mainyp] J T ~savtcode(f12) ~obx 0 ~a3 6913 0 0 end y = vpar(f12,4) a = a1 perform number y = vpar(f12,8) a = a2 perform number if f(f12,12) = 2 if justflag < 2 ++mainyp #if SCORE_PARS tput [Y,mainyp] J T ~savtcode(f12) ~obx 1000 ~a3 6913 0 0 #else tput [Y,mainyp] J T ~savtcode(f12) ~obx ~vst(f12) ~a3 6913 0 0 #endif end y = vpar(f12,4) a = a1 perform number y = vpar(f12,8) a = a2 perform number end end obx = obx + hpar(f12,19) end 4) write measure number if f12 = 1 or f12 > 0 /* f12 > 0 added 01/06/04 (dummy boolean TRUE) t2 = M_NUM_FONT /* font number moved to #define 01/06/04 perform spacepar (t2) if f12 > 1 /* this also added 01/06/04; 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 x = clef_obx - t1 /* New 10/08/08 y = 0 - vpar(f12,2) if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~x ~y 1 6913 0 0 ++mainyp tput [Y,mainyp] W 0 0 ~t2 ~line2 end end 5) put down mark for ending superobject, if supernum > 0 New 05/06/08 a5 = hxpar(8) - sp - vpar(f12,3) if supernum > 0 if justflag < 2 ++mainyp tput [Y,mainyp] J D 0 ~a5 0 0 6913 0 1 ~supernum end end supernum = 0 return *P 13. getsmall Purpose: Identify and count the smallest duration in line Inputs: a1 = number of nodes in larr to look at a9 = purpose flag (0 = condensation, 1 = expansion) Outputs: k = code for smallest note/rest on line (not including syncopated nodes) e = smallest internote distance (not including syncopated distances) delta_e = difference between e and next smallest distance New 10/14/07 df = proper duration flag for shortest note scnt = number of nodes preceded by distance e small(.) = node numbers of duration df, where distance adjustment can take place scnt2 = number of nodes for which adj_space = YES New 05/25/03 small2(.) = node numbers of duration df, where " " distance adjustment can take place " " and adj_space = YES " " Internal variables: a2,a3,a4,a5,a6,a7,a8,a10 procedure getsmall int df2,first k = 11 e = 1000 df2 = 100000 scnt = 0 scnt2 = 0 /* New 05/25/03 delta_e = 0 /* New 10/14/07 loop for a8 = 2 to a1 a4 = larr(a8,TIME_NUM) /* New 05/25/03 if a4 > 0 if larr(a8,MNODE_TYPE) <> 18 or e = 1000 /* New 05/25/03 a5 = larr(a8-1,MNODE_TYPE) /* " " if a5 > 0 Case: node is preceded by variable distance (a4 > 0); node is not a bar line (larr(a8,MNODE_TYPE) <> 18); previous node type is a5; we New 05/25/03 are not including syncopated nodes in our preliminary search for the smallest node type on the line. if a5 <= k if a5 < k a6 = 0 end k = a5 df2 = 64, a6 = 0 --> previous duration is quarter note, etc. df2 = 64, a6 = 1 --> previous duration is a quarter note triplet, etc. 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 if bit(a5-1,df2) = 1 /* i.e. not including syncopations a2 = larr(a8,PRE_DIST) /* New 05/25/03 if a2 < e e = a2 end end We need to change the code here (01/24/04) to deal with the situation that occurs in Baroque music, where (for example) the quarter/eighth combination in triplet is represented by a dotted eighth and sixteenth. The problem is that in this situation, the MNODE_TYPE type "under-represents" what is really there. In this example, the dotted eighth (MNODE_TYPE = 6) is really a triplet quarter (MNODE_TYPE = 7); and the sixteenth (MNODE_TYPE = 5) is really a triplet eighth (MNODE_TYPE = 6). Because of this, the code above thinks these intervals are syncopations. The trick here will be to write some code that will capture this situation, without letting through the syncopated case. By increasing the value of MNODE_TYPE by one, we are increasing the value of a5 by one, which means we are looking at the next larger bit of df2. The value of df2 is valid; we don't propose to change that. We need to consider the effect of looking at the next larger bit. Let us suppose that df2 has the following value: xxy0xx..., where the 0 corresponds to the bit read above. If the value of y is 0, then either this node is very short relative to the note-type represented and is definitely syncopated, or the node is at least four times longer than the note-type represented, which is a logical error. If the value of y is 1, the node is at least twice as long as the note-type represented, which is also a logical error. Based on this analysis, I think the fix is actually very simple. The basic rule is that the node type should NEVER exceed the value of the note-type represented. If the note-type represented is too small, as happens in the triplet case, the above code fails for the wrong reason. What we really should be asking is: if df2 >= (0x01 << (a5-1)) /* i.e. not including syncopations The "=" part of this statement encompasses the normal situation; i.e., the node type is identical to the note-type represented. The "less than" condition is where this statement fails, and this is the syncopated case. The "greater than" condition is logically impossible, but now accepts the case where the size of the note-type was under-represented, as happens in the triplet case. if df2 >= (0x01 << (a5-1)) /* i.e. not including syncopations a2 = larr(a8,PRE_DIST) /* New 05/25/03 if a2 < e delta_e = e - a2 /* New 10/14/07 e = a2 end if e + delta_e > a2 delta_e = a2 - e /* New 10/14/07 end end 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 k = code for smallest note/rest on line e = smallest internote distance df = proper duration flag for shortest note in search set Determine quantity and location of smallest distances 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 05/25/03 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 Case: node is preceded by variable distance (larr(a8,TIME_NUM) > 0); (05/25/03) node is not a bar line (larr(a8,MNODE_TYPE) <> 18); node aligns with a multiple of the minimum duration; a4 = cumulative number of minimum durations to this node; a5 = previous cumulative number of minimum durations. a2 = a4 - a5 if a2 = 1 a7 += larr(a8,PRE_DIST) /* New 05/25/03 Condensation: a7 (effective distance) must be within hxpar(14) of e if a9 = 0 if a7 < a6 ++scnt small(scnt) = a8 if larr(a8,M_ADJ) = YES /* New Code 05/25/03 ++scnt2 small2(scnt2) = a8 end end else ++scnt small(scnt) = a8 if larr(a8,M_ADJ) = YES /* New Code 05/25/03 ++scnt2 small2(scnt2) = a8 end end end a5 = a4 a7 = 0 else a7 = larr(a8,PRE_DIST) /* New 05/25/03 end end GSM1: repeat if scnt <= 4 and first = 0 first = 1 scnt = 0 scnt2 = 0 /* New 05/25/03 goto GSM2 end return *P 25. endcheck Purpose: Check status of end of part flags. Inputs: f(.,8) 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 ends of each of the i-files. putc Compare the last measure number in each file. If one putc of the i-files ends early, this could be caused by a putc slur that was started but not terminated. putc putc Another possibility is that an error was made when track putc numbers were added to multiple rests. Use qed to check putc the sequential order of measure numbers. putc putc Look also for the misspelling of measure, mdouble, mheavy, etc. putc in one of the files. putc examine stop end repeat #if REPORT if endflag = 1 putc ENDFLAG = 1 end #endif return *P 27. setckt Purpose: Generate entries in marr for possible clef, key, time and clef signatures in that order (snode = 6913) Input: marc = index into marr array f(.,6) = record pointer in part (.) f(.,10) = active measure flag for part (.) olddist(.) = value of x-coordinate for previous object Outputs: Entries in marc for clef, key and time signature when any of these are present Updated marc and f(.,6) pointers Updated olddist(.) Updated ldist rmarg changed (this will be changed back to hxpar(4) at CF: if signatures are not at end of line) Internal variables: tarr(.) procedure setckt int g,h,i,j,k,q int firstclef check for presence of clef, key, time and clef (again) loop for f12 = 1 to f11 loop for g = 1 to 4 tarr4(f12,g) = 0 repeat repeat loop for g = 1 to 4 tarr(g) = 0 repeat i = 0 j = 0 loop for f12 = 1 to f11 firstclef = 0 notesize = f(f12,14) if f(f12,10) = 0 rec = f(f12,6) CKT1: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" if snode <> 6913 h = dvar1 - olddist(f12) if h > i i = h /* constructing maximum distance end goto CKT2 end if "CKT" con jtype if mpt > 1 firstclef = 1 /* K or T encountered else if firstclef = 1 mpt = 4 /* Clef after K or T end end ++tarr4(f12,mpt) /* here is where we count end end goto CKT1 end CKT2: loop for g = 1 to 4 if tarr4(f12,g) > tarr(g) tarr(g) = tarr4(f12,g) /* we want maximum of count for each sign end repeat repeat i = maximum distance from bar line to first object beyond signatures loop for g = 1 to 4 if tarr(g) > 0 j = 1 ++marc marr(marc,PRE_DIST) = 0 if g < 4 marr(marc,MNODE_TYPE) = 13 + g else marr(marc,MNODE_TYPE) = 14 /* Clef following Key or Time end marr(marc,TIME_NUM) = 0 marr(marc,SNODE) = 6913 marr(marc,ACT_FLAG) = 0 marr(marc,M_ADJ) = adj_space marr(marc,MARR_TEMP) = 0 k = 0 q = 1 /* for constructing marr(marc,ACT_FLAG) loop for f12 = 1 to f11 if tarr4(f12,g) > 0 --tarr4(f12,g) notesize = f(f12,14) if f(f12,10) = 0 rec = f(f12,6) CKT3: perform save3 /* oby not used here #if OVERRUN if rec > 400000 dputc Stopping Here stop end #endif &X dputc rec = ~rec &X putc line = ~line ++rec if line{1} = "J" and jtype = "CKTC"{g} marr(marc,ACT_FLAG) |= q h = dvar1 - olddist(f12) if h > marr(marc,PRE_DIST) marr(marc,PRE_DIST) = h end ++k tdist(k,1) = f12 tdist(k,2) = dvar1 f(f12,6) = rec goto CKT4 end if rec < f(f12,2) goto CKT3 end end end CKT4: q <<= 1 repeat perform adjolddist ldist += marr(marc,PRE_DIST) i -= marr(marc,PRE_DIST) * perform showmarr * getc end --tarr(g) if tarr(g) > 0 /* if more than one of a sign, --g /* go though loop again end repeat If j = 1, i = maximum distance from last signature to the first object beyond signatures. #if SCROLL_OUT #else if j = 1 false_rmarg = hxpar(4) - i end #endif return *P 28. adjolddist Purpose: Adjust olddist(.) for parts where f(f12,10) = 0 procedure adjolddist k = 1 loop for f12 = 1 to f11 if f(f12,10) = 0 if tdist(k,1) = f12 olddist(f12) = tdist(k,2) ++k else olddist(f12) += marr(marc,PRE_DIST) end end repeat return spaging code #if SCORE_PARS *P 29(a). wholerest (t1) Purpose: Typeset whole measure rest Inputs: f12 = part number a = x-coord of left bar (from beginning of staff) b = x-coord of right bar " " " " t1 = staff flag: 0 = normal 1 = don't print rests 2 = also print rest on auxiliary stave mrest_data(f12) = "| P7=x.yyyy" (P7 parameter data) Internal variables: x y z procedure wholerest (t1) str temp.80 int t1 getvalue t1 if justflag < 2 if t1 < 2 temp = "| FLOAT P2=1.1 P4=0 P5=-2 P6=" if t1 = 1 temp = temp // "-1 " else temp = temp // "0 " end mrest_data(f12) = trm(mrest_data(f12)) temp = temp // mrest_data(f12){3..} // " P8=0" x = a + b / 2 - notesize y = vpar(f12,4) putf [3] J R 9 ~x ~y 46 1 0 0 ~temp ++mainyp if rest7 = 1 /* added 12/24/03 "Q" is an internal flag tput [Y,mainyp] Q R 9 ~x ~y 1 1 0 0 ~temp else tput [Y,mainyp] J R 9 ~x ~y 1 1 0 0 ~temp end ++mainyp tput [Y,mainyp] K 0 0 46 else putc Possible (non-fatal) program error. Compound (multiple) rests putc are not supposed to be possible on the grand staff in this putc implementation of MUSDATA. putc No action taken, but you'd better check the results! putc putf [3] J R 9 ~x ~y 2 1 0 0 putf [3] K 0 0 46 putf [3] K 0 ~vst(f12) 46 end end return xmskpage code #else *P 29(b). wholerest (t1) Purpose: Typeset whole measure rest Inputs: f12 = part number a = x-coord of left bar (from beginning of staff) b = x-coord of right bar " " " " t1 = staff flag: 0 = normal 1 = don't print rests 2 = also print rest on auxiliary stave rest7 = set "optional line rest" Internal variables: x y z 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 12/24/03 "Q" is an internal flag tput [Y,mainyp] Q R 9 ~x ~y 46 1 0 0 else tput [Y,mainyp] J R 9 ~x ~y 46 1 0 0 end end return end if justflag < 2 ++mainyp if rest7 = 1 /* added 12/24/03 "Q" is an internal flag tput [Y,mainyp] Q R 9 ~x ~y 2 1 0 0 else tput [Y,mainyp] J R 9 ~x ~y 2 1 0 0 end ++mainyp tput [Y,mainyp] K 0 0 46 ++mainyp tput [Y,mainyp] K 0 ~vst(f12) 46 end return End of split #endif *P 30. getcontrol Purpose: Find the object that generates a proper-node for the current object being looked at at rec. Inputs: rec = record number for current object f12 = part to search cjtype = object type from last call to getcontrol csnode = node number from last call to getcontrol Outputs: crec = record number which generates proper-node cjtype = object type cntype = node type cdv = x coordinate coby = y coordinate cz = value of z csnode = snode number line2 = record which is proper node Operation: if csnode < 6913 and if csnode = snode and if cjtype = B and if jtype = N,R,Q,F,I, current object generates node otherwise next N,R,Q,F,I object generates node otherwise current proper node is still valid if csnode < snode and if jtype = N,R,Q,F,I,B, current object generates node otherwise next N,R,Q,F,I,B object generates node if csnode > snode, I think you have a problem if csnode = 6913 if snode = 6913 and if jtype = B,C,K,T, current object generates node otherwise next C,K,T generates node otherwise next N,R,Q,F,I,B object generates node procedure getcontrol str local_last_jtype.1 /* added 11/25/06 local_last_jtype = last_jtype /* added 11/25/06 last_jtype = jtype /* added 11/25/06 if csnode < 6913 if csnode = snode if cjtype = "B" crec = rec GC1: perform save4 if "NRQFI" con cjtype if "NRrQFI" con cjtype /* New 10/15/07 return end ++crec goto GC1 end return else if csnode < snode crec = rec GC2: perform save4 if "NRQFIB" con cjtype if "NRrQFIB" con cjtype /* New 10/15/07 if mpt < 7 return end if csnode = 6913 return end end ++crec goto GC2 else putc Error: csnode > snode in part ~f12 at ~barnum putc This could be caused by durations that don't properly add up. examine stop end end else Code added 11/25/06 to try to fix an End-of-measure Bug #if ADD112506 if csnode = snode and local_last_jtype = "M" and jtype <> "B" crec = rec GC2A: perform save4 if "B" con cjtype return end if csnode < 6913 putc A new bug was introduced on 11/25/06. Please report. putc To restore this program to its earlier, set the #define ADD112506 to 0 putc putc Operation Halted putc stop end ++crec goto GC2A end #endif End of 11/26/06 Addition crec = rec GC3: perform save4 if snode = 6913 if "BCKT" con cjtype return end else if "NRQFIB" con cjtype if "NRrQFIB" con cjtype /* New 10/15/07 return end end ++crec goto GC3 end * return *P 33. number Purpose: Typeset a number Inputs: a = number b = center position for number (not used here 11/05/05) y = vertical location of number procedure number x = 0 - hpar(f12,20) if a > 99 x = 0 + hpar(f12,20) else if a > 9 x = 0 /* Fixing bug 11/05/05 (was x = b) end end NU1: a = a / 10 z = rem + 71 if justflag < 2 ++mainyp tput [Y,mainyp] K ~x ~y ~z end if a = 0 return end x -= hpar(f12,19) goto NU1 * return PEND ************************************************** 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" structure of transp super-object: 4. situation: 0=8av up, 1=8av down 5. horiz. disp. from obj1 6. horiz. disp. from obj2 7. vert. disp. from obj1 8. length of right vertical hook tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(f12,k,2) tline = txt(line,[' '],lpt) a1 = int(tline) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp - notesize if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum y1 -= 1000 else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum V ~a3 0 ~x2 ~y1 ~a1 end end return end if htype = "E" structure of ending super-object: 4. ending number (0 = none) 5. horiz. disp. from obj1 6. horiz. disp. from obj2 7. vert. disp. from staff lines 8. length of left vertical hook 9. length of right vertical hook tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp - vpar(f12,3) if superdata(f12,k,6) = 0 if superdata(f12,k,6) = 0 or superdata(f12,k,5) = 3 /* New 05/06/08 a1 = 0 if superdata(f12,k,5) <> 3 a3 = 0 end end if justflag < 2 * create mark at beginning of line ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum E ~a3 0 ~x2 ~y1 ~a1 ~a2 end end superdata(f12,k,5) = 0 /* New 05/06/08 Clear these to make superdata(f12,k,6) = 0 /* sure they are not used elsewhere. superdata(f12,k,7) = 0 return end if htype = "D" structure of dashes super-object: 4. horiz. disp. from obj1 5. horiz. disp. from obj2 6. vert. disp. from staff lines 7. spacing parameter 8. font designator tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 += superdata(f12,k,1) else x1 = hxpar(8) - sp if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum D 0 ~x2 ~y1 ~a1 ~a2 end end return end if htype = "R" structure of trill super-object: 4. situation: 1 = no trill, only ~~~~ 2 = trill with ~~~~ 3 = tr ~~~~ with sharp above 4 = tr ~~~~ with natural above 5 = tr ~~~~ with flat above 5. horiz. disp. from object 1 6. horiz. disp. from object 2 7. vert. disp. from object 1 tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y1 = int(tline) + superdata(f12,k,2) if superdata(f12,k,5) = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end x1 = int(tline) + superdata(f12,k,1) else a1 = 1 x1 = hxpar(8) - sp - notesize if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum y1 -= 1000 else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum R ~a1 0 ~x2 ~y1 end end return end if htype = "W" structure of wedge super-object: 4. left spread 5. right spread 6. horiz. disp. from obj1 7. beg. vert. disp. from staff 8. horiz. disp. from obj2 9. end. vert. disp. from staff tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) /* + superdata(f12,k,3) tline = txt(line,[' '],lpt) y2 = int(tline) a1 = superdata(f12,k,5) if a1 = 0 if justflag < 2 ++mainyp tput [Y,mainyp] ~superline end else x1 = hxpar(8) - sp c1 = a1 if justflag < 2 * create mark at beginning of line (mindful of virtual staff possibility) if superdata(f12,k,2) > 700 and f(f12,12) = 2 ++mainyp tput [Y,mainyp] J M 0 ~x1 1000 0 6913 0 1 ~supernum else ++mainyp tput [Y,mainyp] J M 0 ~x1 0 0 6913 0 1 ~supernum end * create "second half" of superobject (objects are out of order but will be reversed) ++mainyp tput [Y,mainyp] H ~supernum W ~c1 ~c2 0 ~y1 ~x2 ~y2 end end return end return * procedure save3 cflag = 0 tget [Z,rec] line .t3 jtype ntype dvar1 oby z snode dincf * dinct will be 10000 when there is a centered rest if dincf = 10000 dincf = 0 cflag = 1 end This code added 12/24/03 for optional rests if dincf = 10001 cflag = 1 end if f(f12,12) = 2 and oby >= 1000 oby -= 1000 if jtype <> "B" oby += vst(f12) end end return * procedure save4 S4: tget [Z,crec] line2 .t3 cjtype cntype cdv coby cz csnode if line2{1} <> "J" ++crec goto S4 end if "CKTDBSFIM" con cjtype if mpt < 6 cntype = 13 + mpt else cntype = 17 end end return * procedure save5 int c,x loop a = point b = oldmpoint + barpar(barcount+1,1) c = f(f12,12) perform wholerest (c) #if SCORE_PARS if justflag < 2 and f(f12,11) > 1 x = oldmpoint + barpar(barcount+1,1) c = barnum + 1 ++mainyp tput [Y,mainyp] J B ~c ~x 1 82 6913 1 0 | EXPERIMENTAL BAR AFTER FLOATING REST end #endif ++barnum --f(f12,11) if f(f12,11) > 0 ++barcount point = oldmpoint + barpar(barcount,1) oldmpoint = point oldmp2 = point if barcount = delta f(f12,6) = rec return end #if SCORE_PARS else mrest_data(f12) = "" #endif end repeat while f(f12,11) > 0 return *PX showmarr procedure showmarr putc marr(~marc ,*) .t12 ... loop for j = 1 to MARR_PARS putc .w6 ~marr(marc,j) ... repeat putc return *PX showlarr procedure showlarr putc larr(~a1 ,*) .t12 ... loop for a2 = 1 to MARR_PARS putc .w6 ~larr(a1,a2) ... repeat putc return * ┌──────────────────────────────────────────────────────────────┐ │P xx. spacepar (t5) │ │ │ │ Purpose: Be sure that proper space paramters are loaded │ │ │ │ Inputs: t5 = font number │ │ │ │ Outputs: valid spc(.) array for this font │ │ updated value of curfont │ │ │ │ │ │ Internal Variables: │ │ │ │ int bfont(4,4) Spacepar keeps a record of past calls │ │ together with the number of times │ │ a particular font has been asked for. │ │ If the number of fonts exceeds 4, │ │ spacepar will replace the space data │ │ from the memory block [bspc(.,.)] │ │ least current. │ │ int bspc(4,255) Four memory blocks for space data │ │ int time pseudo timer │ │ │ │ │ └──────────────────────────────────────────────────────────────┘ procedure spacepar (t5) int bfont(4,4),bspc(4,255),time int t1,t2,t3,t4,t5,t6 str file.200,line.280 getvalue t5 if t5 <> curfont t2 = 1000000 loop for t1 = 1 to 4 if t5 = bfont(t1,1) /* font found in reserve ++time bfont(t1,2) = time loop for t3 = 1 to 255 spc(t3) = bspc(t1,t3) repeat curfont = t5 return end if bfont(t1,2) < t2 t2 = bfont(t1,2) t4 = t1 /* t4 is the oldest block end repeat New code 03/19/04 line = DISP_DISK // ":/musprint/new/xfonts/tms/fontspac" open [4,1] line t6 = revsizes(notesize) t1 = t5 - 29 /* 1 <= t1 <= 19 t2 = XFonts(t6,t1) - 50 /* 1 <= t2 <= 90 (text font) t2 = Fspacex(t2) - 1 /* t2 = offset in fontspac 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 *P XXII. procedure newfont_init Initializing arrays for NEWFONTS procedure newfont_init nsizes(1) = 4 nsizes(2) = 5 nsizes(3) = 6 nsizes(4) = 7 nsizes(5) = 8 nsizes(6) = 10 nsizes(7) = 12 nsizes(8) = 14 nsizes(9) = 16 nsizes(10) = 18 nsizes(11) = 21 nsizes(12) = 24 wedgefont(1) = 38 wedgefont(2) = 38 wedgefont(3) = 38 wedgefont(4) = 38 wedgefont(5) = 38 wedgefont(6) = 38 wedgefont(7) = 38 wedgefont(8) = 38 wedgefont(9) = 39 wedgefont(10) = 39 wedgefont(11) = 39 wedgefont(12) = 39 wedgefont(13) = 39 wedgefont(14) = 39 wedgefont(15) = 40 wedgefont(16) = 40 wedgefont(17) = 40 wedgefont(18) = 40 wedgefont(19) = 40 wedgefont(20) = 41 wedgefont(21) = 41 wedgefont(22) = 41 wedgefont(23) = 41 wedgefont(24) = 41 scfont(1) = 44 /* sc08 scfont(2) = 44 scfont(3) = 44 scfont(4) = 44 scfont(5) = 45 /* sc12 scfont(6) = 45 scfont(7) = 45 scfont(8) = 45 scfont(9) = 46 /* sc16 scfont(10) = 46 scfont(11) = 46 scfont(12) = 46 scfont(13) = 47 /* sc24 scfont(14) = 47 scfont(15) = 47 scfont(16) = 47 scfont(17) = 47 scfont(18) = 47 scfont(19) = 47 scfont(20) = 47 scfont(21) = 47 scfont(22) = 47 scfont(23) = 47 scfont(24) = 47 revsizes(1) = 1 revsizes(2) = 1 revsizes(3) = 1 revsizes(4) = 1 revsizes(5) = 2 revsizes(6) = 3 revsizes(7) = 4 revsizes(8) = 5 revsizes(9) = 6 revsizes(10) = 6 revsizes(11) = 7 revsizes(12) = 7 revsizes(13) = 8 revsizes(14) = 8 revsizes(15) = 9 revsizes(16) = 9 revsizes(17) = 10 revsizes(18) = 10 revsizes(19) = 10 revsizes(20) = 11 revsizes(21) = 11 revsizes(22) = 11 revsizes(23) = 12 revsizes(24) = 12 start with notesize, and a number 30 to 48 (19 possibilities) want a font number, that's all XFontstr(1) = " 51 51 81 111 51 81 111 52 82 112 53 83 113 54 84 114 56 86 116" XFontstr(2) = " 51 52 82 112 53 83 113 54 84 114 55 85 115 56 86 116 58 88 118" XFontstr(3) = " 51 54 84 114 55 85 115 56 86 116 57 87 117 58 88 118 60 90 120" XFontstr(4) = " 52 55 85 115 57 87 117 58 88 118 59 89 119 60 90 120 63 93 123" XFontstr(5) = " 53 57 87 117 58 88 118 59 89 119 61 91 121 62 92 122 64 94 124" XFontstr(6) = " 55 59 89 119 61 91 121 63 93 123 64 94 124 65 95 125 68 98 128" XFontstr(7) = " 57 62 92 122 64 94 124 65 95 125 67 97 127 69 99 129 72 102 132" XFontstr(8) = " 58 64 94 124 66 96 126 68 98 128 70 100 130 72 102 132 74 104 134" XFontstr(9) = " 60 67 97 127 69 99 129 71 101 131 73 103 133 74 104 134 76 106 136" XFontstr(10) = " 61 69 99 129 71 101 131 73 103 133 74 104 134 75 105 135 78 108 138" XFontstr(11) = " 64 72 102 132 74 104 134 75 105 135 77 107 137 78 108 138 79 109 139" XFontstr(12) = " 65 74 104 134 75 105 135 77 107 137 78 108 138 79 109 139 80 110 140" loop for i = 1 to 12 sub = 1 loop for j = 1 to 19 XFonts(i,j) = int(XFontstr(i){sub..}) repeat repeat loop for a1 = 1 to 30 Fspacex(a1) = (a1 - 1) * 10 + 1 Fspacex(a1+30) = Fspacex(a1) + 400 Fspacex(a1+60) = Fspacex(a1) + 800 repeat Mbeamfont(1) = 102 Mbeamfont(2) = 102 Mbeamfont(3) = 102 Mbeamfont(4) = 102 Mbeamfont(5) = 103 Mbeamfont(6) = 103 Mbeamfont(7) = 104 Mbeamfont(8) = 105 Mbeamfont(9) = 105 Mbeamfont(10) = 106 Mbeamfont(11) = 106 Mbeamfont(12) = 107 Mbeamfont(12) = 107 Mbeamfont(14) = 108 Mbeamfont(15) = 108 Mbeamfont(16) = 109 Mbeamfont(17) = 109 Mbeamfont(18) = 110 Mbeamfont(19) = 111 Mbeamfont(20) = 111 Mbeamfont(21) = 112 Mbeamfont(22) = 112 Mbeamfont(23) = 114 Mbeamfont(24) = 114 loop for a1 = 1 to 24 revmap(a1) = revsizes(a1) repeat loop for a1 = 1 to 12 revmap(100+a1) = a1 + BEAM_OFFSET repeat revmap(114) = 13 + BEAM_OFFSET revmap(98) = 48 revmap(99) = 49 revmap(100) = 50 dummy(1) = 48 dummy(2) = 48 dummy(3) = 48 dummy(4) = 48 dummy(5) = 49 dummy(6) = 49 dummy(7) = 49 dummy(8) = 49 dummy(9) = 50 dummy(10) = 50 dummy(11) = 50 dummy(12) = 50 extendoff(1) = 32 extendoff(2) = 80 extendoff(3) = 160 extendoff(4) = 208 extendoff(5) = 32 extendoff(6) = 80 extendoff(7) = 160 extendoff(8) = 208 extendoff(9) = 32 extendoff(10) = 80 extendoff(11) = 160 extendoff(12) = 208 return *P XXIII. procedure parameter_init Initializing parameters procedure parameter_init a = 0 b = 0 spaging code #if SCORE_PARS loop for f12 = 1 to f11 if f(f12,14) <> a if a <> 0 and f(f12,14) <> 0 b = 1 end if f(f12,14) > a a = f(f12,14) end end repeat if a = 0 a = NOTEZ end loop for f12 = 1 to f11 if f(f12,14) = 0 f(f12,14) = a end repeat xmskpage code #else loop for f12 = 1 to f11 if f(f12,14) = 0 putc This i-file was typeset by an old version of autoset that is no longer putc supported. Please run autoset again on the stage2 files. putc putc Program Halted putc stop end if f(f12,14) <> a if a <> 0 and f(f12,14) <> 0 b = 1 end if f(f12,14) > a a = f(f12,14) end end repeat End of split #endif maxnotesize = a Initializing horizontal parameters 1. Fixed horizontal parameters 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 /* 12-04-00 changed from 1050 hxpar(6) = 75 hxpar(9) = 130 hxpar(16) = 3 hxpar(17) = 4 hxpar(19) = 9 hxpar(20) = 4 end if maxnotesize = 18 /* New size-18 12/18/04 hxpar(3) = 200 hxpar(4) = 2250 hxpar(6) = 225 /* 75 175 250 hxpar(9) = 300 /* 130 300 300 hxpar(16) = 7 /* 3 6 9 hxpar(17) = 9 /* 4 7 11 hxpar(19) = 28 /* 9 21 32 hxpar(20) = 14 /* 4 10 16 end if maxnotesize = 16 /* New size-16 01/01/09 hxpar(3) = 200 hxpar(4) = 2250 hxpar(6) = 200 /* 75 175 200 225 250 hxpar(9) = 300 /* 130 300 300 300 300 hxpar(16) = 7 /* 3 6 7 7 9 hxpar(17) = 9 /* 4 7 9 9 11 hxpar(19) = 26 /* 9 21 26 28 32 hxpar(20) = 13 /* 4 10 13 14 16 end hxpar(5) = 26 * maxnotesize / 16 hxpar(7) = 24 * maxnotesize / 16 hxpar(10) = 6 * maxnotesize / 16 hxpar(11) = 20 * maxnotesize / 16 hxpar(12) = 4 * maxnotesize / 16 hxpar(13) = 18 * maxnotesize / 16 hxpar(14) = 5 * maxnotesize / 16 hxpar(15) = 60 * maxnotesize / 16 hxpar(18) = 14 * maxnotesize / 16 hxpar(21) = 31 * maxnotesize / 16 hxpar(22) = 19 * maxnotesize / 16 if f11 = 1 /* for parts hxpar(9) /= 3 end 2. Variable Horizontal parameters loop for f12 = 1 to f11 hpar(f12,1) = 60 * f(f12,14) / 16 hpar(f12,2) = 4 * f(f12,14) hpar(f12,5) = 7 * f(f12,14) + 2 / 7 hpar(f12,7) = 15 * f(f12,14) / 16 hpar(f12,9) = 24 * f(f12,14) / 16 hpar(f12,10) = 44 * f(f12,14) / 16 hpar(f12,11) = 20 * f(f12,14) / 16 hpar(f12,12) = 13 * f(f12,14) + 2 / 16 hpar(f12,13) = 6 * f(f12,14) / 16 hpar(f12,14) = 40 * f(f12,14) / 16 hpar(f12,15) = 60 * f(f12,14) / 16 hpar(f12,18) = 14 * f(f12,14) / 16 hpar(f12,21) = 31 * f(f12,14) / 16 hpar(f12,22) = 19 * f(f12,14) / 16 if f(f12,14) = 14 hpar(f12,3) = 4 hpar(f12,4) = 20 hpar(f12,6) = 15 hpar(f12,8) = 17 hpar(f12,16) = 6 hpar(f12,17) = 7 hpar(f12,19) = 21 hpar(f12,20) = 10 hpar(f12,23) = 2 end if f(f12,14) = 21 hpar(f12,3) = 6 hpar(f12,4) = 30 hpar(f12,6) = 21 hpar(f12,8) = 25 hpar(f12,16) = 8 /* changing from 6 to 8 12/18/04 hpar(f12,17) = 11 hpar(f12,19) = 32 hpar(f12,20) = 16 hpar(f12,23) = 3 end if f(f12,14) = 6 hpar(f12,3) = 2 hpar(f12,4) = 9 hpar(f12,6) = 7 hpar(f12,8) = 7 hpar(f12,16) = 3 hpar(f12,17) = 4 hpar(f12,19) = 9 hpar(f12,20) = 4 hpar(f12,23) = 1 end if f(f12,14) = 16 /* New size-16 01/01/09 hpar(f12,3) = 4 /* 2 4 4 5 6 hpar(f12,4) = 23 /* 9 20 23 26 30 hpar(f12,6) = 17 /* 7 15 17 18 21 hpar(f12,8) = 20 /* 7 17 20 23 25 hpar(f12,16) = 7 /* 3 6 7 7 8 hpar(f12,17) = 8 /* 4 7 8 9 11 hpar(f12,19) = 26 /* 9 21 26 28 32 hpar(f12,20) = 13 /* 4 10 13 14 16 hpar(f12,23) = 2 /* 1 2 2 2 3 #if BIG16 ++hpar(f12,8) #endif end if f(f12,14) = 18 /* New size-18 12/18/04 hpar(f12,3) = 5 /* 2 4 6 hpar(f12,4) = 26 /* 9 20 30 hpar(f12,6) = 18 /* 7 15 21 hpar(f12,8) = 23 /* 7 17 25 hpar(f12,16) = 7 /* 3 6 8 hpar(f12,17) = 9 /* 4 7 11 hpar(f12,19) = 28 /* 9 21 32 hpar(f12,20) = 14 /* 4 10 16 hpar(f12,23) = 2 /* 1 2 3 end repeat Variable Vertical parameters ──────────────────────────── loop for f12 = 1 to f11 notesize = f(f12,14) loop for i = 1 to 10 vpar(f12,i) = notesize * i / 2 repeat vpar(f12,11) = 200 * notesize / 16 vpar(f12,12) = 4 * notesize / 16 vpar(f12,13) = 0 /* not used, formerly 8 vpar(f12,14) = 160 * notesize / 16 vpar(f12,15) = 64 * notesize / 16 vpar(f12,16) = 3 * notesize vpar(f12,17) = notesize / 2 vpar(f12,18) = 30 * notesize / 16 vpar(f12,19) = 15 /* fixed for all values of notesize vpar(f12,20) = notesize + 3 / 4 vpar(f12,21) = notesize - vpar(f12,20) vpar(f12,22) = 6 * notesize / 16 vpar(f12,23) = 9 * notesize / 16 vpar(f12,24) = 7 * notesize / 16 vpar(f12,25) = 22 * notesize / 16 vpar(f12,26) = 27 * notesize / 16 vpar(f12,27) = 72 * notesize / 16 vpar(f12,28) = 15 * notesize / 16 vpar(f12,29) = 38 * notesize / 16 vpar(f12,30) = 3 * notesize - 8 / 16 vpar(f12,31) = notesize + 1 / 2 + 1 vpar(f12,32) = notesize * 8 + 4 / 10 vpar(f12,33) = notesize * 12 + 10 / 14 vpar(f12,34) = notesize - 3 / 9 vpar(f12,35) = notesize / 3 vpar(f12,36) = 7 * notesize vpar(f12,37) = 5 * notesize / 4 vpar(f12,38) = 4 * notesize / 3 vpar(f12,39) = notesize vpar(f12,40) = 3 * notesize / 5 if notesize < 18 vpar(f12,41) = 1 end if notesize = 18 /* New size-18 12/18/04 vpar(f12,41) = 2 end if notesize = 21 vpar(f12,41) = 3 /* changing from 2 to 3 12/18/04 end vpar20(f12) = 10 * notesize repeat Other parameters and variables ────────────────────────────── 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 End of Initialization of parameters return *P XXIV. procedure pageform_init Get parameters for page layout, either from FORMATS file or directly from the screen. procedure pageform_init if formatflag = 0 and formatfile <> "" putc Do you want to create a format file? (return = no) getc line line = trm(line) if line <> "" formatflag = 2 treset [F] forp = 0 end end if formatflag = 1 open [1,1] formatfile treset [F] forp = 0 loop getf [1] bigline bigline = trm(bigline) if bigline <> "" ++forp tput [F,forp] ~bigline end repeat eof1: close [1] forpz = forp end if formatflag = 1 forp = 1 tget [F,forp] line line = trm(line) if line = "" or line con "no" or line con "No" putc Reduced size = No line = "" else putc Reduced size = Yes end else /* formatflag = 0 or 2 line = "" /* reduced size no longer a choice if formatflag = 2 ++forp tput [F,forp] Reduced size = no end end if line <> "" hxpar(3) = 520 hxpar(4) = 2270 lowerlim = 2400 toplim = 100 else if maxnotesize = 6 lowerlim = 1250 toplim = 60 else lowerlim = 2900 toplim = 140 end end simple_test = 0 if formatflag <> 1 putc Enter a non-blank line if this is a simple test getc line line = trm(line) if line <> "" simple_test = 1 end end if formatflag = 1 ++forp tget [F,forp] line .t1 i line = trm(line) if line = "" or line con "default" or i = 0 psq(1) = toplim - 20 putc Height of new typesetting = top of page else psq(1) = i putc Height of new typesetting = ~i end else /* formatflag = 0 or 2 putc Height of new typesetting (return = top) getc line .t1 i line = trm(line) if line <> "" psq(1) = i else psq(1) = toplim - 20 end if formatflag = 2 if line = "" line = "Use default height for new typesetting" end ++forp tput [F,forp] ~line end end if formatflag = 1 ++forp tget [F,forp] line line = trm(line) if line = "" or line con "No tacit instructions" line = "" putc No line of tacit instructions else putc Line of tacit instructions = ~line end else /* formatflag = 0 or 2 putc Line of tacit instructions? (return = none) getc line line = trm(line) if formatflag = 2 ++forp if line = "" tput [F,forp] No tacit instructions else tput [F,forp] ~line end end end tacetline = line justflag = 0 if formatflag = 1 ++forp tget [F,forp] line line = trm(line) if line con "yes" or line con "Yes" putc Production copy; right justify last line. justflag = 2 else putc Proof copy only; do not try to justify last line. end #if SCROLL_OUT justflag = 0 #endif Variable "wide" feature added 01/01/09 #if WIDE hxpar(3) = 100 hxpar(4) = 2350 #else if line con "wide" line = line // " " line = line{mpt..} if line con " " line = line{mpt..} end tput [GN,1] ~line a = 1000 b = 1000 tget [GN,1] a b if a = 1000 a = 100 end if b = 1000 b = 100 end hxpar(3) -= a hxpar(4) += b end #endif else /* formatflag = 0 or 2 #if SCROLL_OUT justflag = 0 if formatflag = 2 ++forp tput [F,forp] Justify = no end #else putc Right justify last line? (return = no) Also, enter "wide" command here. getc line 03/06/09 Adding code here to allow margins to be set by the "wide" command a = 0 b = 0 if line con "wide" line = line{mpt..} line = line // " " if line con " " line = line{mpt..} end line = trm(line) if line = "" a = 100 b = 100 line = "y" else tput [GN,1] ~line a = 1000 b = 1000 tget [GN,1] a b if a = 1000 a = 100 end if b = 1000 b = 100 end end hxpar(3) -= a hxpar(4) += b else line = trm(line) end if formatflag = 2 ++forp if line = "" tput [F,forp] Justify = no else if a <> 0 or b <> 0 /* This condition new 03/06/09 tput [F,forp] Justify = yes wide ~a ~b else tput [F,forp] Justify = yes end end end if line <> "" justflag = 2 end #endif end if formatflag = 1 ++forp tget [F,forp] line line = trm(line) if line = "" or line con "No movement title" putc No movement title line = "" else putc Movement title = ~line end else /* formatflag = 0 or 2 putc Movement title? getc line line = trm(line) if formatflag = 2 ++forp if line = "" tput [F,forp] No movement title else tput [F,forp] ~line end end end mvtline = line 1. ask for brace/bracket/bar structure if formatflag = 1 ++forp tget [F,forp] syscode putc Syscode = ~syscode a = 0 b = 0 loop for i = 1 to len(syscode) if "[](){}" con syscode{i} c = mpt + 1 >> 1 ++tarr(c) ++a if bit(0,tarr(c)) <> bit(0,mpt) putc Incompatable syscode; please enter by hand goto SQ end end if "x:" con syscode{i} f(b+1,12) = mpt syscode{i} = "." else f(b+1,12) = 0 end if syscode{i} = "." ++b loop for c = 1 to 3 if bit(0,tarr(c)) <> 0 goto SQ11 end repeat putc Incompatable syscode; please enter by hand goto SQ end SQ11: repeat if b <> f11 putc Incompatable syscode; please enter by hand goto SQ end if bit(0,a) = 1 putc Incompatable syscode; please enter by hand goto SQ end goto WWW end SQ: putc Enter brace/bracket/bar structure putc [] = bracket and bar () = bar only {} = brace dot = part colon = grandstaff getc syscode savesyscode = syscode a = 0 b = 0 loop for i = 1 to len(syscode) if "[](){}" con syscode{i} c = mpt + 1 >> 1 ++tarr(c) ++a if bit(0,tarr(c)) <> bit(0,mpt) goto SQ end end if "x:" con syscode{i} f(b+1,12) = mpt syscode{i} = "." else f(b+1,12) = 0 end if syscode{i} = "." ++b loop for c = 1 to 3 if bit(0,tarr(c)) <> 0 goto SQ1 end repeat goto SQ end SQ1: repeat if b <> f11 goto SQ end if bit(0,a) = 1 goto SQ end if formatflag = 2 ++forp tput [F,forp] ~savesyscode end 2. set spacing for lines WWW: loop for i = 1 to 30 w(i) = 0 repeat if formatflag = 1 ++forp tget [F,forp] bigline bigline = bigline // " |" sub = 1 loop for i = 1 to 30 a = int(bigline{sub..}) if a = 0 i = 30 else w(i) = a end repeat putc Spacings = ... if w(1) = 0 putc default: Music with text = ~vpar(1,11) With no text = ~vpar(1,14) else loop for i = 1 to f11 if w(i) = 0 putc Not enough spaces; you need ~f11 putc Please fix the format file: ~formatfile putc and try again. putc putc Program Halted 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 Program Halted putc stop end loop for j = 1 to 30 if w(j) > 0 putc ~w(j) ... else putc j = 30 end repeat end else /* formatflag = 0 or 2 putc Line spacing: text, no text (return = no change) putc Otherwise, enter all spacings (max of 15 per line) putc ~vpar(1,11) ~vpar(1,14) temp1 = "" temp2 = "" getc w(1) w(2) w(3) w(4) w(5) w(6) w(7) w(8) w(9) w(10) w(11) w(12) w(13) w(14) w(15) .t1 temp1 if w(15) <> 0 getc w(16) w(17) w(18) w(19) w(20) w(21) w(22) w(23) w(24) w(25) w(26) w(27) w(28) w(29) w(30) .t1 temp2 loop for i = 1 to f11 if w(i) = 0 putc Not enough spaces; you need ~f11 goto WWW end repeat if w(f11+1) <> 0 putc Too many spaces; you need ~f11 goto WWW end end temp1 = trm(temp1) temp2 = trm(temp2) if formatflag = 2 if temp1 = "" bigline = "Spacings = default" else bigline = temp1 // " " // temp2 bigline = trm(bigline) end ++forp tput [F,forp] ~bigline end end putc loop for i = 2 to f11 if w(1) = 0 if f(i-1,9) = 0 psq(i) = psq(i-1) + vpar(i-1,14) else psq(i) = psq(i-1) + vpar(i-1,11) end else psq(i) = psq(i-1) + w(i-1) end if f(i-1,12) = 2 if vst(i-1) = 0 vst(i-1) = vpar(i-1,14) end psq(i) += vst(i-1) else vst(i-1) = 0 end repeat if f(f11,12) = 2 if vst(f11) = 0 vst(f11) = vpar(f11,14) end end #if XVERSION #else if formatflag = 2 open [1,2] formatfile loop for i = 1 to forp tget [F,i] bigline bigline = trm(bigline) putf [1] ~bigline repeat close [1] end #endif no_action = 0 psysnum = 0 edflag = 0 start_look = 1 pn_left = 0 This code added 12/24/03 to set new variables intersys and firstsys if w(1) = 0 intersys = vpar(f11,14) * 3 / 2 else intersys = w(f11) end firstsys = TRUE return *P XXIV. procedure show_Ytable For debug purposes, show us what has been put into the Y table procedure show_Ytable int i putc Current contents of Y table. Size = ~mainyp putc loop for i = 1 to mainyp tget [Y,i] line putc ~line repeat putc return spaging code #if SCORE_PARS *P XXV(a). process_and_transfer (size) Transfer Y-table to output file Input: size = last record to transfer procedure process_and_transfer (size) str line.200 int size int i getvalue size open [3,2] outfile if f11 > 1 03/25/06 Data to support analysis if andata_flag = 1 loop for i = 1 to tq_size tget [Q,i] line line = trm(line) putf [3] ~line repeat loop for f12 = 1 to f11 putf [3] @ SOURCE: ~@sources(f12) repeat andata_flag = 2 end loop for i = 1 to size tget [Y,i] line line = trm(line) if line{1} = "S" and andata_flag > 0 putf [3] ~@system end putf [3] ~line repeat close [3] return end loop for i = 1 to size tget [Y,i] line line = trm(line) putf [3] ~line repeat close [3] return xmskpage code #else *P XXV(b). procedure output_page (size) Transfer Y-table to output file procedure output_page (size) str line2.200 int size int h,i,j,k int a,b,c,d,e int next_obx,prior_obx,current_obx int next_i int gap,minspace,gap2,length,shift int flag getvalue size open [3,2] outfile if f11 > 1 03/25/06 Data to support analysis if andata_flag = 1 loop for i = 1 to tq_size tget [Q,i] line line = trm(line) putf [3] ~line repeat loop for f12 = 1 to f11 putf [3] @ SOURCE: ~@sources(f12) repeat andata_flag = 2 end loop for i = 1 to size tget [Y,i] line line = trm(line) if line{1} = "S" and andata_flag > 0 putf [3] ~@system end putf [3] ~line repeat close [3] return end gap = maxnotesize * 2 minspace = gap * 2 + 90 loop for i = 1 to size tget [Y,i] line line = line // pad(6) if line{1,5} = "J S 4" current_obx = int(line{7..}) line = line{sub..} line = mrt(line) loop for j = i + 1 to size tget [Y,j] line2 if line2{1} = "J" b = int(line2{5..}) next_obx = int(line2{sub..}) /* next obx next_i = j - 1 j = size end repeat loop for j = i - 1 to 1 step -1 tget [Y,j] line2 if line2{1} = "J" and line2{3} <> "D" and line2{3} <> "M" /* New 02/13/09 b = int(line2{5..}) prior_obx = int(line2{sub..}) /* prior obx New 02/13/09 if line2{3} = "K" k = int(line2{5..}) if k > 0 prior_obx += (k * hpar(f12,6)) end if k < 0 prior_obx -= (k * hpar(f12,7)) end end j = 1 end repeat k = next_obx - prior_obx if k > minspace flag = 0 h = k / minspace gap2 = gap * h h = prior_obx + gap2 length = next_obx - h - gap2 shift = length - 90 / 2 line = "J S 4 " // chs(h) // " " // line putf [3] ~line loop for j = i + 1 to next_i tget [Y,j] line2 if line2{1} = "K" a = int(line2{3..}) b = int(line2{sub..}) c = int(line2{sub..}) if c > 70 and c < 81 a += shift putf [3] K ~a ~b ~c end if c = 62 if a = 0 putf [3] K 0 ~b 62 else putf [3] K ~length ~b 62 end end if c = 92 and flag = 0 flag = 1 a = length loop while a > 30 d = a - 30 putf [3] K ~d ~b 92 a -= 30 repeat putf [3] K 0 ~b 92 end end repeat i = next_i end else line = trm(line) putf [3] ~line end repeat close [3] return End of split #endif *P XXX. procedure look_dir (name) look inside directory (name) procedure look_dir (name) str name.200 str line.200 int i getvalue name open [7,1] name loop for i = 1 to 2000 getf [7] line line = line{33..} line = line // pad(20) line = line{1,20} dir_contents(i) = trm(line) repeat eof7: close [7] dir_size = i - 1 return #if XVERSION This is a GIANT #if section -- extending to the End of the Program ┌─────────────────────────────────────────────────────────────────────────┐ │ Below this point, the code derives from the ESKPAGE program. The │ │ main program is cast as a procedure, with all of its own variables. │ │ The exception is those variables which are "inter-procedural" in │ │ ESKPAGE and therefore must be declared globally. To avoid "clashes" │ │ with MSKPAGE variables of the same name, these variables have been │ │ given the prefix "esk" │ └─────────────────────────────────────────────────────────────────────────┘ ESKPAGE program. Rewritten as a procedure procedure eskpage notesize = 14 sizenum = 8 Initialize display strings setup curstr,5,32,1,0,0,160,904 setup msgstr,160,60,1 setup redmsgstr,160,60,1 msgstr{8341,160} = gline{1,160} /* line 3 + 50 50 x 160 = 100 x 80 = 8000 msgstr{8501,160} = gline{1,160} /* line 4 + 50 msgstr{8661,160} = gline{1,160} /* line 5 + 50 msgstr{8821,160} = gline{1,160} /* line 6 + 50 perform setupmsg activate msgstr,0,MSGVLOC,1 activate redmsgstr,0,MSGVLOC,4 setup gstr,300,3100,3,0,0,160,904 setup tstr2,160,1600,1,0,0,160,904 setup tstr3,160,1040,1,0,0,160,904 setup tstr4,160,910,1,0,0,160,904 setup red_gstr,300,3100,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 setup red_tstr3,160,1040,1,0,0,160,904 setup red_tstr4,160,910,1,0,0,160,904 bitmode 2, xze, yze xze >>= 3 Transfer source file to Z table 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 New code added 12/06/03 implementing pointers from bar objects to bar records loop for i = 1 to 1000 barlinks(i) = 0 repeat barlink_cnt = 0 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 getf [1] line 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 if "Rr" con jtype and ntype = 9 and nodenum = 1 and oldrestx <> obx /* New 10/15/07 ++measnum else trigger = 0 end end end end curnode = 10000 * measnum + nodenum if jtype = "M" and curnode <> savecurnode and nodenum = 6913 i = savecurnode / 10000 if rem <> 6913 curnode = savecurnode end end pointers(object_count,9) = curnode if curnode <> savecurnode if savecurnode <> 0 i = object_count - 1 loop while pointers(i,9) = savecurnode pointers(i,3) = object_count /* forward pointer --i repeat while i > 0 xbacknode = xsavecurnode else xbacknode = object_count end savecurnode = curnode xsavecurnode = object_count Look for this node in the node list 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 New code added 12/06/03 implementing pointers from bar objects to bar records ++barlink_cnt barlinks(barlink_cnt) = k end if jtype = "R" and ntype = 9 and nodenum = 1 if "Rr" con jtype and ntype = 9 and nodenum = 1 /* New 10/15/07 trigger = 2 oldrestx = obx end else if line{1} = "H" ++super_count supernum = int(line{3..}) tput [X,k] H ~super_count .t8 ~line{3..} super_pointers(super_count,1) = k super_pointers(super_count,3) = relob_cnt + 1 j = 0 loop for i = 1 to 200 if temp_store_ob(i,2) = supernum ++relob_cnt ++j related_objects(relob_cnt) = temp_store_ob(i,1) temp_store_ob(i,1) = 0 temp_store_ob(i,2) = 0 end repeat super_pointers(super_count,4) = j else tput [X,k] ~line if line{1} = "S" tget [X,k] line a = int(line{5..}) b = int(line{sub..}) line = "S 0 " // chs(a) // " 120" // line{sub..} tput [X,k] ~line syspoint = k loop for i = 1 to nodelistcnt nodelist(i,1) = 0 nodelist(i,2) = 0 repeat nodelistcnt = 0 ++system_cnt system_rec(system_cnt) = k list_order(k,3) = -1 list_order(k,5) = -1 barlink_cnt = 0 /* added 12/06/03 end if line{1} = "L" or line{1} = "l" linepoint = k measnum = 0 trigger = 1 list_order(k,3) = -1 list_order(k,5) = -1 end New code added 12/06/03 implementing pointers from bar objects to bar records 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 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 <esc> to stop the program. putc putc P R O G R A M H A L T E D putc stop end if trp = 10 putc putc TERMINATION NOTICE !!! putc putc The ESKPAGE module is confused about something you did. It putc is most probably not 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 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 TRANSFER APPARATUS 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 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 P R O G R A M H A L T E D putc stop end return ╔═════════════════════════════════════════════════╗ ║ ║ ║ P R O C E D U R E S ║ ║ ║ ╚═════════════════════════════════════════════════╝ *P 1. esksetbeam Purpose: Typeset beams and accompanying notes and stems. Also typeset accompanying tuplet, if present Inputs: bcount = number of notes under beam beamdata(.,1) = x-position of note beamdata(.,2) = y-position of note beamcode(.) = beam code beam code = 6 digit number (string) 0 = no beam 1 = continue beam 2 = begin beam 3 = end beam 4 = forward hook 5 = backward hook 6 = single stem repeater 7 = begin repeated beam 8 = end repeated beam 100000's digit = eighth level beams 10000's digit = 16th level beams 1000's digit = 32nd level beams 100's digit = 64th level beams 10's digit = 128th level beams 1's digit = 256th level beams @k = distance from first object (oby of note group) to top of top beam (for stems up) or bottom of bottom beam (for stems down). @k > 0 means stem up. @m = number of dots the beam falls (rises = negative) in a distance of 30 horizontal dots. (i.e. slope * 30) beamfont = font for printing beam stemchar = character number for stem beamh = height parameter for beams beamt = vertical space between beams (normally eskvpar(32)) qwid = width of quarter note (normally eskhpar(3)) tupldata(1) = tuplet situation flag tupldata(2) = tuplet number tupldata(3) = x1 offset tupldata(4) = x2 offset tupldata(6) = y1 offset / For case where tuple goes over tupldata(7) = y2 offset \ note heads and there are chords. tbflag = print tuplet flag Outputs: prints out beams, stems and notes by means of procedures, printbeam, hook and revset. Internal variables: beamfy = y coordinate of first note under beam @b = y-intercept of beam @f = temporary variable @g = temporary variable (related to @@g) @h = temporary variable @i = temporary variable @j = temporary counter @k = |@m| @n = temporary variable @q = temporary counter @s = temporary variable @t = temporary variable @@b = vertical range of note set @@g = top of staff line @@n = temporary variable @@q = temporary variable bthick = thickness of beam - 1 (x1,y1) = temporary coordinates (x2,y2) = temporary coordinates z1,z2,z3 = temporary character numbers stemdir(80) = stem directions for mixed direction case stemends(80) = stem endpoints for mixed direction case beampos(8) = position of beam (mixed stem dir) beamlevel = index into beampos(one for each note belonging to beam) 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 check for errors in beam repeaters 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 Determine direction of first stem 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 Program Halted putc stop end if @k > 0 stem = UP else stem = DOWN end Check for situation where notes span two staves (grand staff) 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 Adjust all y coordinates be relative to the top staff 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 Check for mixed stem directions 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 Deal with tuplets attached to note heads 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 Adding code 05/09/03 to make space for numbers inside brackets 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 Code fix 11/30/07 trying a new algorithm for avoiding clash with staff line. @h = 0 - notesize * 2 / 3 + staff_height - @s if y1 > @h y1 = @h end if y2 > @h y2 = @h end @h = 0 - notesize * 2 / 3 + staff_height if (y1 + tupldata(6)) > @h y1 = @h - tupldata(6) end if (y2 + tupldata(6)) > @h y2 = @h - tupldata(6) end end else if staff_height <> 10000 Same code fix as above 11/30/07 @h = 11 * notesize / 2 + staff_height + @s if y1 < @h y1 = @h end if y2 < @h y2 = @h end @h = 11 * notesize / 2 + staff_height if (y1 + tupldata(6)) < @h y1 = @h - tupldata(6) end if (y2 + tupldata(6)) < @h y2 = @h - tupldata(6) end 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) Reverse all y co-ordinates if first stem is down @g = esksq(eskf12) if stem = DOWN @g = eskvpar(2) * 500 - eskvpar(8) - @g loop for @j = 1 to bcount beamdata(@j,2) = eskvpar(2) * 500 - beamdata(@j,2) repeat end @@g = @g if stem = 1 @m = 0 - @m @k = 0 - @k end dv3 = @m * beamdata(1,1) dv3 = beamdata(1,2) - @k * eskhpar(1) - dv3 @k = abs(@m) @@q = 0 loop for @j = 1 to bcount @n = 5 if beamcode(@j) con "0" @n = mpt - 2 /* number of additional beams on this note end if @n > @@q @@q = @n /* max number of additional beams end repeat ++@@q if @@q > 3 beamt = eskvpar(33) end This is the printout portion of the procedure ───────────────────────────────────────────── @m = eskhpar(1) * slope of beam @k = |@m| dv3 = y-intercept of top of beam (times eskhpar(1)) identify beam characters z1 = @k + 33 if @m > 0 z1 += 128 end z2 = @k + 49 if @m > 0 z2 += 128 end check for tuplet over beam if tbflag = 2 sitflag = tupldata(1) if bit(7,sitflag) = 1 /* curved bracket 03/15/97 a4 = 0 - 2 * qwid / 3 if stem = UP a4 = qwid / 3 end else a4 = 0 - qwid / 3 if stem = UP a4 = 2 * qwid / 3 end end a1 = tupldata(2) x1 = beamdata(1,1) + a4 - esksp + tupldata(3) x2 = beamdata(bcount,1) + a4 - esksp + tupldata(4) y1 = @m * beamdata(1,1) + dv3 / eskhpar(1) y2 = @m * beamdata(bcount,1) + dv3 / eskhpar(1) if stem = DOWN y1 = eskvpar(2) * 500 - y1 - bthick - esksq(eskf12) + eskvpar(39) + eskvpar(38) y2 = eskvpar(2) * 500 - y2 - bthick - esksq(eskf12) + eskvpar(39) + eskvpar(38) else y1 = y1 - eskvpar(39) - esksq(eskf12) y2 = y2 - eskvpar(39) - esksq(eskf12) end y1 += tupldata(6) y2 += tupldata(7) perform puttuplet end Here the situation diverges Case I: all stems go in the same direction Case II: stem directions are mixed Case I: all stems go in the same direction if mixflag = 0 put in first beam x1 = beamdata(1,1) x2 = beamdata(bcount,1) if beamcode(1){1} = "7" x1 += eskhpar(59) x2 -= eskhpar(59) end perform printbeam put in vertical stems 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 put in other beams 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 Case II: stem directions are mixed 1. Determine definitive stem directions and end points on main staff. 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 first stem x1 -= qwid - eskhpar(29) else x1 += qwid - eskhpar(29) end y1 = @m * x1 + dv3 / eskhpar(1) + 4 end stemends(@j) = y1 repeat 2. Put in first beam 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 2a. Set beamlevel = 1 for all notes. beamlevel for notes will change as we move through the beam. Basically, if notes A and B start and end a beam respectively, then beamlevel will be given the same value for all of these notes and any that might be in between. If another beam extends between notes C and B, then beamlevel for these notes will be increased. In the end, beamlevel for each note will be the number of beams connecting or going through the stem for that note. loop for @j = 1 to bcount beamlevel(@j) = 1 repeat NEW 05/19/03 I am going to attempt a rewrite of this section. The problem with the old code was that it sometimes didn't give asthetically pleasing solutions. In particular, the problem arises when a secondary beam is to be drawn between endpoints whose stems are in different directions. The old code made the arbitrary decision to draw the secondary beam according to the direction of the stem of the initial note. This had the additional advantage that stems could be drawn as notes were processed, i.e., we would not have to go back and "lengthen" a stem because a secondary beam was drawn on the other side of the primary. With this rewrite, I must change this, i.e., stems cannot be drawn until all beams are set. Secondly, I need to come up with a set of rules as to how to deal with the situation where the endpoints of a secondary connect to stems of different directions. I propose to generate these rules from experience, and by trial and error. As we encounter situations where the result seems to violate common sense, then we can consider adding a new rule. It should be pointed out that at the moment there is no provision made for editing the decision made by this program as regards the placing of secondary beams. To add this feature, we would need to expand the contents of the beam super-object record. As of this data 05/19/03, I have only one rule to propose for cases where the endpoints have stems that go in different directions. 1. If there is a stem that follows the terminating stem, then use use this stem direction to "arbitrate" between the directions of the endpoint stems. If no stem follows, then the stem direction of the initial note wins. 3. Loop through notes, one at a time 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 a. add all extra beams starting at this note (and increase beamlevel accordingly) 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 9-21-96 if stem = UP x2 -= qwid - eskhpar(29) else x2 += qwid - eskhpar(29) end end dv3 = beampos(1) Here is where the rules take effect. Case I: Use stem direction of first note to determine secondary beam position cases: 1) Normal: stemdir(@g) = stemdir(@j) 2) stemdir(@g) <> stemdir(@j) but either @g = bcount or stemdir(@g+1) = stemdir(@j) 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 b. adjust stem ends for notes under (over) this beam 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 Case II: Use stem direction of last note to determine secondary beam position cases: 1) stemdir(@g) <> stemdir(@j), and @g < bcount, and stemdir(@g+1) = stemdir(@g) 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 c. adjust stem ends for notes under (over) this beam 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 Increment beamlevel for all notes between endpoints of this beam ++beamlevel(@g) end repeat if @g <> 10000 putc No termination found for beam goto BERR end else @h = 6 end repeat d. put in any hooks that might go with this note 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 4. Loop again through notes, one at a time, and now draw the stems (05/19/03) loop for @j = 1 to bcount a. put in stem 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 End of 05/19/03 rewrite end return BERR: putc Beam format error, printbeam aborted return *P 2. hook Purpose: Typeset hook beam Inputs: @m = slope * eskhpar(1) x1 = horizontal position of note y = vertical position of hook attachment stem = stem direction z = hook character beamfont = type of font for beam procedure hook x = x1 if stem = 1 y = eskvpar(2) * 500 - y - bthick z += 128 z &= 0xff else x += qwid - eskhpar(29) end scf = beamfont scx = x scy = y scb = z perform charout scf = notesize return *P 3. printbeam Purpose: Typeset beam Inputs: @m = slope * eskhpar(1) x1 = starting point of beam x2 = end point of beam dv3 = y intercept of beam (times eskhpar(1)) stem = stem direction z1 = beam character number for this slop 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 <n> "overlapping" hooks if stem = DOWN y = eskvpar(2) * 500 - y - bthick else x2 += qwid - eskhpar(29) end PBEAM01: scy = y scb = 65 perform charout x += eskhpar(2) if x < x2 goto PBEAM01 end scx = x2 scb = 65 perform charout scf = notesize return end z = z1 if stem = DOWN z += 128 z &= 0xff end loop while x1 <= x2 y = y1 if stem = DOWN y = eskvpar(2) * 500 - y - bthick end scy = y scb = z perform charout x1 += eskhpar(1) y1 += @m repeat y2 = x2 + eskhpar(1) - x1 print fraction of beam y2 = extra length needed to complete beam if y2 = 0 scf = notesize return end y = y1 if stem = DOWN y = eskvpar(2) * 500 - y - bthick end 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 *P 4. revset Purpose: Check for reversal of page and correct x y and z Inputs: x1 = horizontal position of note y1 = vertical position of note z3 = character to typeset stem = stem direction procedure revset x = x1 y = y1 z = z3 if stem = DOWN if z = 59 or z = 61 or z = 187 or z = 189 ++z end y = eskvpar(2) * 500 - y end perform setmus return *P 5. setmus Purpose: Typeset character Inputs: x = horizontal position of note y = vertical position of note z = character to typeset sizenum = current scale size (1 to 12) procedure setmus int sy,pz if z = 0 return end Implementing extended music font 02/19/06 if z > 999 pz = dummy(sizenum) sy = y z = extendoff(sizenum) + z - 1001 scx = x scy = sy scb = z scf = pz + 50 /* scf is intex into revmap producing fonts 48,49,50 perform charout scf = notesize return end End of 02/19/06 addition sy = y - pos(z-32) scx = x scy = sy scb = z perform charout return 04/22/04 Setwords now occurs in one version: NEWFONTS *P 6. setwords Purpose: Typeset words Inputs: x = horizontal position of words y = vertical position of words z = font number for words line = words to set procedure setwords (a1) str textline.300 int t1 04/22/04 Call to setwords now includes paramter: 0 = regular setwords call 1 = setwords called from TEXT sub-obj int a1 getvalue a1 04/22/04 This code taken from settext (08/31/03 OK) if a1 = 1 and line = "&" return end scx = x scy = y if z = 1 /* added 03/15/04 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 This coded added 03/05/04 to implement "in-line" space commands if "!@#$%^&*(-=" con textline{2} textline = chr(130+mpt) // textline{3..} goto A11 end 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 End of setwords with NEWFONTS *P 6a. lineout Purpose: Send a line of text to output device Inputs: line2 z = font number for words Side effects: value of z may be changed value of scf may be changed procedure lineout int t1, t2, t3 str textline.300 AAA111: if line2 con "!" t1 = mpt if t1 > 1 if z <> notesize and z <> 1 /* z <> 1 added 01/13/04 textline = line2{1,t1-1} else textline = "" loop for t2 = 1 to t1 - 1 t3 = ors(line2{t2}) t3 = music_con(t3) textline = textline // chr(t3) repeat end perform stringout (textline) line2 = line2{t1..} end if len(line2) > 1 if "0123456789" con line2{2} z = int(line2{2..}) if z = 1 /* added 03/15/04 scf = notesize else scf = z end if sub <= len(line2) line2 = line2{sub..} Code added 01/17/04 to remove terminator to font designation field if line2{1} = "|" if len(line2) = 1 return end line2 = line2{2..} end goto AAA111 else return end else if z <> notesize and z <> 1 /* z <> 1 added 01/13/04 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 01/13/04 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 *P 8. staff Purpose: Typeset staff Inputs: y = absolute vertical location esksp = starting point of staff lines esksyslen = length of staff lines stave_type = type of staff 0 = 5-line /* New 12/18/05 1 = single line procedure staff int slen if notesize >= 10 slen = 64 else slen = 32 end New 12/18/05: Single line stave if stave_type = 1 y += eskvpar(4) d2 = esksp + esksyslen - eskhpar(1) z = 90 loop for x = sp to d2 step eskhpar(1) perform setmus repeat x = d2 perform setmus y -= eskvpar(4) return end End of 11/11/05 addition if notesize >= 18 /* Added 11/18/03 to fill holes in lines /* New 12/18/04 changed from = 21 to >= 18 d2 = esksp + esksyslen - slen z = 81 loop for x = esksp to d2 step slen - 1 perform setmus ++x perform setmus repeat x = d2 perform setmus --x perform setmus else d2 = esksp + esksyslen - slen z = 81 loop for x = esksp to d2 step slen perform setmus repeat x = d2 perform setmus end return *P 9. settie Purpose: Typeset typeset tie Inputs: x1 = x-object coordinate of first note y1 = y-object coordinate of first note (+1000 if on virtual staff) tspan = distance spanned by tie sitflag = situation flag eskf12 = staff number tpost_x = post adjustment to left x position added 04/20/03 tpost_y = post adjustment to y position " tpost_leng = post adjustment to right x position " Internal varibles: d1 = temporary variable d2 = temporary variable tiechar = first tie character textend = tie extention character hd = horizontal displacement vd = vertical displacement procedure settie int d1,d2,d3,d4,d5 int virtoff label STL(4) 1) decode y-object coordinate of first note virtoff = 0 if y1 > 700 y1 -= 1000 virtoff = eskvst(eskf12) end 2) complete sitflag 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: 3) from sitflag and tspan, get tiechar, hd and vd * putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag tspan -= tpost_x /* added 04/20/03 tspan += tpost_leng /* added 04/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 4) typeset tie x = x1 + hd + esksp + tpost_x /* modified 04/20/03 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 Revision 09/21/02: 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 *P 10. sethyph (level) Purpose: Typeset hyphons Inputs: level = level of text line (usually 1) x = absolute coordinate of terminating syllable y = absolute coordinate text line eskbackloc(.) = location first space beyond last syllable or location of first hyphon on next line Internal varibles: a,b,c,d procedure sethyph (level) int level int a,b,c,d /* a,b,c,d added 03/15/04 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) 08/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) if x = esksysright /* esksysright (from i-file) replaces eskhpar(9) 12/31/08 scx = eskbackloc(level) scb = ors("-") perform charout goto CM end end else if eskbackloc(level) = ibackloc(level) /* changed from eskhpar(15) 08/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 *P 11. setunder (level) Purpose: Typeset underline Inputs: level = level of text line (usually 1) eskuxstop(.) = x-coordinate of end of line eskuxstart(.) = x-coord. of first space beyond last syllable or location of first hyphon on next line y = y-coordinate for text line underflag = execution flag, currently set for ties and melismas eskxbyte(.) = ending punctuation Internal varibles: a,b,c,d procedure setunder (level) int a,b,c,d /* 03/15/04 adding a,b,c,d int level getvalue level if underflag = 0 return end x = eskuxstart(level) - eskhpar(19) scf = mtfont scx = x scy = y a = eskuxstop(level) - eskuxstart(level) * a = distance over which to set hyphons if a >= eskhpar(18) y -= eskvpar(13) scx = eskuxstart(level) scy = y scb = ors("_") b = eskuxstop(level) - underspc(sizenum) d = underspc(sizenum) loop for c = eskuxstart(level) to b step d perform charout repeat scx = b perform charout scx += 5 scy += eskvpar(13) end if underflag = 1 and eskxbyte(level) <> "_" scb = ors(eskxbyte(level)) perform charout end scf = notesize return *P 14. putslur Purpose: Typeset slur Inputs: (x1,y1) = starting note head (x2,y2) = terminating note head slur_edit_flag = flag indicating that y1 and/or y2 have been altered postx = horiz. movement of slur after it has been chosen posty = vert. movement of slur after it has been chosen addcurve = flag indicating the curvature should be added sitflag = situation flag bit clear bit set -------------- ------------- bit 0: full slur dotted slur bit 1: stock slur custom slur bit 2: first tip down first tip up (*) bit 3: second tip down second tip up (+) bit 4: compute stock slur hold stock slur (*) used on custom slurs only (+) used on stock slurs only bit 5: continuous slur broken slur /* 03/15/97 bits 8-15: size of break (0 to 255 dots, centered) Internal variables: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 c1,c2,c3,c4,c5,c6,c7 procedure putslur str line2.480 bstr tbt.2500 /* added 01/26/05 bstr tbt2.2500 /* added 01/26/05 int save_y1,save_y2 int save_x1,save_x2 save_y1 = y1 /* added 01/03/05, etc. save_y2 = y2 save_x1 = x1 save_x2 = x2 determine case 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 determine method of dealing with slurs stock vs. custon if notesize = 14 a5 = 800 /* changed from 801 on 9-12-97 end if notesize = 6 a5 = 400 /* changed from 801 on 9-12-97 end if notesize = 21 a5 = 600 /* changed from 601 on 9-12-97 end if notesize = 18 /* New size-18 12/18/04 a5 = 800 end if notesize = 16 /* New size-16 01/01/09 a5 = 800 end if x2 - x1 < a5 /* stock slurs SR5: a5 = eskvpar(10) + eskvpar20 - y1 * 2 + 1 / eskvpar(2) - 20 a6 = eskvpar(10) + eskvpar20 - y2 * 2 + 1 / eskvpar(2) - 20 a7 = abs(a5-a6) determine whether to use the parametric method of slur placement if a7 < 11 or (x2 - x1 < 100 and slur_edit_flag = 0) /* protopar file specific if a7 > 10 a7 -= 10 a7 = a7 + 20 * eskvpar(2) / 2 - eskvpar20 if a1 = 1 y1 -= a7 else if a1 = 2 y2 -= a7 else if a1 = 3 y2 += a7 else /* a1 = 4 y1 += a7 end end end goto SR5 end if a5 < 1 or a6 < 1 goto SR1 end if a5 > 11 or a6 > 11 goto SR2 end goto SR3 * adjust parameters upward SR1: a10 = a5 a11 = a6 if a6 < a5 a10 = a6 a11 = a5 end a10 = 1 - a10 /* minimum amount to raise pars if a7 < 10 a12 = a10 / 2 if a9 = 0 /* convex slur a10 += rem else if a11 + a10 > 3 a10 += rem end end end a5 += a10 a6 += a10 goto SR3 * adjust parameters downward SR2: a10 = a5 a11 = a6 if a6 > a5 a10 = a6 a11 = a5 end a10 -= 11 /* minimum amount to lower pars if a7 < 10 a12 = a10 / 2 if a9 = 1 /* concave slur a10 += rem else if a11 - a10 < 9 a10 += rem end end end a5 -= a10 a6 -= a10 SR3: get stock slur number and location SR4: a7 = x2 - x1 if notesize = 14 or notesize = 16 or notesize = 18 /* Modified (size-16) 01/01/09 if a7 < 10 --x1 ++x2 goto SR4 end end if notesize = 21 if a7 < 15 --x1 ++x2 goto SR4 end end if notesize = 6 if a7 < 5 --x1 ++x2 goto SR4 end end if notesize = 14 or notesize = 16 or notesize = 18 /* Modified (size-16) 01/01/09 a7 = x2 - x1 / 2 - 2 /* a7 should be less than 399 end if notesize = 21 a7 = x2 - x1 + 1 / 3 - 2 /* a7 should be less than 199 end if notesize = 6 a7 = x2 - x1 - 2 /* a7 should be less than 399 end if notesize = 14 or notesize = 6 or notesize = 16 or notesize = 18 /* Modified (size-16) 01/01/09 if a7 >= 399 putc Program Error examine return 10 end end if notesize = 21 if a7 >= 199 putc Program Error examine return 10 end end if notesize = 14 line2 = DISP_DISK // ":/musprint/bitmap/slurs/c/" end if notesize = 21 line2 = DISP_DISK // ":/musprint/bitmap21/slurs/c/" end if notesize = 6 line2 = DISP_DISK // ":/musprint/bitmap06/slurs/c/" end if notesize = 18 /* New (size-18) 12/18/04 line2 = DISP_DISK // ":/musprint/bitmap18/slurs/c/" end if notesize = 16 /* New (size-16) 01/01/09 line2 = DISP_DISK // ":/musprint/bitmap16/slurs/c/" end line2 = "c:\wbh\res\mus\prnt\bitmap\slurs\protopar\c\" line2 = line2 // chs(a5) // "/" // chs(a6) open [3,1] line2 loop for a8 = 1 to a7 getf [3] repeat getf [3] c1 c2 c3 c4 c5 c6 c7 .t1 line2 if a1 < 3 x1 += c2 y1 -= c3 a3 = c4 else x1 += c5 y1 += c6 a3 = c7 end close [3] x = x1 + esksp y = y1 + esksq(eskf12) else /* we don't use parametric method if a1 < 3 /* tips down c1 = y1 / eskvpar(2) if y1 > eskvpar(1) and rem = 0 y1 = (c1 - 1) * eskvpar(2) + eskvpar(1) end c1 = y2 / eskvpar(2) if y2 > eskvpar(1) and rem = 0 y2 = (c1 - 1) * eskvpar(2) + eskvpar(1) end a3 = abs(y1 - y2) /* rise y1 -= eskvpar(2) else c1 = y1 / eskvpar(2) if y1 < eskvpar(8) and rem = 0 y1 += eskvpar(1) /* OK 04-24-95 end c1 = y2 / eskvpar(2) if y2 < eskvpar(8) and rem = 0 y2 += eskvpar(1) /* OK 04-24-95 end a3 = abs(y1 - y2) /* rise y1 += eskvpar(2) end x = x1 + esksp + eskvpar(2) y = y1 + esksq(eskf12) a7 = x2 - x1 - eskvpar(1) /* length if notesize = 14 or notesize = 16 or notesize = 18 /* Modified (size-16) 01/01/09 For 14-dot slurs, the distribution of length for stock slurs is a follows Lengths Length Rise Number in dots increments increments of types (possible) ────────── ────────── ────────── ──────── 8 to 18 2 2 6 20 to 196 4 2 12 200 to 392 8 2 24 400 to 784 16 2 48 if a7 < 8 a7 = 8 end if a7 < 20 c1 = a7 / 2 if rem > 0 /* Fixing error: was if rem > 1 12/18/04 ++a7 end else if a7 < 200 c1 = a7 / 4 if rem > 1 ++x end a7 -= rem else if a7 < 400 c1 = a7 / 8 x += (rem >> 1) a7 -= rem else c1 = a7 / 16 x += (rem >> 1) a7 -= rem if rem > 11 x -= 8 a7 += 16 end if a7 >= 784 a7 = 784 end end end end For 14-dot slurs and 18-dot slurs, (Comment modified (size-18) 12/18/04) Slur number = (rise * 1200) + (length * 3) + type number number ranges from 8 to 143999 c1 = a3 / 4 a3 -= rem if a1 > 2 y += rem end a3 = a3 * 1200 + (a7 * 3) + 1 end if notesize = 21 For 21-dot slurs, the distribution of length for stock slurs is a follows Lengths Length Rise Number in dots increments increments of types (possible) ────────── ────────── ────────── ──────── 12 to 27 3 2 6 30 to 294 6 2 12 300 to 600 12 2 24 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 For 21-dot slurs, Slur number = (rise * 600) + (length * 2) + type number number ranges from 8 to 143999 c1 = a3 / 4 a3 -= rem if a1 > 2 y += rem end a3 = a3 * 600 + (a7 * 2) + 1 end if notesize = 6 For 6-dot slurs, the distribution of length for stock slurs is a follows Lengths Length Rise Number in dots increments increments of types (possible) ────────── ────────── ────────── ──────── 4 to 9 1 1 6 10 to 98 2 1 12 100 to 396 4 1 24 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 For 6-dot slurs, Slur number = (rise * 2400) + (length * 6) + type number number ranges from 8 to 143999 c1 = a3 / 2 a3 -= rem y += rem a3 = a3 * 2400 + (a7 * 6) + 1 end end x += postx y += posty a3 += addcurve /* new 6-30-93 if notesize = 14 if a3 > 120000 /* max rise = 96 goto NOSTOCK end end if notesize = 16 if a3 > 120000 /* max rise = 96 01/01/09 goto NOSTOCK end end if notesize = 18 /* New (size-18) 12/18/04 if a3 > 115200 /* max rise = 92 goto NOSTOCK end end if notesize = 21 if a3 > 70000 goto NOSTOCK end end /* large gaps should now be supported a1 = case number a3 = stock slur number x = horizontal position y = vertical position Enter new code for acquiring and printing slur perform printslur_screen (a1, a3, x, y, con3, sitflag) if a3 = 1000000 goto NOSTOCK end return end NOSTOCK: /* long slurs y1 = save_y1 /* added 01/03/05, etc. y2 = save_y2 x1 = save_x1 x2 = save_x2 if a1 < 3 /* tips down c1 = y1 / eskvpar(2) if y1 > eskvpar(1) and rem = 0 y1 = (c1 - 1) * eskvpar(2) + eskvpar(1) end c1 = y2 / eskvpar(2) if y2 > eskvpar(1) and rem = 0 y2 = (c1 - 1) * eskvpar(2) + eskvpar(1) end a3 = abs(y1 - y2) /* rise y1 -= eskvpar(2) else c1 = y1 / eskvpar(2) if y1 < eskvpar(8) and rem = 0 y1 += eskvpar(1) /* OK 04-24-95 end c1 = y2 / eskvpar(2) if y2 < eskvpar(8) and rem = 0 y2 += eskvpar(1) /* OK 04-24-95 end a3 = abs(y1 - y2) /* rise y1 += eskvpar(2) end x = x1 + esksp + eskvpar(2) + postx y = y1 + esksq(eskf12) + posty a7 = x2 - x1 - eskvpar(1) /* length perform make_longslur (a7,a3,a1) /* length,rise,smode /* return: a7 = offset, a3 = height y = y - a7 Code added 01/26/05 to implement dotted slurs in NOSTOCK situation 1) Determine a5 = maximum length of slur 2) Construct tbt = dotted mask for this slur if sitflag = 1 a5 = 0 loop for i = 1 to a3 tbt = cbi(longslur(i)) a6 = bln(tbt) if a6 > a5 a5 = a6 end repeat if a5 = 0 dputc Possible Error in constructing dotted mask a5 = 100 end a6 = a5 / gapsize if bit(0,a6) = 0 --a6 end xxxxxxxxxxx....xxxx....xxxx....xxxx....xxxx....xxxxxxxxxxx | odd number | a6 = largest odd number of intervals that will fit inside a5 a6 *= gapsize a7 = a5 - a6 a7 >>= 1 /* initial correction tbt = dup("1",a7) // dotted{1,a6} // dup("1",a7+10) /* mask end End of this 01/26/05 addition scx = x scy = y c2 = 0 loop for i = 1 to a3 Code added 01/26/05 to implement dotted slurs in NOSTOCK situation if sitflag = 1 tbt2 = cbi(longslur(i)) /* bit equivalent of longslur(i) tbt2 = bnd(tbt2,tbt) /* and this with mask tbt2 = trm(tbt2) /* and trm to length longslur(i) = cby(tbt2) /* put this back in longslur(i) end End of this 01/26/05 addition bt(i) = cbi(longslur(i)) c1 = bln(bt(i)) if c1 > c2 c2 = c1 end repeat * /* display slur contained in bt(a3) if con3 = 1 if con1 = 0 setb gstr,bt,scx,scy,a3,c2,1,3 else setb red_gstr,bt,scx,scy,a3,c2,1,1 end else if con1 = 0 clearb gstr,bt,scx,scy,a3,c2,1,3 else clearb red_gstr,bt,scx,scy,a3,c2,1,1 end end return *P 15. puttuplet Purpose: Typeset tuplet and/or bracket Inputs: x1 = horizontal starting point of tuplet/bracket x2 = horizontal stopping point of tuplet/bracket y1 = vertical starting point y2 = vertical stopping point a1 = tuplet number sitflag = situation flag bit clear bit set ─────────── ───────── bit 0 no tuplet tuplet bit 1 no bracket bracket bit 2 tips down tips up bit 5 broken bracket continuous bracket /* 03/15/97 bit 6 number outside number inside bit 7 square bracket curved bracket Calling variables to internal procedures: a1,a4,a5 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 xav = x at center of tuplet/bracket a4 = slope * 60 yav = y at center of tuplet/bracket Part I: tuplet present 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 New code (12/01/94) to deal with complex tuples 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 03/15/97 numbers below or above 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 Put out numerator of tuple t3 = t2 / 10 t2 = rem if t3 > 0 a1 = t3 + 221 scb = a1 perform charout end a1 = t2 + 221 scb = a1 perform charout Put out denominator of tuple (if present) 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 Square brackets 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 Curved brackets (slurs) /* 03/15/97 Inputs: (x1,y1) = starting note head (x2,y2) = terminating note head slur_edit_flag = flag indicating that y1 and/or y2 have been altered postx = horiz. movement of slur after it has been chosen posty = vert. movement of slur after it has been chosen addcurve = flag indicating the curvature should be added sitflag = situation flag bit clear bit set -------------- ------------- bit 0: full slur dotted slur bit 1: stock slur custom slur bit 2: first tip down first tip up (*) bit 3: second tip down second tip up (+) bit 4: compute stock slur hold stock slur (*) used on custom slurs only (+) used on stock slurs only bit 5: continuous slur broken slur /* 03/15/97 bits 8-15: size of break (0 to 255 dots, centered) 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 *P 16. bracketline Purpose: typeset bracket line Inputs: a1 = length a4 = slope a5 = slope type 0,1,2,3,4,5 x1 = x starting point y1 = y starting point Outputs: x = x coordinate of end of line y = y coordinate of end of line 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 *P 17. putwedge Purpose: Typeset wedge Inputs: x1 = horizontal starting point of wedge x2 = horizontal stopping point of wedge y1 = vertical starting point y2 = vertical stopping point c1 = starting spread of wedge c2 = stopping spread of wedge 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 *P 18. putfigcon Purpose: Typeset figure continuation line Inputs: x1 = horizontal starting point of line x2 = horizontal stopping point of line a3 = vertical level of line y1 = additional vertical displacement from default height New 11/06/03 procedure putfigcon int g x = x1 + esksp --a3 New code 11/06/03 adding figoff(.) and y1 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 *P 19. puttrans Purpose: Typeset octave transposition Inputs: x1 = horizontal starting point of transposition x2 = horizontal stopping point of transposition y1 = vertical level of transposition a1 = length of ending hook a3 = situation, 0 = 8av up, 1 = 8av down 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 *P 20. putending Purpose: Typeset ending Inputs: x1 = horizontal starting point of ending x2 = horizontal stopping point of ending y1 = vertical level of ending a1 = length of start hook a2 = length of ending hook a3 = ending number, 0 = none 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 *P 21. putdashes Purpose: Typeset dashes Inputs: x1 = horizontal starting point of dashes x2 = horizontal stopping point of dashes y1 = vertical level of dashes a1 = spacing parameter a2 = font designator 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 *P 22. puttrill Purpose: Typeset long trill Inputs: x1 = horizontal starting point of trill x2 = horizontal stopping point of trill y1 = vertical level of trill a1 = situation 1 = no trill 2 = trill with no accidental 3 = trill with sharp 4 = trill with natural 5 = trill with flat 6 = trill with sharp following New 11/05/05 7 = trill with natural following " 8 = trill with flat following " procedure puttrill int h,t1,t2,k1 /* k1 is new 11/05/05 x = x1 + esksp y = y1 + esksq(eskf12) k1 = x1 /* localize x1 /* New 11/05/05 h = k1 /* New 11/05/05 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 New code added to implement accidentals following a trill sign 11/05/05 if a1 > 5 and a1 < 9 x -= eskvpar(1) t1 = y - eskvpar(2) t2 = a1 + 185 /* music font (cue size) k1 += eskvpar(2) scx = x scy = t1 scb = t2 perform charout x += eskvpar(3) scx = x scy = y end End of 11/05/05 New Code h = k1 + eskhpar(41) /* k1 replaces x1 11/05/05 end scb = 237 loop while h < x2 perform charout h += eskhpar(40) repeat return *P 23. sysline Purpose: Typeset left-hand system line Inputs: eskf11 = number of parts esksq(1) = y coordinate of first part esksq(eskf11) = y coordinate of last part esksp = x-coordinate of beginning of line esksyscode = format for brace/bracket procedure sysline int a1,a2,a3,a4,a5,a6,a7 int a8,a9,a10,a11 /* added 03/11/06 if esksyscode = "" return end 1. typeset left-hand bar x = esksp z = 82 y1 = esksq(1) y2 = esksq(eskf11) Adding code 11/13/03 to deal with mixed staff sizes 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 04-25-95 y2 -= a5 if notesize <> a4 notesize = a4 /* return to original font size perform init_par end brkcnt = 0 if eskf11 > 1 or eskvst(1) > 0 perform putbar (eskf11) end 2. typeset braces 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) Adding code 11/13/03 to deal with mixed staff sizes a4 = notesize a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction y2 -= a5 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 11/13/03 ++a2 end repeat 3. typeset brackets 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) Adding code 11/13/03 to deal with mixed staff sizes a4 = notesize a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction y2 -= a5 Adding code 03/11/06 to fully implement the 2-font system of brackets if notesize < 10 a8 = 100 a9 = 3 a10 = 6 a11 = 96 else a8 = 201 a9 = 6 a10 = 12 a11 = 192 end a3 = y2 - y1 There are three cases: a3 <= 201 (one glyph) granularity = 6 202 <= a3 <= 402 (two glyphs) granularity = 12 403 <= a3 <= 570 (three glyphs) granularity = 12 if a3 <= 201 if a3 <= a8 /* New 03/11/06 a4 = a3 + 2 / 6 * 6 /* actual length a4 = a3 + 2 / a9 * a9 /* actual length New 03/11/06 a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 6 + 20 /* font number a5 = a4 / a9 + 20 /* font number New 03/11/06 scx = x scy = y scb = a5 scf = 320 perform charout scf = notesize else if a3 <= 402 if a3 <= (a8 * 2) /* New 03/11/06 a4 = a3 + 5 / 12 * 12 /* actual length a4 = a3 + 5 / a10 * a10 /* actual length New 03/11/06 a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 12 + 10 * 2 /* font number a5 = a4 / a10 + 10 * 2 /* font number New 03/11/06 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 a4 = a3 + 5 / a10 * a10 /* actual length New 03/11/06 a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 12 - 5 * 3 + 1 /* font number a5 = a4 / a10 - 5 * 3 + 1 /* font number New 03/11/06 a6 = a4 - 384 /* y increment to third glyph a6 = a4 - (a11 * 2) /* y increment to third glyph New 03/11/06 scx = x scy = y scb = a5 scf = 320 perform charout scy += 192 scy += a11 /* New 03/11/06 ++scb perform charout scy += a6 ++scb perform charout scf = notesize end end end if ".:,;" con esksyscode{a1} /* changed 11/13/03 ++a2 end repeat return *P 24. putbar (t1) Purpose: Typeset bar line Inputs: t1 = staff number of last line y1 = coordinate of top of line y2 = coordinate of last bar character brkcnt = number of breaks in bar barbreak(.,1) = y coordinate of top of break . barbreak(.,2) = y coordinage of bottom of break . x = x-coordinat of line z = font character 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 *P 26a. printslur_screen Purpose: read slur data from bigslur, compile and send slur to screen Input: ori case: 1,2,3 or 4 snum slur number x x location y y location mode 1 = display, 0 = clear (cancel) sitflag situation flag bit 5: continuous slur broken slur bits 8-15: size of break (0 to 255 dots, centered) procedure printslur_screen (ori,snum,x,y,mode,sitflag) str file.200,pointer.6,data.500 bstr bt.800(150) This is now global 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 /* 03/15/97 real rx * getvalue ori,snum,x,y,mode,sitflag if bit(5,sitflag) = 1 /* 03/15/97 broksize = sitflag >> 8 else broksize = 0 end sitflag &= 0x01 file = "c:\wbh\res\mus\prnt\bitmap\slurs\bigslur" if notesize = 14 file = DISP_DISK // ":/musprint/bitmap/slurs/bigslur" end if notesize = 21 file = DISP_DISK // ":/musprint/bitmap21/slurs/bigslur" end if notesize = 6 file = DISP_DISK // ":/musprint/bitmap06/slurs/bigslur" end if notesize = 18 /* Notesize 18 bigslur is new 12/18/04 file = DISP_DISK // ":/musprint/bitmap18/slurs/bigslur" end if notesize = 16 /* Notesize 16 bigslur is new 01/01/09 file = DISP_DISK // ":/musprint/bitmap16/slurs/bigslur" end putc printslur called putc file = ~file putc ori = ~ori snum = ~snum x = ~x y = ~y getc open [1,5] file i = snum * 6 + 1 len(pointer) = 6 read [1,i] pointer offset = ors(pointer{1,4}) datalen = ors(pointer{5,2}) if datalen < 4 or datalen > 500 close [1] snum = 1000000 passback snum return end len(data) = datalen if offset = 0 close [1] snum = 1000000 passback snum return end read [1,offset] data n = ors(data{1,3}) if n <> snum close [1] snum = 1000000 passback snum return end nrows = ors(data{4}) slen = ors(data{5,2}) srise = ors(data{7}) bulge = ors(data{8}) if bulge > 127 /* added 01/03/05 bulge = 0 end slen += bulge /* added 11-19-92 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 <x,y> 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 xxxxxxxxxxx....xxxx....xxxx....xxxx....xxxx....xxxxxxxxxxx | odd number | j = largest odd number of intervals that will fit inside maxn 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 /* 03/15/97 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 * *P 32. barline Purpose: Typeset bar line Inputs: eskf11 = number of parts esksq(1) = y coordinate of first part esksq(eskf11) = y coordinate of last part x = x-coordinate of line z = bar character esksyscode = format for bar govstaff = governing staff for size (length) of barline nsz(.) = notesizes for each staff in the systme Procedure rewritten 11/13/03 to deal with mixed staff sizes 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} If a4 is not determined at this point, set it to the default 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 04-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 return ************************************************** procedure esksave1 if htype = "V" structure of transp super-object: 4. situation: 0=8av up, 1=8av down 5. horiz. disp. from obj1 6. horiz. disp. from obj2 7. vert. disp. from obj1 8. length of right vertical hook 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" structure of ending super-object: 4. ending number (0 = none) 5. horiz. disp. from obj1 6. horiz. disp. from obj2 7. vert. disp. from staff lines 8. length of left vertical hook 9. length of right vertical hook 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" structure of dashes super-object: 4. horiz. disp. from obj1 5. horiz. disp. from obj2 6. vert. disp. from staff lines 7. spacing parameter 8. font designator 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" structure of trill super-object: 4. situation: 1 = no trill, only ~~~~ 2 = trill with ~~~~ 3 = tr ~~~~ with sharp above 4 = tr ~~~~ with natural above 5 = tr ~~~~ with flat above 5. horiz. disp. from object 1 6. horiz. disp. from object 2 7. vert. disp. from object 1 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" structure of wedge super-object: 4. left spread 5. right spread 6. horiz. disp. from obj1 7. beg. vert. disp. from staff 8. horiz. disp. from obj2 9. end. vert. disp. from staff 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 ╔═════════════════════════════════════════════════════════╗ ║ L O N G S L U R C O N S T R U C T I O N ║ ╚═════════════════════════════════════════════════════════╝ #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) * I. Determine scaling factor if notesize = 14 SCALE = 1.0 else SCALE = flt(notesize) / 14.0 end * II. Get rise and length limits getvalue length,rise,smode i = length - 1 X = flt(i) Y = flt(rise) X = X / SCALE /* 05-12-95 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 Beginning of slur generation ┌────────────────────────────────────────────────┐ │ P A R A M E T R I C M A G I C │ └────────────────────────────────────────────────┘ 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 compute R, P, A, B, Cx, Cy, Ca, Cb and check limitations 1. Q: if X > 300.0 Q = 15.0 else Q = 13.0 end LS_PAA: 2. R = L*L/Q/8 + Q/2 x = L * L / Q / 8.0 y = Q / 2.0 R = x + y 3. P = R - (R*R - (W*W/4))^1/2 component of height from 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 4. A = (L - W) / 2 B = H - P <A,B> = transition point A = (L - W) / 2.0 B = H - P 5. Cx = X/2 Cy = R - H <Cx,Cy> = center of main arc Cx = L / 2.0 Cy = H - R /* a negative number 6. Compute <Ca,Cb> = center of starting arc [ B*(Cx-A)/(Cy-B) + (A*A + B*B)/2/A - A ] Cb = ───────────────────────────────────────── [ B/A + (Cx-A)/(Cy-B) ] Ca = (A*A + B*B)/2/A - B*(Cb)/ A 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) normalize D-function 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 ┌────────────────────────────────────────┐ │ S W E E P L O O P 1 │ └────────────────────────────────────────┘ ║ sqt(A*A + B*B) ║ 1. compute beta = 2 * sin-1║─────────────────────║ sweep angle ║ 2*sqt(Ca*Ca + Cb*Cb)║ 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) 2. compute delta so that sweep hits every dot a = sqt(a) /* length of arc (approx) delta = beta / a / 2.0 scnt = 0 alpha = 0.0 3. begin sweep 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 ┌────────────────────────────────────────┐ │ S W E E P L O O P 2 │ └────────────────────────────────────────┘ 1. compute beta2 = sin-1{ [(L/2)-A] / R } a = L / 2.0 - A / R beta2 = ars(a) 2. compute delta so that sweep hits every dot delta2 = beta2 * 2.0 / W / 2.0 alpha = 0.0 - beta2 3. begin sweep 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 ┌────────────────────────────────────────┐ │ S W E E P L O O P 3 │ └────────────────────────────────────────┘ 1. beta and delta already computed alpha = beta 2. begin sweep 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 ┌──────────────────────────────────────────────────────────────┐ │ E N D O F S W E E P S. C O N S T R U C T S L U R │ └──────────────────────────────────────────────────────────────┘ 1. rotate data to produce rise 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 2. setup thickness parameters pc = length * 60 / (length + 400) /* carefully worked out formula 05/13/95 pd = pc * 3 / 10 pe = scnt - pc pf = scnt - pd if notesize = 21 /* disable this feature for notesize = 21 12/03/08 pc = 1 pe = scnt end pg = 50 * scnt / 100 if length < 400 ph = 0 else ph = (length - 400) * scnt * 4 / 40000 end 3. compute ind, outd loop for i = 1 to scnt if i < pc /* left hand side of slur ind = 0.6 if notesize = 21 ind = 1.3 end if i < pd /* extreme left end if notesize = 16 /* New size-16 12/31/08 outd = .4 * flt(i) / flt(pc) else outd = flt(i) / flt(pc) + .1 end else outd = 0.4 end if notesize = 14 outd += .4 end if notesize = 18 /* New size-18 12/18/04 outd += .3 end if notesize = 18 /* New size-18 12/18/04 outd += .3 end if notesize = 21 outd += .3 end goto LS_PCD end if i > pe /* right hand side of slur ind = 0.6 if i >= pf /* extreme right end j = scnt - i if notesize = 16 /* New size-16 12/31/08 outd = 0.4 * flt(j) / fl(pc) else outd = flt(j) / flt(pc) + .1 end else outd = 0.4 end if notesize = 14 outd += .4 end if notesize = 16 /* New size-16 01/01/09 outd += .3 end if notesize = 18 /* New size-18 12/18/04 outd += .3 end goto LS_PCD end /* middle of slur if i > pg + ph /* right side j = pe - i s = pe - pg - ph else /* left side if i < pg - ph j = i - pc s = pg - pc - ph else s = 10000 j = 9999 end end b = flt(j) * ars(1.0) / flt(s) /* max(b) = sin-1(1) a = sin(b) if notesize = 14 outd = D - .8 * a + .8 ind = D - .6 * a + .6 end New 01/01/09 parameters for notesize 16 (based on create16.z) if notesize = 16 outd = D - 0.1 * a + 0.4 ind = D - 0.6 * a + 0.6 outd += .29000 ind += .29000 end New 12/18/04 parameters for notesize 18 (based on create18.z) if notesize = 18 outd = D - 0.7 * a + 0.7 ind = D - 0.6 * a + 0.6 outd += .69000 ind += .79000 end 01/26/06 parameters added for notesize 6 if notesize = 6 outd = D - 0.8 * a + 0.8 ind = D - 0.6 * a + 0.6 outd += .39000 ind += .49000 end 12/03/08 parameters changed for notesize 21 if notesize = 21 outd = D - 0.6 * a + 0.6 ind = D - 1.0 * a + 1.0 outd += .29000 ind += .89000 end 4. compute outside point, inside point LS_PCD: x = sx(i) y = sy(i) give finite width to slur 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) 5. compute box coordinates 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 For notesize = 21, it appears that scaling here is better if notesize = 21 inpx = inpx * SCALE outpx = outpx * SCALE inpy = inpy * SCALE outpy = outpy * SCALE end x1 = fix(inpx) x2 = fix(outpx) y1 = fix(inpy) y2 = fix(outpy) if x2 - x1 < 2 ++y2 /* radical end 6. set points inside box to 1 (with inverted vertical axis) Here is where you scale the slur back to its original size if notesize <> 21 x1 = x1 * notesize / 14 x2 = x2 * notesize + 7 / 14 y1 = y1 * notesize / 14 y2 = y2 * notesize + 7 / 14 end if y2 > 249 y2 = 249 end loop for j = y1 to y2 q = 250 - j loop for k = x1 to x2 map(q){k} = "x" repeat repeat repeat End of slur generation /* determine size of map display loop for i = 1 to 250 map(i) = trm(map(i)) if map(i) <> "" goto LS_CE end repeat LS_CE: y1 = i loop for j = i to 249 map(j+1) = trm(map(j+1)) if map(j) = "" and map(j+1) = "" goto LS_CF end repeat LS_CF: y2 = j - 1 loop for j = 1 to MAPZ loop for i = y1 to y2 if map(i){j} = "x" goto LS_CH end repeat repeat LS_CH: x1 = j x2 = 0 loop for i = y1 to y2 if x2 < len(map(i)) x2 = len(map(i)) end repeat /* write slur to longslur(.) x2 = x2 - x1 /* x range j = 0 if smode < 3 loop for i = y1 to y2 map(i) = map(i) // pad(MAPZ) out = map(i){x1,x2} if smode = 2 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat else loop for i = y2 to y1 step -1 map(i) = map(i) // pad(MAPZ) out = map(i){x1,x2} if smode = 3 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat end if smode = 1 length = j - 1 else if smode = 2 length = j - 1 - rise else if smode = 3 length = rise else length = 0 end end end rise = j passback length,rise /* length = initial offset; rise = number of rows return ╔═════════════════════════════════════════════╗ ║ ║ ║ PROCEDURES ADDED FOR SCREEN DISPLAY ║ ║ ║ ╚═════════════════════════════════════════════╝ * procedure stringout (out) str out.500 int font,i,k,fontoff getvalue out font = revmap(scf) fontoff = font - 1 * 256 if con3 = 1 if con2 > 0 and con2 <> 5 if conx1 > scx - 10 conx1 = scx - 10 end if cony1 > scy - hght(font) cony1 = scy - hght(font) end if cony2 < scy + dpth(font) cony2 = scy + dpth(font) end end if con1 = 0 loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff setb gstr,FA,scx,scy,k,1 end repeat else loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff setb red_gstr,FA,scx,scy,k,1 end repeat end if con2 > 0 and conx2 < scx + 10 conx2 = scx + 10 end else if con1 = 0 loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff clearb gstr,FA,scx,scy,k,1 end repeat else loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += fontoff clearb red_gstr,FA,scx,scy,k,1 end repeat end end return procedure charout int font,k,i,j font = revmap(scf) k = font - 1 * 256 + scb putc k = ~k font = ~font /* DEBUG if con3 = 1 if con2 > 0 and con2 <> 5 if conx1 > scx - 10 conx1 = scx - 10 end if cony1 > scy - hght(font) cony1 = scy - hght(font) end if cony2 < scy + dpth(font) cony2 = scy + dpth(font) end end if con1 = 0 setb gstr,FA,scx,scy,k,1 else setb red_gstr,FA,scx,scy,k,1 end if con2 > 0 and conx2 < scx + 40 conx2 = scx + 40 end else if con1 = 0 clearb gstr,FA,scx,scy,k,1 else clearb red_gstr,FA,scx,scy,k,1 end end return procedure pan (flag) str lflag.1 /* New 12/18/05 int k,h,j int x(4),y(4) int flag int sflag,oldsflag int wflag2,wflag3,wflag4 int px,py int t1,t2 int font,color,scflag int tsavensz int v1,v2,v3,v4,v5,v6,v7,v8,v9,v10 int v3a(10) flag = 0 x(1) = 20 y(1) = 240 x(2) = 10 y(2) = 160 x(3) = 20 y(3) = 160 x(4) = 20 y(4) = 160 wflag2 = 0 wflag3 = 0 wflag4 = 0 sflag = 1 oldsflag = 1 trecord_cnt = 0 treset [X2] activate red_gstr,px,py,14 PPP: if oldsflag > 0 px = x(oldsflag) py = y(oldsflag) end if oldsflag <> sflag if oldsflag = 1 activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 else if oldsflag = 2 activate tstr2,px,py,5 activate tstr2,px,py,0 activate blue_horiz2t,px-10-LMRG2,py-TMRG2,5 activate blue_horiz2b,px-10-LMRG2,py+1650-TMRG2,5 activate blue_vert2v,px-LMRG2,py-80-TMRG2,5 activate blue_vert2r,px+159-LMRG2,py-80-TMRG2,5 activate red_tstr2,px,py,5 activate red_tstr2,px,py,0 else if oldsflag = 3 activate tstr3,px,py,5 activate tstr3,px,py,0 activate blue_horiz3t,px-10-LMRG3,py-TMRG3,5 activate blue_horiz3b,px-10-LMRG3,py+1100-TMRG3,5 activate blue_vert3v,px-LMRG3,py-80-TMRG3,5 activate blue_vert3r,px+106-LMRG3,py-80-TMRG3,5 activate red_tstr3,px,py,5 activate red_tstr3,px,py,0 else activate tstr4,px,py,5 activate tstr4,px,py,0 activate blue_horiz4t,px-10-LMRG4,py-TMRG4,5 activate blue_horiz4b,px-10-LMRG4,py+825-TMRG4,5 activate blue_vert4v,px-LMRG4,py-80-TMRG4,5 activate blue_vert4r,px+79-LMRG4,py-80-TMRG4,5 activate red_tstr4,px,py,5 activate red_tstr4,px,py,0 end end end end px = x(sflag) py = y(sflag) if sflag = 1 activate gstr,px,py,1 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,3 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,3 activate blue_vert1v,px-LMRG1,py-80-TMRG1,3 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,3 if oldsflag <> sflag activate red_gstr,px,py,4 else if trecord_cnt > 0 activate red_gstr,px,py,4 else activate red_gstr,px,py,14 end end else if sflag = 2 activate tstr2,px,py,1 activate blue_horiz2t,px-10-LMRG2,py-TMRG2,3 activate blue_horiz2b,px-10-LMRG2,py+1650-TMRG2,3 activate blue_vert2v,px-LMRG2,py-80-TMRG2,3 activate blue_vert2r,px+159-LMRG2,py-80-TMRG2,3 if trecord_cnt > 0 activate red_tstr2,px,py,4 end else if sflag = 3 activate tstr3,px,py,1 activate blue_horiz3t,px-10-LMRG3,py-TMRG3,3 activate blue_horiz3b,px-10-LMRG3,py+1100-TMRG3,3 activate blue_vert3v,px-LMRG3,py-80-TMRG3,3 activate blue_vert3r,px+106-LMRG3,py-80-TMRG3,3 if trecord_cnt > 0 activate red_tstr3,px,py,4 end else activate tstr4,px,py,1 activate blue_horiz4t,px-10-LMRG4,py-TMRG4,3 activate blue_horiz4b,px-10-LMRG4,py+825-TMRG4,3 activate blue_vert4v,px-LMRG4,py-80-TMRG4,3 activate blue_vert4r,px+79-LMRG4,py-80-TMRG4,3 if trecord_cnt > 0 activate red_tstr4,px,py,4 end end end end activate msgstr,0,MSGVLOC,1 activate redmsgstr,0,MSGVLOC,4 PPQ: if sflag = 1 x2cur = 8 * px + xcur y2cur = py + ycur else if sflag = 2 x2cur = 8 * px + (xcur / 2) y2cur = py + (ycur / 2) else if sflag = 3 x2cur = 8 * px + (xcur / 3) y2cur = py + (ycur / 3) else x2cur = 8 * px + (xcur / 4) y2cur = py + (ycur / 4) end end end if x2cur < LMARG h = LMARG - x2cur + 7 / 8 + 9 / 10 * 10 x(sflag) += h goto PPP end if x2cur > RMARG h = x2cur - RMARG + 7 / 8 + 9 / 10 * 10 x(sflag) -= h goto PPP end if y2cur < TMARG h = TMARG - y2cur + 79 / 80 * 80 y(sflag) += h goto PPP end if y2cur > BMARG h = y2cur - BMARG + 79 / 80 * 80 y(sflag) -= h goto PPP end clearb curstr, CURSOR, acur, bcur, 1, 1 x2cur -= 30 y2cur -= 10 x2cur = x2cur / 8 acur = rem bcur = 0 setb curstr, CURSOR, acur, bcur, 1, 1 activate curstr, x2cur, y2cur, 3 Display current line 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 Display current definition new_def = "" if current_line{1} = "K" new_def = sub_def(g) // " sub-object" end if current_line{1} = "J" if "BCKTDSNRGQFIM" con jtype if "BCKTDSNRGQFIMr" con jtype /* New 10/15/07 if mpt = 14 /* New 10/15/07 mpt = 8 end new_def = obj_def(mpt) // " object" end end if current_line{1} = "H" mpt = 1 line = txt(temp,[' ']) line = txt(temp,[' ']) if "BTSXWDERVFN" con line{1} new_def = super_def(mpt) // " super-object" end end if current_line{1} = "W" new_def = "Word(s) sub-object" end if current_line{1} = "T" new_def = "Text sub-object" end if current_line{1} = "L" or current_line{1} = "l" new_def = "Lines (musical staff) " new_def = new_def // "Special commands: <shft> arrow up/down moves text lines or figures up or down" end if current_line{1} = "S" new_def = "System of staff lines" end if current_line{1} = "X" new_def = "General text record" end font = MSGFONT color = 4 scflag = 0 scx = MSGTAB5A scy = MSGROW2 perform msgout (current_def,font,color,scflag) scflag = 1 scx = MSGTAB5A scy = MSGROW2 perform msgout (new_def,font,color,scflag) if notesize <> tsavensz notesize = tsavensz perform init_par end current_def = new_def NOOP: perform pgetk (k) if k <> oldk or k <> 0x030120 ptoggle = 0 else ptoggle = 1 - ptoggle end oldk = k oldsflag = sflag NEWK: if k = 0x03040a /* <Backspace> 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 /* <Tab> 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 /* <Enter> 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 /* <esc> putc .b27 Y.b27 F... return 1 end ReDraw Command if k = 0x010052 or k = 0x010072 /* r or R = redraw activate gstr,0,0,0 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct activate gstr,0,0,-1 goto PPP end Cancel Command 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 Here is where you cancel all changes CC3: a = list_order(h,4) if a <> 0 list_order(h,4) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto CC3 end setup red_gstr,300,3100,1 if wflag4 <> 0 setup red_tstr4,160,910,1 setup red_tstr2,160,1600,1 else if wflag2 <> 0 setup red_tstr2,160,1600,1 end end if wflag3 <> 0 setup red_tstr3,160,1040,1 end activate red_gstr,px,py,3 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 treset [X2] trecord_cnt = 0 con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct activate gstr,0,0,-1 goto PPP end Save Command 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 Here is where you turn off the things that have been moved con1 = 0 /* construct on black con2 = 5 con3 = 0 /* use clearb con4 = 0 perform construct Here is where you re-display the things that are moved con1 = 0 /* construct on black con2 = 3 /* selective construction, with staff lines con3 = 1 /* use setb perform construct activate gstr,0,0,-1 Here is where you copy modified records back to the main table h = hh SS3: a = list_order(h,4) if a <> 0 tget [X2,a] line line = trm(line) tput [X,h] ~line list_order(h,4) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto SS3 end setup red_gstr,300,3100,1 if wflag4 <> 0 setup red_tstr4,160,910,1 setup red_tstr2,160,1600,1 else if wflag2 <> 0 setup red_tstr2,160,1600,1 end end if wflag3 <> 0 setup red_tstr3,160,1040,1 end activate red_gstr,px,py,3 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 treset [X2] trecord_cnt = 0 goto PPP end Editing commands 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 Flag all members of "group" for purposes of turning off glyphs g = pointers(obcursor,5) 12/17/03 Get the larr index that helped generate the obx for this object larrx = pointers(g,10) if larrx = 0 dputc Program Warning: No larr index for this object end 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 12/17/03 Compare larrx for each member of group; hope they are all the same 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 Flag all super-objects 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 Flag all associated sub-object 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 Here is where you turn off the things that will be moved con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct Now look at group again; adjust position of members of "group" 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 Increase (decrease) the x-coordinate of this object 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 12/17/03 larrx = 0 end else c -= incre if larrx > 0 cum_larr(larrx,1) -= incre /* added 12/17/03 larrx = 0 end end line = line{1,9} // chs(b) // " " // chs(c) // line2{sub..} tput [X2,a] ~line If this is a bar line, adjust the appropriate bar record (added 12/06/03) 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 Incremented backward (forward) all associated text records GRP2: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte goto GRP2 end if pointers(h+1,9) = pointers(h,9) ++h goto GRP1 end g = h h = pointers(g,6) if h > g goto GRP1 end Here is where you re-display the things that are moved con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 1 /* use setb perform construct activate red_gstr,0,0,-1 if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,5 activate red_tstr2,px,py,3 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,5 activate red_tstr3,px,py,3 end end if wflag4 = 1 conx1 >>= 1 cony1 >>= 1 conx2 >>= 1 cony2 >>= 1 dscale2 red_tstr2, red_tstr4, conx1, cony1, conx2, cony2 if sflag = 4 activate red_tstr4,px,py,5 activate red_tstr4,px,py,3 end end goto PPQ end End of "group" movement if cmode = "j" goto JAC0 end if cmode = "x" tget [X,X_point] line if line{1} = "J" goto JAC00 end if "X" con line{1} con4 = X_point /* pointer to system record for this system list_order(X_point,3) = -1 list_order(X_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end sub = 3 b = int(line{sub..}) c = int(line{sub..}) d = int(line{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 or k = 0x030117 c += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 or k = 0x030115 c -= incre else if k = 0x03010e or k = 0x030119 or k = 0x03011b or k = 0x030116 d -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c or k = 0x030118 d += incre end end end end tput [X2,a] X ~b ~c ~d ~line{sub..} con2 = 1 /* selective construction goto REDIS end End of "X" movement in mode "x" if "KWTk" con line{1} d = mpt h = X_point KAC1: /* attempt to set obcursor correctly g = list_order(h,1) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "J" goto KAC1 end b = int(line{3..}) con4 = pointers(b,8) /* pointer to system record for this system if d = 2 a = pointers(b,7) c = list_order(a,4) if c = 0 tget [X,a] .t3 c textoff else tget [X2,c] .t3 c textoff end end list_order(h,3) = -1 list_order(h,5) = -1 list_order(X_point,3) = -1 list_order(X_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 2 /* selective construction, no super-objects con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line .t3 line2 a = trecord_cnt else tget [X2,a] line .t3 line2 end sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 or k = 0x030117 b += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 or k = 0x030115 b -= incre else if d = 3 and c < 11 c = c - 1 * eskvpar(41) + textoff + 1000 end if k = 0x03010e or k = 0x030119 or k = 0x03011b or k = 0x030116 c -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c or k = 0x030118 c += incre end end end end line = line{1,2} // chs(b) // " " // chs(c) // line2{sub..} tput [X2,a] ~line con2 = 2 /* selective construction, omit super-objects goto REDIS end End of sub-object movement in mode "x" if line{1} = "L" or line{1} = "l" lflag = line{1} h = X_point b = 0 LAC1: /* mark all elements on line g = list_order(h,2) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if b = 0 and line{1} = "J" b = int(line{3..}) con4 = pointers(b,8) /* pointer to system record for this system end list_order(h,3) = -1 list_order(h,5) = -1 if line{1} <> "E" goto LAC1 end Flag barline records for this system 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 Turn off all red on this line con1 = 1 /* construct on red_gstr con2 = 3 /* selective construction, including redrawn staff line con3 = 0 /* use clearb sysflag = 0 perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end line = line // " " Field 2: y off-set in system b = int(line{3..}) Field 3: text off-set(s) from line (separated by |) Field 4: eskdyoff(s) separated by | Field 5: eskuxstart(s) separated by | Field 6: eskbackloc(s) spearated by | 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) 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) 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 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 /* <shft> ↑ if v3a(1) = 0 --v10 else loop for e = 1 to v3 v3a(e) -= 1 repeat end end if k = 0x030108 /* <shft> ↓ if v3a(1) = 0 ++v10 else loop for e = 1 to v3 v3a(e) += 1 repeat end end if k = 0x030107 /* <shft> ─► ++v10 end if k = 0x030105 /* <shft> ◄─ --v10 end end end end line = "" loop for e = 1 to v3 - 1 line = line // chs(v3a(e)) // "|" repeat line = line // chs(v3a(v3)) tput [X2,a] ~lflag ~b ~line ~tline ~d ~v9 ~v10 con2 = 3 /* selective construction; including redrawn staff line sysflag = 0 goto REDIS end End of staff line movement in mode "x" 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: Turn off all red and all black on this system if list_order(X_point,4) = 0 con1 = 0 /* erasing black system con2 = 0 /* redraw entire system con3 = 0 /* use clearb perform construct activate gstr,0,0,-1 if wflag2 = 1 dscale2 gstr, tstr2 if sflag = 2 activate tstr2,px,py,1 end end if wflag3 = 1 dscale3 gstr, tstr3 if sflag = 3 activate tstr3,px,py,1 end end if wflag4 = 1 dscale2 tstr2, tstr4 if sflag = 4 activate tstr4,px,py,1 end end end con1 = 1 /* construct on red_gstr con2 = 4 /* redraw entire system; use updated records con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end lpt = 5 tline = txt(line,[' '],lpt) esksp = int(tline) tline = txt(line,[' '],lpt) esksysy = int(tline) tline = txt(line,[' '],lpt) esksyslen = int(tline) tline = txt(line,[' '],lpt) esksysh = int(tline) tline = txt(line,[' '],lpt) eskf11 = int(tline) tline = txt(line,[' '],lpt) tline = tline // pad(2) esksyscode = tline{2..} if esksyscode con quote esksyscode = esksyscode{1,mpt-1} end if k >= 0x030115 and k <= 0x030118 if k = 0x030116 esksysy -= eskvpar(2) end if k = 0x030118 esksysy += eskvpar(2) end else if k = 0x03010f or k = 0x030112 or k = 0x030114 esksysh += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 esksysh -= incre else if k = 0x03010e or k = 0x030119 or k = 0x03011b esksysy -= incre else if k = 0x030110 or k = 0x03011a or k = 0x03011c esksysy += incre end end end end end tput [X2,a] S 0 ~esksp ~esksysy ~esksyslen ~esksysh ~eskf11 "~esksyscode " con2 = 4 /* redraw entire system; use updated records goto REDIS end End of system movement in mode "x" if line{1} = "H" SX_point = X_point goto HAC1000 end End of super-object movement in mode "x" goto PPQ end if cmode = "h" SX_point = super_pointers(supercursor,1) goto HAC1000 end SUPER-OBJECT MOVEMENT 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) All objects associated with this super-object, which have previously been moved (and are now drawn in red, must be identified. 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 If this super-object is a tuple and the tuple is associated with a beam, then the beam must be flagged, or else the tuple will not turn off. 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) get stem direction (a2 = beam super number) and flag beam hh = SX_point HAC101: 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 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 End of code which flags the beam assocated with a tuplet list_order(SX_point,3) = -1 list_order(SX_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 a = list_order(SX_point,4) /* better get line again! if a = 0 tget [X,SX_point] line else tget [X2,a] line end lpt = 8 tline = txt(line,[' '],lpt) supernum = int(tline) /* supernum htype = txt(line,[' '],lpt) Ties 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 Beams 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 Slurs 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 sitflag &= 0xfe else /* → increase addcurve ++addcurve 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 Figure continuation lines if htype = "F" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) Adding code 11/06/03 to look for optional additional vert. disp. 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 Tuplets 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 get stem direction (a2 = beam super number) and flag beam hh = SX_point HAC100: 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 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 Transpositions 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 Endings 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 Dashes associated with text or directives (dynamics, tempo, etc) 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 Wavey line trills ~~~~~~ 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 Wedges 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 END OF SUPER-OBJECT MOVEMENT Object Movement 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 Code added 12/06/03 if line{8} = "B" /* do nothing, please goto NOOP end list_order(g,3) = -1 list_order(g,5) = -1 Flag all super-objects 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 Flag all associated sub-objects 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 Here is where you turn off the things that will be moved con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct activate red_gstr,0,0,-1 Now look at object again; adjust position of object 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 Increase (decrease, raise, lower) the x-coordinate of this object 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 Incremented backward (forward) all associated text records 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 Backup (advance) x-coordinate of text sub-object 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 End of "object" movement REDIS: Here is where you re-display the things that are moved con1 = 1 /* construct on red_gstr /* con2 = 1 or 2 or 3 or 4. This has been set earlier con3 = 1 /* use setb perform construct activate red_gstr,0,0,-1 if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,5 activate red_tstr2,px,py,3 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,5 activate red_tstr3,px,py,3 end end if wflag4 = 1 conx1 >>= 1 cony1 >>= 1 conx2 >>= 1 cony2 >>= 1 dscale2 red_tstr2, red_tstr4, conx1, cony1, conx2, cony2 if sflag = 4 activate red_tstr4,px,py,5 activate red_tstr4,px,py,3 end end goto PPQ end if k = 0x03010b /* ctrl → if x(sflag) < 40 x(sflag) += 10 end end if k = 0x030109 /* ctrl ← if x(sflag) > xze - 340 x(sflag) -= 10 end end if k = 0x03010a /* ctrl ↑ if y(sflag) > yze - 3500 y(sflag) -= 80 end end if k = 0x03010c /* ctrl ↓ if y(sflag) < 320 y(sflag) += 80 end end if k = 0x010067 /* g newcmode = "g" perform change_cmode end if k = 0x010066 /* f newcmode = "j" perform change_cmode end if k = 0x01006a /* j newcmode = "j" perform change_cmode end if k = 0x010068 /* h newcmode = "h" perform change_cmode a = pointers(obcursor,1) loop while list_order(a,1) <> TOP_FLAG a = list_order(a,1) tget [X,a] tbyte repeat while tbyte <> "H" if tbyte <> "H" loop while list_order(a,2) <> BOTTOM_FLAG a = list_order(a,2) tget [X,a] tbyte repeat while tbyte <> "H" end if tbyte = "H" tget [X,a] .t3 supercursor .t8 line Set cursor at new location 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 Get object with smallest x position loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end end if k = 0x010078 /* x newcmode = "x" perform change_cmode end if k >= 0x030101 and k <= 0x030104 if k = 0x030101 /* ← if cmode = "g" h = pointers(obcursor,4) if h > 0 and h <= object_count obcursor = h goto SETCUR end end if cmode = "j" if obcursor > 1 --obcursor goto SETCUR end end if cmode = "x" BWXP: if list_order(X_point,1) = TOP_FLAG /* top of list goto PPQ else X_point = list_order(X_point,1) end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) tget [X,X_point] .t3 t1 t2 xcur += t1 ycur += t2 goto PPQ end if "H" = rectype tget [X,X_point] .t3 supercursor .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 Get object with smallest x position loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end if rectype = "L" or rectype = "l" h = X_point loop g = list_order(h,2) tget [X,g] line .t3 a if line{1} = "J" c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 b xcur ycur tget [X,c] .t3 c ycur += c end h = g repeat while "JE" not_con line{1} goto PPQ end if "SX" con rectype tget [X,X_point] .t3 g xcur ycur goto PPQ end if "AEB" con rectype goto BWXP end end if cmode = "h" if supercursor <= 1 goto PPQ end --supercursor a1 = super_pointers(supercursor,1) tget [X,a1] .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 Get object with smallest x position loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 obcursor .t8 jtype .t10 c d oby perform setcurloc (obcursor,X_point) /* return new X_point if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end end if k = 0x030102 /* ↑ if "gj" con cmode obcursor = pointers(obcursor,5) goto SETCUR end if cmode = "x" UPXP: if list_order(X_point,1) = TOP_FLAG /* top of list goto PPQ end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) if obcursor > 1 --obcursor end goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) rectype = "J" goto PPQ end if "AEB" con rectype X_point = list_order(X_point,1) goto UPXP end if "HLlSX" con rectype X_point = list_order(X_point,1) goto UPXP end end end if k = 0x030103 /* → if cmode = "g" h = pointers(obcursor,3) if h > 0 and h <= object_count obcursor = h goto SETCUR end end if cmode = "j" if obcursor < object_count ++obcursor goto SETCUR end end if cmode = "x" FWXP: if list_order(X_point,2) = BOTTOM_FLAG goto PPQ end X_point = list_order(X_point,2) tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) tget [X,X_point] .t3 t1 t2 xcur += t1 ycur += t2 goto PPQ end if "H" = rectype tget [X,X_point] .t3 supercursor .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 Get object with smallest x position loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end if rectype = "L" or rectype = "l" h = X_point loop g = list_order(h,2) tget [X,g] line .t3 a if line{1} = "J" c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 b xcur ycur tget [X,c] .t3 c ycur += c end h = g repeat while "JE" not_con line{1} goto PPQ end if "SX" con rectype tget [X,X_point] .t3 g xcur ycur goto PPQ end if "AEB" con rectype goto FWXP end end if cmode = "h" if supercursor = super_count or supercursor = 0 goto PPQ end ++supercursor a1 = super_pointers(supercursor,1) tget [X,a1] .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 Get object with smallest x position loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 obcursor .t8 jtype .t10 c d oby perform setcurloc (obcursor,X_point) /* return new X_point if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += eskhpar(3) end end goto PPQ end end if k = 0x030104 /* ↓ if "gj" con cmode obcursor = pointers(obcursor,6) goto SETCUR end if cmode = "x" DOWNXP: if list_order(X_point,2) = BOTTOM_FLAG goto PPQ end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) if obcursor < object_count ++obcursor end goto SETCUR end if "WTKk" con rectype perform getobposition (X_point,obcursor) if obcursor < object_count ++obcursor end rectype = "J" goto SETCUR end if "AEB" con rectype X_point = list_order(X_point,2) goto DOWNXP end if "HLlSX" con rectype X_point = list_order(X_point,2) goto DOWNXP end end end SETCUR: perform setcurloc (obcursor,X_point) /* return new X_point goto PPQ end if k = 0x030120 or k = 0x030121 if k = 0x030120 /* page up a = X_point get an original index loop while a > table_size and list_order(a,1) <> TOP_FLAG a = list_order(a,1) repeat get first system index which is smaller that this index b = system_rec(1) if a <= table_size loop for i = system_cnt to 1 step -1 if system_rec(i) < a b = system_rec(i) i = 1 end repeat end if b = system_rec(1) ptoggle = 0 end if ptoggle = 0 if cmode = "h" if supercursor = 0 goto PPQ end loop tget [X,b] tbyte .t3 a if tbyte = "H" if a = 1 a = 2 end supercursor = a k = 0x030101 /* ← goto NEWK end b = list_order(b,2) repeat while b <> BOTTOM_FLAG else if cmode = "x" if b = system_rec(1) loop b = list_order(b,2) tget [X,b] tbyte repeat while tbyte <> "J" if list_order(b,2) <> BOTTOM_FLAG b = list_order(b,2) end end X_point = b k = 0x030101 /* ← goto NEWK else loop tget [X,b] tbyte .t3 a if tbyte = "J" obcursor = a X_point = b k = 0x030101 /* ← goto NEWK end b = list_order(b,2) repeat while b <> BOTTOM_FLAG end end else if cmode = "h" if supercursor = 0 goto PPQ end loop tget [X,b] tbyte .t3 a if tbyte = "H" if a = super_count a = super_count - 1 end supercursor = a k = 0x030103 /* → goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG else if cmode = "x" c = b if c >= table_size loop c = list_order(c,1) tget [X,c] tbyte repeat while "KJWTH" not_con tbyte c = list_order(c,1) end X_point = c k = 0x030103 /* → goto NEWK else loop tget [X,b] tbyte .t3 a if tbyte = "J" obcursor = a X_point = b k = 0x030103 /* → goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG end end end goto PPQ end if k = 0x030121 /* page down a = X_point get an original index loop while a > table_size and list_order(a,1) <> TOP_FLAG a = list_order(a,1) repeat set c = bottom of page c = table_size loop while list_order(c,2) <> BOTTOM_FLAG c = list_order(c,2) repeat 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 setcurloc Input: a = index in pointers array for a particular object Output: b = address in table for this object Other outputs: xcur = x coordinate of cursor ycur = y coordinate of cursor grand_space = distance between grand staff lines procedure setcurloc (a,b) str line.100,jtype.1 int a,b,c,d,g int x,y int dummy getvalue a if a = 0 return end b = pointers(a,1) /* object c = pointers(a,7) /* line d = pointers(a,8) /* system if d = 0 return 2 end tget [X,d] .t3 g xcur ycur tget [X,c] .t3 y .t3 line line = trm(line) line = rev(line) if line con " " line = line{1,mpt-1} line = rev(line) grand_space = int(line) end ycur += y tget [X,b] .t8 jtype g x y if jtype = "F" y += figoff(eskf12) end if jtype = "B" y = 0 end if y > 800 y = y - 1000 + grand_space end passback b xcur += x ycur += y return procedure msgout (out,fnum,color,scflag) str out.180 int font,i,k,fnum,color,scflag,plane getvalue out,fnum,color,scflag plane = 1 font = revmap(fnum) font = font - 1 * 256 if color = 1 if scflag = 1 loop for i = 1 to len(out) k = ors(out{i}) + font setb msgstr,FA,scx,scy,k,plane repeat else loop for i = 1 to len(out) k = ors(out{i}) + font clearb msgstr,FA,scx,scy,k,plane repeat end activate msgstr,0,0,-1 else if scflag = 1 loop for i = 1 to len(out) k = ors(out{i}) + font setb redmsgstr,FA,scx,scy,k,plane repeat else loop for i = 1 to len(out) k = ors(out{i}) + font clearb redmsgstr,FA,scx,scy,k,plane repeat end activate redmsgstr,0,0,-1 end return procedure setupmsg int a,b,c,d,e,font,color,scflag int tsavensz str out.80 tsavensz = notesize notesize = MSGFONTZ if notesize <> tsavensz perform init_par end font = MSGFONT color = 1 scflag = 1 scx = MSGTAB1 scy = MSGROW1 out = messages(1) perform msgout (out,font,color,scflag) scx = MSGTAB2 scy = MSGROW1 out = messages(2) perform msgout (out,font,color,scflag) scx = MSGTAB3 scy = MSGROW1 out = messages(3) perform msgout (out,font,color,scflag) scx = MSGTAB4 scy = MSGROW1 out = messages(4) perform msgout (out,font,color,scflag) scx = MSGTAB1 scy = MSGROW1 out = messages(1) color = 4 perform msgout (out,font,color,scflag) cmode = "g" color = 1 scx = MSGTAB5 scy = MSGROW2 out = messages(5) perform msgout (out,font,color,scflag) #if MSGLINOPT scx = MSGTAB6 scy = MSGROW2 out = messages(6) perform msgout (out,font,color,scflag) #endif if notesize <> tsavensz notesize = tsavensz perform init_par end return procedure change_cmode int a,b,c,d,e,font,color,scflag int tsavensz str out.80 tsavensz = notesize notesize = MSGFONTZ if notesize <> tsavensz perform init_par end font = MSGFONT color = 3 scflag = 0 if cmode = "g" out = messages(1) scx = MSGTAB1 scy = message_row(1) else if cmode = "j" out = messages(2) scx = MSGTAB2 scy = message_row(2) else if cmode = "h" out = messages(3) scx = MSGTAB3 scy = message_row(3) else if cmode = "x" out = messages(4) scx = MSGTAB4 scy = message_row(4) end end end end perform msgout (out,font,color,scflag) scflag = 1 if newcmode = "g" out = messages(1) scx = MSGTAB1 scy = message_row(1) else if newcmode = "j" out = messages(2) scx = MSGTAB2 scy = message_row(2) else if newcmode = "h" out = messages(3) scx = MSGTAB3 scy = message_row(3) else if newcmode = "x" out = messages(4) scx = MSGTAB4 scy = message_row(4) end end end end perform msgout (out,font,color,scflag) if notesize <> tsavensz notesize = tsavensz perform init_par end cmode = newcmode return getobposition Input: a = address in table of a particular sub-object (or word, or text item) Output: b = index in pointers array for object associated with this sub-object Other outputs: xcur = x coordinate of cursor for object ycur = y coordinate of cursor for object grand_space = distance between grand staff lines 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 Procedure construct Purpose: construct or erase sections of music Inputs: con1 = black/red flag 0 = construct on gstr 1 = construct on red_gstr con2 = full/partial 0 = make a full construction using X table records 1 = use only records with list_order(.,3) <> 0 2 = same as 1, but omit all references to super-objects 3 = same as 1, but also redraw staff lines 4 = full construction; make use of updated records 5 = save as 3, but use original X table records con3 = turn on/off 1 = use setb 0 = use clearb con4 = starting point 0 = start at top; use entire file >0 = start at record con4; stop before next "S" record Outputs: conx1 = \ cony1 = \ ROW and COLUMN boundaries to box where conx2 = / reconstruction took place. These outputs cony2 = / are valid only when con2 > 0 and con3 = 1. procedure construct label LTY(16) if con2 > 0 and con3 = 1 conx1 = 100000 cony1 = 100000 conx2 = 0 cony2 = 0 end loop for k = 1 to SUPERMAX esksupermap(k) = 0 repeat sysnum = 0 if con4 > 0 eskrec = con4 else eskrec = 1 end eskf12 = 0 scf = notesize TOP: if eskrec > f04 return end if con2 = 0 tget [X,eskrec] line else if con2 = 4 trec = list_order(eskrec,4) if trec = 0 tget [X,eskrec] line else tget [X2,trec] line end else if list_order(eskrec,3) <> 0 if con2 = 5 trec = 0 else trec = list_order(eskrec,4) end if trec = 0 tget [X,eskrec] line else tget [X2,trec] line end if con3 = 1 if "SL" not_con line{1} if "SLl" not_con line{1} /* Chnaged 12/18/05 list_order(eskrec,3) = 0 /* remove flag end end else eskrec = list_order(eskrec,2) goto TOP end end end line = trm(line) if line{1} = "S" and con4 > 0 and eskrec > con4 return end eskrec = list_order(eskrec,2) if "ESLlXJKAWTHBkZY@" con line{1} /* New 02/21/06 goto LTY(mpt) end END OF LINE ─────────── 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 S Y S T E M (recoded 05/26/03) ─────────── LTY(2): /* line{1} = "S" eskf12 = 0 sysnum = sysnum + 1 #if REPORT3 putc System ~sysnum putc Line ... #endif sub = 5 esksp = int(line{sub..}) esksysy = int(line{sub..}) esksyslen = int(line{sub..}) esksysright = esksysy + esksyslen /* added 12/31/08 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 Code to check number of parts in syscode (modified 11/13/03) a2 = 0 loop for c8 = 1 to len(esksyscode) if ".:,;" con esksyscode{c8} ++a2 end repeat if a2 <> eskf11 and esksyscode <> "" putc Syscode Warning: Incorrect number of parts in syscode. eskrec = ~(eskrec - 1) end sysflag = 0 goto TOP L I N E ─────── LTY(3): /* line{1} = "L" LTY(4): /* line{1} = "l" /* Added 12/18/05 New code to deal with single line staff 12/18/05 stave_type = 0 if line{1} = "l" stave_type = 1 end New 08/28/03. Must zero out parameters eskdyoff, eskuxstart, backloc, and ibackloc OK 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 Field 2: y off-set in system esksq(eskf12) = int(line{3..}) esksq(eskf12) += esksysy Field 3: text off-set(s) from line (separated by |) ntext = 0 NSR1: ++ntext eskf(eskf12,ntext) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR1 end Field 4: eskdyoff(s) separated by | c8 = 0 NSR2: ++c8 eskdyoff(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR2 end Field 5: eskuxstart(s) separated by | c8 = 0 NSR3: ++c8 eskuxstart(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR3 end Field 6: eskbackloc(s) separated by | c8 = 0 NSR4: ++c8 eskbackloc(c8) = int(line{sub..}) ibackloc(c8) = eskbackloc(c8) /* New 08/26/03 if line{sub} = "|" ++sub goto NSR4 end tline = line{sub+1..} tline = mrt(tline) Field 7: eskxbyte(s) (length of field = number of bytes) 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 New 08/28/03 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 Field 8: y off-set to virtual staff line (0 = none) eskvst(eskf12) = 0 if tline con " " tline = tline{mpt..} eskvst(eskf12) = int(tline) tline = tline // " " tline = tline{sub..} end Field 9: notesize (0 = not specified; i.e., no change) if tline con " " tline = tline{mpt..} c8 = int(tline) tline = tline // " " /* New code 09/14/03 tline = tline{sub..} /* " " " if chr(c8) in [6,14,18,21] /* New: notesize 18 added 12/18/04 if c8 <> notesize notesize = c8 perform init_par end end end nsz(eskf12) = notesize /* New code 11/13/03 Field 10: additional off-set for figured harmony New 09/14/03 figoff(eskf12) = 0 if tline con " " tline = tline{mpt..} figoff(eskf12) = int(tline) tline = tline // " " /* New code 09/14/03 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 G L O B A L T E X T ───────────────────── New Code 02/12/05 LTY(16): /* line{1} = "@" goto TOP LTY(15): /* line{1} = "Y" sub = 3 z = int(line{sub..}) if z = 0 /* New 03/26/05 goto TOP end x = int(line{sub..}) 03/04/05 Deal with optional "C" or "R" following x-data ttext = " " if line{sub} = "C" or line{sub} = "R" ttext = line{sub} // " " ++sub end y = int(line{sub..}) tline = line{sub..} tline = mrt(tline) line = "X " // chs(z) // " " // chs(x) // ttext // chs(y) // " " /* New 03/04/05 line = "X " // chs(z) // " " // chs(x) // " " // chs(y) // " " if tline <> "" loop for i = 1 to len(tline) if tline{i} = "\" if i < len(tline) if ">]" con tline{i+1} ++i /* skip \> and \] else if "<[" con tline{i+1} loop while i < len(tline) and tline{i} <> "|" ++i /* skip up to "|" character repeat else line = line // tline{i} end end else line = line // tline{i} end else line = line // tline{i} end repeat end End of 02/12/05 addition LTY(5): /* line{1} = "X" lpt = 3 tline = txt(line,[' '],lpt) z = int(tline) Code added 08/28/02 if lpt > len(line) if z = 6 or z = 14 or z = 21 or z = 18 or z = 16 /* New: notesize 16 added 01/01/09 notesize = z perform init_par scf = notesize end goto TOP end tline = txt(line,[' '],lpt) tline = tline // " " /* New 03/04/05 x = int(tline) ttext = tline{sub} /* New 03/04/05 tline = txt(line,[' '],lpt) y = int(tline) if lpt > len(line) line = "" else line = line{lpt+1..} line = trm(line) end 04/22/04 Call to setwords now includes paramter: 0 = regular setwords call a1 = 0 perform setwords (a1) scf = notesize goto TOP O B J E C T S ───────────── LTY(6): /* line{1} = "J" trec = list_order(eskrec,1) if con2 = 5 or con2 = 0 trec2 = 0 else trec2 = list_order(trec,4) end if trec2 > 0 tget [X2,trec2] line .t8 jtype ntype obx oby z i i supcnt else tget [X,trec] line .t8 jtype ntype obx oby z i i supcnt end if con2 = 2 supcnt = 0 end j = int(line{3..}) line = line{sub..} line = mrt(line) line = "J " // line * New code 09/14/03 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 Collect super-object information 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 if not found, then set up reference to this superobject. 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 dputc Storing esksuperdata putc .t10 esksuperdata(~k ,~h ) = ~obx .t40 esksuperdata(~k ,~(h+1) ) = ~oby repeat end if no sub-objects, then typeset object 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 12/06/03) y = esksq(eskf12) + oby perform setmus end end end typeset underline (if unset) esksaverec = eskrec if jtype = "R" if jtype = "R" or jtype = "r" /* New 10/15/07 loop for c8 = 1 to ntext if "_,.;:!?" con eskxbyte(c8) check next note for new syllable 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 11-11-93 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 S U B - O B J E C T S ───────────────────── LTY(7): /* line{1} = "K" trec = list_order(eskrec,1) if con2 = 5 or con2 = 0 trec2 = 0 else trec2 = list_order(trec,4) end if trec2 > 0 tget [X2,trec2] .t3 sobx soby z else tget [X,trec] .t3 sobx soby z end x = esksp + obx + sobx y = esksq(eskf12) + oby + soby perform setmus Adding code 05/26/03 for printing repeat dots on the grandstaff if save_jtype = "B" and z = DOT_CHAR y += eskvst(eskf12) perform setmus end goto TOP A T T R I B U T E S ─────────────────── LTY(8): /* line{1} = "A" goto TOP W O R D S ───────── LTY(9): /* line{1} = "W" lpt = 3 tline = txt(line,[' '],lpt) * line structure = sobx soby font# text sobx = int(tline) tline = txt(line,[' '],lpt) soby = int(tline) tline = txt(line,[' '],lpt) z = int(tline) if len(line) > lpt and z <> 0 /* 10/01/03 adding condition z <> 0 line = line{lpt+1..} x = esksp + obx + sobx y = esksq(eskf12) + oby + soby a1 = 0 04/22/04 Call to setwords now includes paramter: 0 = regular setwords call perform setwords (a1) end goto TOP T E X T ─────── LTY(10): /* line{1} = "T" line = line // " " * line structure = sobx tlevel[|soby] ttext xbyte textlen sobx = int(line{3..}) tlevel = int(line{sub..}) if tlevel < 1 or tlevel > 10 putc Error: Invalid tlevel in Text record ~(eskrec - 1) putc Enter blank line to stop program getc line line = trm(line) if line = "" return 10 end goto TOP end soby = 0 if line{sub} = "|" ++sub soby = int(line{sub..}) end line = line{sub..} line = mrt(line) /* ttext is next in line New 08/28/03 Stripping of ttext moved up 26 lines to here. We need to know if ttext = "~" in order to set underflag correctly. if line con " " ttext = line{1,mpt-1} line = line{mpt..} line = mrt(line) end typeset back hyphons or underlines (if they exist) 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 08/28/03 don't set punctuation 'till after next note. else underflag = 1 end perform setunder (tlevel) end typeset underline if terminator (~) is found (Code added 02-24-95) 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 08/28/03 xbyte zeroed after 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 04/22/04 replacing settext with setwords Call to setwords now includes paramter: 1 = setwords called from TEXT sub-obj z = mtfont line = ttext a1 = 1 perform setwords (a1) perform settext goto TOP S U P E R - O B J E C T S ───────────────────────── LTY(11): /* line{1} = "H" lpt = 8 tline = txt(line,[' '],lpt) * line structure = supernum htype . . . supernum = int(tline) * get esksuperdata for this superobject loop for k = 1 to SUPERMAX if esksupermap(k) = supernum goto EWB end repeat putc Error: No refererce to superobject ~supernum in previous objects examine return 10 * k = index into esksuperdata EWB: htype = txt(line,[' '],lpt) Construct esksuperdata for case where con2 = 1 or 3 (partial construction) 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 reverse order of esksuperdata(k,.) 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 compensate for out-of-order objects 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" structure of tie superobject: 4. vertical position of tied note 5. horiz. displacement from 1st note 6. horiz. displacement from 2nd note 7. post adjustment of calculated left x position 04/20/03 8. post adjustment of calculated y position " 9. post adjustment of calculated right x position " 10. sitflag 11. recalc flag 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 04/20/03 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" structure of beam superobject: slope vertoff font# #obs bc(1) ... tline = txt(line,[' '],lpt) @k = int(tline) tline = txt(line,[' '],lpt) @m = int(tline) tline = txt(line,[' '],lpt) beamfont = int(tline) i = Mbeamfont(notesize) /* covers all 12 notesizes /* 12/18/04 if beamfont = i stemchar = 59 beamh = eskvpar(16) beamt = eskvpar(32) qwid = eskhpar(3) else stemchar = 187 beamh = eskvpar(16) * 4 / 5 beamt = eskvpar(32) * 4 + 3 / 5 qwid = eskhpar(5) end tline = txt(line,[' '],lpt) bcount = int(tline) j = 1 loop for i = 1 to bcount beamdata(i,1) = esksuperdata(k,j) + esksp beamdata(i,2) = esksuperdata(k,j+1) + esksq(eskf12) temp = txt(line,[' '],lpt) temp = rev(temp) e = 6 - len(temp) beamcode(i) = temp // "00000"{1,e} j += 2 repeat * print beam tbflag = 0 if tupldata(1) > 0 and tupldata(5) = supernum tbflag = bit(4,tupldata(1)) ++tbflag end perform esksetbeam tupldata(1) = 0 esksupermap(k) = 0 goto TOP end if htype = "S" structure of slur superobject: 4. sitflag 5. extra horiz. displ. from obj-1 6. extra vert. displ. from obj-1 7. extra horiz. displ. from obj-2 8. extra vert. displ. from obj-2 9. extra curvature (new 6-30-93) 10. beam flag 11. post adjustment to x co-ordinate 12. post adjustment to y co-ordinate slur_edit_flag = 0 tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + esksuperdata(k,1) tline = txt(line,[' '],lpt) y1 = int(tline) if y1 <> 0 slur_edit_flag = 1 end y1 += esksuperdata(k,2) tline = txt(line,[' '],lpt) x2 = int(tline) + esksuperdata(k,3) tline = txt(line,[' '],lpt) y2 = int(tline) if y2 <> 0 slur_edit_flag = 1 end y2 += esksuperdata(k,4) if y1 > 700 y1 -= 1000 y1 += eskvst(eskf12) end if y2 > 700 y2 -= 1000 y2 += eskvst(eskf12) end tline = txt(line,[' '],lpt) addcurve = int(tline) tline = txt(line,[' '],lpt) j = int(tline) postx = 0 posty = 0 if lpt < len(line) tline = txt(line,[' '],lpt) postx = int(tline) end if lpt < len(line) tline = txt(line,[' '],lpt) posty = int(tline) end if bit(5,sitflag) = 0 /* This condition added 04/26/05 perform putslur end esksupermap(k) = 0 goto TOP end if htype = "F" structure of figcon super-object: 4. figure level 5. horiz. disp. from obj1 6. horiz. disp. from obj2 7. (optional) additional vert. disp. New 11/06/03 from default height 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) Adding code 11/06/03 to look for optional additional vert. disp. 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" structure of tuplet super-object: 4. situation flag 5. tuplet number 6. horiz. disp. from obj1 7. vert. disp. from obj1 8. horiz. disp. from obj2 9. vert. disp. from obj2 10. associated beam super-number 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 For the rest of the superbjects, please see code at procedure esksave1 perform esksave1 esksupermap(k) = 0 goto TOP B A R L I N E (section recoded 05/26/03) ──────────────── LTY(12): /* line{1} = "B" sub = 3 a7 = int(line{sub..}) if a7 = 99 if sysflag = 0 #if REPORT3 putc #endif sysflag = 1 end goto TOP end First make sure that the system line is printed. (this code moved here and revised 11/13/03) savesub = sub savensz = notesize if sysflag = 0 #if REPORT3 putc #endif Code added here 11/13/03 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 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 Adding code 05/26/03 for print second set of dots in case of grandstaff 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 Code added 11/13/03 to reset notesize to local value if notesize <> savensz notesize = savensz perform init_par end goto TOP "Silent" S U B - O B J E C T S ────────────────────────────── LTY(13): /* line{1} = "k" goto TOP "Silent" Z - R E C O R D S ────────────────────────── LTY(14): /* line{1} = "Z" goto TOP End of processing music data return *P XX. init_par Purpose: Initialize Vertical and Horizontal Parameters and expar(.) parameters Inputs: notesize Outputs: eskvpar(.) eskhpar(.) eskvpar20 expar(.) revmap(.) sizenum Other operations: In all cases, if scf = old notesize, then scf reset to new notesize procedure init_par int a,b,i int pz bstr cycle.200 sizenum = revsizes(notesize) Vertical parameters ─────────────────── if notesize = 14 eskvpar(13) = 8 eskvpar(42) = 4 eskvpar(43) = 240 eskvpar(44) = 1 end if notesize = 6 eskvpar(13) = 3 /* Changed from 4 to 3 01/30/05 eskvpar(42) = 2 eskvpar(43) = 80 eskvpar(44) = 1 end if notesize = 21 eskvpar(13) = 12 eskvpar(42) = 6 eskvpar(43) = 240 eskvpar(44) = 3 end if notesize = 18 /* New size-18 12/18/04 eskvpar(13) = 10 eskvpar(42) = 5 eskvpar(43) = 240 eskvpar(44) = 2 end if notesize = 16 /* New size-16 01/01/09 eskvpar(13) = 9 eskvpar(42) = 4 eskvpar(43) = 240 eskvpar(44) = 1 end loop for i = 1 to 10 eskvpar(i) = notesize * i / 2 repeat eskvpar(11) = 200 * notesize / 16 eskvpar(12) = 4 * notesize / 16 eskvpar(14) = 160 * notesize / 16 eskvpar(15) = 64 * notesize / 16 eskvpar(16) = 3 * notesize eskvpar(17) = notesize / 2 eskvpar(18) = 30 * notesize / 16 eskvpar(19) = 15 eskvpar(20) = notesize + 3 / 4 eskvpar(21) = notesize - eskvpar(20) eskvpar(22) = 6 * notesize / 16 eskvpar(23) = 9 * notesize / 16 eskvpar(24) = 7 * notesize / 16 eskvpar(25) = 22 * notesize / 16 eskvpar(26) = 27 * notesize / 16 eskvpar(27) = 72 * notesize / 16 eskvpar(28) = 15 * notesize / 16 eskvpar(29) = 38 * notesize / 16 eskvpar(30) = 3 * notesize - 8 / 16 eskvpar(31) = notesize / 2 + 1 eskvpar(32) = notesize * 8 + 4 / 10 eskvpar(33) = notesize * 12 + 10 / 14 eskvpar(34) = notesize - 3 / 9 eskvpar(35) = notesize / 3 eskvpar(36) = 7 * notesize eskvpar(37) = 5 * notesize / 4 eskvpar(38) = 4 * notesize / 3 eskvpar(39) = notesize eskvpar(40) = 3 * notesize / 5 eskvpar(41) = eskvpar(5) eskvpar(45) = 2 * notesize eskvpar20 = notesize * 10 Horizontal parameters ───────────────────── if notesize = 14 eskhpar(2) = 15 eskhpar(3) = 19 eskhpar(5) = 13 eskhpar(6) = 80 eskhpar(7) = 56 /* 01/20/05 made explicit eskhpar(12) = 80 eskhpar(17) = 14 eskhpar(19) = 4 eskhpar(20) = 20 eskhpar(29) = 2 eskhpar(30) = 15 eskhpar(33) = 6 eskhpar(34) = 7 eskhpar(43) = 40 eskhpar(48) = 8 eskhpar(58) = 30 eskhpar(60) = 254 eskhpar(61) = 20 eskhpar(62) = 2 eskhpar(63) = 90 end if notesize = 6 eskhpar(2) = 7 eskhpar(3) = 8 eskhpar(5) = 6 eskhpar(6) = 34 eskhpar(7) = 18 /* 01/20/05 changed from 24 to 18 and made explicit eskhpar(12) = 35 eskhpar(17) = 7 eskhpar(19) = 2 eskhpar(20) = 9 eskhpar(29) = 1 eskhpar(30) = 7 eskhpar(33) = 3 eskhpar(34) = 4 eskhpar(43) = 30 eskhpar(48) = 4 eskhpar(58) = 10 eskhpar(60) = 110 eskhpar(61) = 10 eskhpar(62) = 1 eskhpar(63) = 90 end if notesize = 21 eskhpar(2) = 19 eskhpar(3) = 28 eskhpar(5) = 18 /* 12/18/04 changed from 19 to 18 eskhpar(6) = 110 eskhpar(7) = 88 /* 01/20/05 made explicit eskhpar(12) = 100 eskhpar(17) = 21 eskhpar(19) = 6 eskhpar(20) = 30 eskhpar(29) = 3 eskhpar(30) = 19 eskhpar(33) = 8 /* 12/18/04 changed from 9 to 8 eskhpar(34) = 11 eskhpar(43) = 30 eskhpar(48) = 13 eskhpar(58) = 30 eskhpar(60) = 381 eskhpar(61) = 30 eskhpar(62) = 3 eskhpar(63) = 80 end New 01/01/09 notesize 16 parameters added if notesize = 16 eskhpar(2) = 16 eskhpar(3) = 22 eskhpar(5) = 15 eskhpar(6) = 90 eskhpar(7) = 64 eskhpar(12) = 80 eskhpar(17) = 16 eskhpar(19) = 4 eskhpar(20) = 23 eskhpar(29) = 2 eskhpar(30) = 18 eskhpar(33) = 6 eskhpar(34) = 9 eskhpar(43) = 30 eskhpar(48) = 9 eskhpar(58) = 30 eskhpar(60) = 280 eskhpar(61) = 22 eskhpar(62) = 2 eskhpar(63) = 80 #if BIG16 ++eskhpar(3) #endif end New 12/18/04 notesize 18 parameters added if notesize = 18 eskhpar(2) = 17 eskhpar(3) = 26 eskhpar(5) = 17 eskhpar(6) = 100 eskhpar(7) = 72 /* 01/20/05 made explicit eskhpar(12) = 90 eskhpar(17) = 18 eskhpar(19) = 5 eskhpar(20) = 26 eskhpar(29) = 3 eskhpar(30) = 17 eskhpar(33) = 7 eskhpar(34) = 9 eskhpar(43) = 30 eskhpar(48) = 10 eskhpar(58) = 30 eskhpar(60) = 326 eskhpar(61) = 26 eskhpar(62) = 2 eskhpar(63) = 80 end eskhpar(1) = 30 eskhpar(2) = 18 * notesize / 16 eskhpar(3) = 19 * notesize + 8 / 16 eskhpar(4) = 3 eskhpar(5) = 13 * notesize + 2 / 16 eskhpar(6) = 80 eskhpar(7) = 4 * notesize /* 01/20/05 made explicit eskhpar(8) = 200 eskhpar(9) = 2250 eskhpar(10) = 26 * notesize / 16 eskhpar(11) = 200 * notesize / 16 eskhpar(12) = 80 eskhpar(14) = 40 * notesize / 16 eskhpar(16) = 24 * notesize / 16 eskhpar(17) = 14 eskhpar(18) = 2 * notesize eskhpar(19) = 4 eskhpar(20) = 20 eskhpar(21) = 300 eskhpar(22) = 6 * notesize / 16 (not used) eskhpar(23) = 60 * notesize / 16 (not used) eskhpar(24) = 7 * notesize + 2 / 7 (not used) eskhpar(25) = notesize + 1 (not used) eskhpar(26) = 15 * notesize / 16 (not used) eskhpar(27) = 0 (not used) eskhpar(28) = 0 - 32 * notesize / 16 (not used) eskhpar(29) = 2 * notesize + 8 / 16 eskhpar(30) += eskhpar(29) eskhpar(31) = 24 * notesize / 16 eskhpar(32) = 44 * notesize / 16 eskhpar(33) = 6 * notesize / 16 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 eskhpar(43) = 40 eskhpar(44) = notesize eskhpar(45) = notesize eskhpar(46) = 13 * notesize / 16 eskhpar(47) = 2 * notesize / 5 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 New 01/01/09 parameters added for notesize 16 if notesize = 16 eskhpar(42) = 56 end New 12/18/04 parameters added for notesize 18 if notesize = 18 eskhpar(11) = 225 eskhpar(39) = 50 eskhpar(42) = 67 end if notesize = 21 eskhpar(11) = 250 eskhpar(39) = 50 eskhpar(42) = 76 end Other parameters and variables ────────────────────────────── 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 notesize 16 added 01/01/09 if notesize = 16 expar(1) = 278 expar(2) = 362 expar(3) = 290 expar(4) = 372 expar(5) = 296 expar(6) = 368 expar(7) = 298 expar(8) = 376 end notesize 18 added 12/18/04 if notesize = 18 expar(1) = 308 expar(2) = 424 expar(3) = 326 expar(4) = 428 expar(5) = 330 expar(6) = 422 expar(7) = 334 expar(8) = 432 end loop for i = 1 to 223 pos(i) = urpos(i) * notesize repeat Dotted mask (modified 10/23/03) if notesize = 14 gapsize = 8 cycle = dup("1",10) // dup("0",6) end if notesize = 6 gapsize = 3 cycle = dup("1",4) // dup("0",2) end if notesize = 21 gapsize = 12 cycle = dup("1",15) // dup("0",9) end if notesize = 16 /* New size-16 mask 01/01/09 gapsize = 9 cycle = dup("1",11) // dup("0",7) end if notesize = 18 /* New size-18 mask 12/18/04 gapsize = 10 cycle = dup("1",12) // dup("0",8) end dotted = "" i = 2500 - (2 * gapsize) loop dotted = dotted // cycle repeat while len(dotted) < i scf can be (1) old notesize (4 to 24) (requires change in scf) (2) beamfont (101 to 114) (independent of notesize) (3) text font (31 to 48) (actual font depends on notesize) (4) 300 (ties) " (5) 320 (brackets) " (6) 400 (wedges) " (7) 30 (variable pitch screen fonts, display only) (8) 200 (fixed pitch screen font, display only) if scf > 0 and scf < 25 scf = notesize end pz = revsizes(notesize) loop for a = 30 to 48 revmap(a) = XFonts(pz,a-29) repeat revmap(200) = scfont(notesize) revmap(300) = pz + TIE_OFFSET if notesize < 10 revmap(320) = SMALL_BRACK else revmap(320) = LARGE_BRACK end revmap(400) = wedgefont(notesize) return ┌───────────────────────────────────────────────────────────────────────────────┐ │*P procedure pgetk (k) Added 11/25/03 │ │ │ │ Purpose: Combine all getk calls. Make possible the │ │ implementation of macros │ │ │ │ Operation: The idea is that the user can set up 8 possible │ │ macros, F5 to F12. And if the user types one │ │ of these keys, pgetk will feed the buffer │ │ successively to to user. If the buffer is │ │ empty or is undefined, the normal getk will │ │ be called. │ │ │ │ Variables: int macros(8,100) │ │ int macropnt(8) │ │ int macstrokes(8) │ │ int macchange │ └───────────────────────────────────────────────────────────────────────────────┘ procedure pgetk (k) int i,j,k int macroswitch(8) First: Look to see if a macro is active 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 Also: Check for active pseudomacro (New 11/01/08) if pseudomacropnt > 0 k = pseudomacro(pseudomacropnt) if k = 0 pseudomacropnt = 0 goto GETKK /* back to getk end ++pseudomacropnt goto RETGETK end GETKK: getk k Second: Check to see if this is a call to a macro 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 Third: Look for turning on or off loading of macro 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 Fourth: load macro buffer, if appropriate 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 Fifth: Return value of k RETGETK: passback k return *P XXI. get_hght_dpth Purpose: Construct the hght(.) and dpth(.) arrays -- parameters used in estimating size of scaling section after a change Outputs: hght(.) dpth(.) Note: The hght(.) and dpth(.) values for the NEWFONTS case may be reconstructed (updated) using the program J:/MUSPRINT/NEW/XFONTS/TMS/eskpars.z procedure get_hght_dpth hght(1) = 21 hght(2) = 23 hght(3) = 25 hght(4) = 27 hght(5) = 29 hght(6) = 33 hght(7) = 37 hght(8) = 57 hght(9) = 45 hght(10) = 73 hght(11) = 86 hght(12) = 61 hght(13) = 15 hght(14) = 15 hght(15) = 15 hght(16) = 15 hght(17) = 15 hght(18) = 15 hght(19) = 15 hght(20) = 15 hght(21) = 15 hght(22) = 15 hght(23) = 15 hght(24) = 15 hght(25) = 15 hght(26) = 23 hght(27) = 23 hght(28) = 23 hght(29) = 23 hght(30) = 23 hght(31) = 23 hght(32) = 23 hght(33) = 23 hght(34) = 23 hght(35) = 30 hght(36) = 69 hght(37) = 23 hght(38) = 5 hght(39) = 7 hght(40) = 7 hght(41) = 8 hght(42) = 0 hght(43) = 0 hght(44) = 5 hght(45) = 8 hght(46) = 11 hght(47) = 17 hght(48) = 5 hght(49) = 5 hght(50) = 5 hght(51) = 8 hght(52) = 8 hght(53) = 8 hght(54) = 13 hght(55) = 14 hght(56) = 16 hght(57) = 17 hght(58) = 18 hght(59) = 20 hght(60) = 22 hght(61) = 23 hght(62) = 25 hght(63) = 27 hght(64) = 30 hght(65) = 32 hght(66) = 35 hght(67) = 36 hght(68) = 40 hght(69) = 41 hght(70) = 42 hght(71) = 43 hght(72) = 46 hght(73) = 48 hght(74) = 54 hght(75) = 59 hght(76) = 63 hght(77) = 63 hght(78) = 68 hght(79) = 82 hght(80) = 82 hght(81) = 13 hght(82) = 13 hght(83) = 13 hght(84) = 13 hght(85) = 16 hght(86) = 16 hght(87) = 17 hght(88) = 19 hght(89) = 19 hght(90) = 22 hght(91) = 23 hght(92) = 25 hght(93) = 26 hght(94) = 29 hght(95) = 32 hght(96) = 33 hght(97) = 35 hght(98) = 38 hght(99) = 39 hght(100) = 42 hght(101) = 42 hght(102) = 46 hght(103) = 47 hght(104) = 51 hght(105) = 55 hght(106) = 60 hght(107) = 63 hght(108) = 68 hght(109) = 78 hght(110) = 78 hght(111) = 14 hght(112) = 14 hght(113) = 14 hght(114) = 14 hght(115) = 15 hght(116) = 16 hght(117) = 17 hght(118) = 19 hght(119) = 22 hght(120) = 23 hght(121) = 25 hght(122) = 26 hght(123) = 27 hght(124) = 30 hght(125) = 33 hght(126) = 34 hght(127) = 35 hght(128) = 38 hght(129) = 40 hght(130) = 41 hght(131) = 44 hght(132) = 47 hght(133) = 48 hght(134) = 53 hght(135) = 59 hght(136) = 61 hght(137) = 64 hght(138) = 69 hght(139) = 82 hght(140) = 82 dpth(1) = 23 dpth(2) = 25 dpth(3) = 27 dpth(4) = 29 dpth(5) = 31 dpth(6) = 35 dpth(7) = 39 dpth(8) = 63 dpth(9) = 47 dpth(10) = 79 dpth(11) = 94 dpth(12) = 63 dpth(13) = 16 dpth(14) = 17 dpth(15) = 18 dpth(16) = 20 dpth(17) = 20 dpth(18) = 21 dpth(19) = 22 dpth(20) = 23 dpth(21) = 24 dpth(22) = 27 dpth(23) = 27 dpth(24) = 27 dpth(25) = 27 dpth(26) = 24 dpth(27) = 24 dpth(28) = 24 dpth(29) = 24 dpth(30) = 24 dpth(31) = 24 dpth(32) = 24 dpth(33) = 24 dpth(34) = 24 dpth(35) = 31 dpth(36) = 72 dpth(37) = 24 dpth(38) = 6 dpth(39) = 7 dpth(40) = 7 dpth(41) = 8 dpth(42) = 198 dpth(43) = 99 dpth(44) = 2 dpth(45) = 3 dpth(46) = 4 dpth(47) = 6 dpth(48) = 2 dpth(49) = 2 dpth(50) = 2 dpth(51) = 3 dpth(52) = 3 dpth(53) = 3 dpth(54) = 4 dpth(55) = 5 dpth(56) = 5 dpth(57) = 6 dpth(58) = 6 dpth(59) = 7 dpth(60) = 8 dpth(61) = 8 dpth(62) = 8 dpth(63) = 9 dpth(64) = 10 dpth(65) = 11 dpth(66) = 11 dpth(67) = 10 dpth(68) = 11 dpth(69) = 12 dpth(70) = 13 dpth(71) = 13 dpth(72) = 14 dpth(73) = 15 dpth(74) = 16 dpth(75) = 18 dpth(76) = 19 dpth(77) = 20 dpth(78) = 21 dpth(79) = 25 dpth(80) = 25 dpth(81) = 4 dpth(82) = 4 dpth(83) = 4 dpth(84) = 4 dpth(85) = 6 dpth(86) = 6 dpth(87) = 6 dpth(88) = 5 dpth(89) = 7 dpth(90) = 6 dpth(91) = 7 dpth(92) = 6 dpth(93) = 7 dpth(94) = 8 dpth(95) = 8 dpth(96) = 11 dpth(97) = 11 dpth(98) = 11 dpth(99) = 12 dpth(100) = 11 dpth(101) = 14 dpth(102) = 12 dpth(103) = 15 dpth(104) = 16 dpth(105) = 18 dpth(106) = 16 dpth(107) = 17 dpth(108) = 19 dpth(109) = 25 dpth(110) = 25 dpth(111) = 4 dpth(112) = 4 dpth(113) = 4 dpth(114) = 4 dpth(115) = 5 dpth(116) = 6 dpth(117) = 6 dpth(118) = 7 dpth(119) = 7 dpth(120) = 8 dpth(121) = 8 dpth(122) = 9 dpth(123) = 9 dpth(124) = 11 dpth(125) = 11 dpth(126) = 12 dpth(127) = 11 dpth(128) = 12 dpth(129) = 13 dpth(130) = 13 dpth(131) = 15 dpth(132) = 16 dpth(133) = 15 dpth(134) = 16 dpth(135) = 20 dpth(136) = 17 dpth(137) = 22 dpth(138) = 20 dpth(139) = 25 dpth(140) = 25 return End of GIANT #if XVERSION section #endif #if XVERSION *P XXII. procedure start_xversion Initializing arrays for NEWFONTS procedure start_xversion First acquire macro definitions from the MACFILE macchange = 0 macfile = DISP_DISK // ":/release/progs/" // MACFILE loop for i = 1 to 8 loop for j = 1 to 100 macros(i,j) = 0 repeat macstrokes(i) = 0 macropnt(i) = 0 repeat line = DISP_DISK // ":/release/progs" open [9,1] line loop getf [9] line .t10 line2 line = line // pad(8) line2 = line2 // pad(1) line = line{1,8} line = trm(line) line = line // "." // line2{1} if line = MACFILE open [8,1] macfile getf [8] line line = line // pad(48) line = line{1,48} if line <> " ESKPAGE MACRO DEFINITION FILE" putc Macro file found, but the header is not correct. Ignoring file. 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] Second, initialize variables brought over from ESKPAGE 1. Shift parameters for music font file = DISP_DISK // ":/musprint/new/mfonts/pos3" open [1,1] file loop for i = 1 to 223 getf [1] .t39 a urpos(i) = a repeat close [1] 2. Initialize Vertical and Horizontal Parameters notesize = 14 perform init_par Outputs: eskvpar(.) eskhpar(.) eskvpar20 expar(.) revmap(.) sizenum 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 3. Cursor 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 4. Blue lines in display 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) 5. Object, Subobject and Superobject definitions 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) = " " 6. Messages, and their locations 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 7. Miscellaneous 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 8. Screen fonts, and related parameters line = DISP_DISK // ":/zprogs/apps/newscrxx.fnt" open [1,5] line Parameters used in estimating size of scaling section after a change 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] 9. Spacing parameters for hyphon and underline characters (text font) file = DISP_DISK // ":/musprint/new/xfonts/tms/fontspac" loop for a1 = 1 to 12 open [1,1] file a2 = mtfont - 29 a3 = XFonts(a1,a2) - 50 a4 = Fspacex(a3) - 1 loop for j = 1 to a4 getf [1] repeat getf [1] line hyphspc(a1) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(a1) = int(line{10,2}) close [1] repeat 10. Beam generation parameters file = DISP_DISK // ":/musprint/new/beams/beamexs" open [1,1] file loop for i = 1 to 435 getf [1] q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for j = 1 to 12 beamext(i,j) = q(j) repeat repeat close [1] 11. Tie placement parameters loop for a1 = 1 to 12 a2 = nsizes(a1) file = DISP_DISK // ":/musprint/new/ties/tpar" if a2 < 10 file = file // "0" end file = file // chs(a2) if chr(a2) in [6,14,16,18,21] /* 01/01/09 size 16 included here else file = file // "x" end file = file // "/" tiefile(1) = file // "td-ns" tiefile(2) = file // "td-nl" tiefile(3) = file // "tu-ns" tiefile(4) = file // "tu-nl" loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to ( TIE_DISTS ) getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(a1,i,j,k) = q(k) repeat repeat close [1] repeat repeat return #endif run Explanation of Variables ──────────────────────────────── I. Horizontal distance related olddist(32) = x-value of last object (.) bolddist(32) = x-value of last object which was typeset (.) sp = x co-ordinate of line obx = object x co-ordinate sobx = sub-object x co-ordinte sobx2 = optional second value of sobx for "T" text records saved_sobx2 = old value of sobx2 for "T" text record x = x co-ordinate for typesetting x1,x2 = pdist = horizontal location along staff line ldist = absolute horizontal location along current line point = horizontal location along staff at print time prev_point = previous value of point on this staff line point_adv = point - prev_point oldmpoint = value of point at last bar line oldmp2 = adjusted value of last bar line (first measure) dxoff(32) = x offset for directive thrown to next line tdist(32,2) = new values of olddist for parts in a node rmarg = temporary right margin (usually hxpar(4)) delta = distance to make up in line expansion firstbarflag = 0: first bar on a line; 1: subsequent bars on a line (print loop) pn_left = amount by which part names need to be moved left to avoid a clash II. Vertical distance related psq(32) = preliminary (at start) y co-ordinate of line (.) sq(32) = y co-ordinate of line (.) vst(32) = y shift (down) to auxiliary staff line (grand staff) oby = object y co-ordinate coby = object y co-ordinate (control) soby = sub-object y co-ordinate y = y co-ordinate for typesetting y1,y2 = savenoby(32) = save variable for oby dyoff(32) = y offset for directive thrown to next line III. Record related rec = next record in file crec = record number for proper object-node drec(32) = record number for directive thrown to next line saverec = place to save current value of rec while browsing endbarrec = record number for last bar in line + 1 IV. Counting and space related marc = number of objects in a measure larc = number of objects on the line larc2 = number of objects on extended line larr(300,MARR_PARS) = distances between proper object nodes on a line marr(60,MARR_PARS) = distances between objects in measure (.,1) = distance from previous node (.,2) = type of node 14 = clef 15 = key 16 = time 17 = directive, bar, mult-rest, figure, mark 18 = controlling bar (?) (.,3) = time number (576 = quarter note) (.,4) = space node number (max = 6913) (also called snode) (.,5) = parts active on this node (snode = 6913 only) (.,6) = space modification flag: 0 = O.K. to modify spacing in this measure 1 = don't modify spacings in this measure (.,7) = temporary data tarr(32) = temporary array tarr2(32) = temporary array tarr3(32) = temporary array tarr4(32,4) = temporary array introduced to fixed setckt tarr5(32,2) = temporary array adjarr(300,4) = collection of distances to add adjarc = counter for adjarr small(300) = list of smallest nodes on a line scnt = counter for small small2(300) = list of smallest nodes on a line scnt2 = counter for small2 barnum = measure number oldbarnum = measure at beginning of line newbarnum = measure number for next line snode = space node number csnode = space node number (control) dincf = distance increment flag cdincf(32) = cumulative distance increment flag for part (.) ndincf(32) = next distance increment flag for part (.) barcount = counter for bars on a particular line barpar(40,3) = measure parameters, first subscript = barcount (.,1) = length of measure (.,2) = node number for terminating bar line (.,3) = type for terminating bar line sysbarpar(400,5) = parameters relating to the number and size of measures (bars) per system (.,1) = number of bars per system (.,2) = extra space on a system before justification (.,3) = if > 0, this is the max number of bars allowed on this system (.,4) = extra space, assuming last measure is removed (.,5) = sys_jflag for this system oldsysbarpar(.,.) = saving values of sysbarpar 1 and 2 for going back to a previous solution (.,1) = number of bars per system (.,2) = extra space on a system before justification IV. Type related jtype.1 = type of object cjtype.1 = type of object (control) htype.1 = type of super-object lbyte.1 = type of line "L" or "l" ntype = field three in an object record cntype = field three in an object record (control) V. Super-object related supernum = super-object number supermap(32,N_SUPER) = mapping pointer (N_SUPER simultaneous super-objects) superpnt(32,N_SUPER) = pointer into superdata storage array superdata(32,N_SUPER,SUPERSIZE) = information for compiling super-object supcnt = number of super-objects attached to an object conttie(32) = continued tie flag. Used for setting accidentals VI. Beam related beamdata(MAX_BNOTES,2) = data for typesetting beam beamcode.6(MAX_BNOTES) = beamcode bcount = number of notes under a beam beamfont = font for printing beam beamt = vertical space between beams beamh = height parameter for beams stemchar = character number for stem stem = stem direction flag VII. Tie related sitflag = situation flag for ties tspan = distance spanned by tie VIII. Text related textline.232 = working string for text ttext.80 = text to typeset xbyte.10(32) = extension byte (-_,.;:!?) (ten of them) textflag = text present flag textlen = length of syllable to typeset backloc(32) = location of first space beyond last syllable uxstart(32) = x-coord. of first space beyond last syllable uxstop(32) = x-coordinate of end of line nuxstop(32) = IX. Character related notesize = size of note maxnotesize = maximum of all notesizes mtfont = text font number z = number of character to typeset cz = number of character to typeset (control) X. Parameters hxpar(25) = fixed horizontal spacing parameters hpar(32,25) = variable horizontal spacing parameters (32 lines max) vpar(32,41) = variable vertical spacing parameters vpar20(32) = 10 times notesize (20 claves) zak(2,6) = accidental placement parameters XI. Flags nflg1 = set of parts in node (bits 31--0: parts 1--32) rflag(40) = global rest in meas(barcount) (# > 0: distance) endflag = completion flag f(32,1) = first record in part (.) f(32,2) = last record in part(.) f(32,3) = size of clef and key header for part(.) f(32,4) = record at new line of music for part(.) (bbrec) f(32,5) = record at new measure of music for part(.)(brec) f(32,6) = next record to read in part(.) (rec) f(32,7) = multiple rest counter for part(.) f(32,8) = completion flag for part(.) f(32,9) = vertical displacement of text (0 = no text) f(32,10) = first temporary multiple rest counter f(32,11) = second temporary multiple rest counter f(32,12) = staff flag: 0 = normal staff = 1 = continuo part (no printing of rests) = 2 = grand staff (auxiliary stave) f(32,13) = number of levels of text in this file f(32,14) = notesize f(32,15) = line flag: 1 = "L" 2 = "l" f(32,16) = trans flag (spaging only) f(32,17) = instrument number (spaging only) f2 = general rest in extra measure on line f4 = end of line flag f5 = bar spitting flag (for types 9 and 10) f11 = number of parts f12 = current part number f13 = first line flag (zero = first line) music on line cflag = set: center object in measure (for whole rests) XII. Music related key(32) = operative number of sharps (flats) (.) clef(32,2) = operative clef (.,virtual staff number) tcode(32) = time signature code (active, if time signature changes at the end of a line XIII. Format related formatflag = formatting options 0 = don't use or create a format file 1 = format file exist, use it 2 = create a new format file justflag = last line justify options 0 = do not justify last line, go with first pass 1 = justify last line using current line configuration ( < 2 ) = produce output 2 = last line is to be right justified 3 = recompute line configuration XIV. Added for version 3.0 table Y = pre-output for page files table F = pre-output to format file str outfile = page specific output file (special name for safety) forp = pointer into table F forpz = size of pre-existing format file mainyp = main pointer into Y table sv_mainyp = saved value of main pointer into Y table y1p,y2p,y3p = pointers in table Y XV. Added for extended format files plarr(300,2) = first two elements of the larr array as read from the format file cum_larr(300,2) = cumulative horizontal distances from first element of larr array (.,1) = cumulative distance (.,2) = distance flag: 0 = determined from PRE_DIST 1 = determined from rflag(.) e.g., G.P. cum_larrz = size of cum_larr array (can be bigger than larc) larr_gen(20000) = larr index (1st dim) which helped to generate the obx of an object record plarc = counter for plarr psysnum = system number edflag = edit flag: bit 0: 1 = edit always on bit 1: 1 = selectively edit this system larrx = a larr index XVI. Added implementing optional staff lines rest7 = optional rest flag (used in procedure wholerest) intersys = inter-system vertical space firstsys = first system flag f11out = flag indicating the bottom line of system was removed mnum = measure number of last system to display bottom_sq = value of sq for bottom staff (initially sq(f11)) tf11 = temporary value of f11 (used when removing lines) tsq(.) = temporary values of sq(.) (used when removing lines) tvst(.) = temporary values of vst(.) (used when removing lines) tnotesize(.) = temporary values of notesizes(.) (used when removing lines) sys_bottom = y-value of system bottom (initially sq(f11) + vst(f11)) XVII. Added implementing tag records str abbr.40(.) = abbreviated part names abbr_cnt = counter into abbr recflag(100000) = record flags: 0xff: if non-zero, this is pointer to abbr part name 0xff00: 0 = normal print rules 1 = tag as type-1 record 2 = tag as type-2 record current_recf = current value of rec flag type1_dflag(32) = type 1 delete flag: initially set to on, then turned off type2_dflag(32) = type 2 delete flag: initially set to off, then turned on Variable Vertical Parameters ──────────────────────────── vpar(.,1) = one vertical note space vpar(.,2) = two " " spaces vpar(.,3) = three " " " vpar(.,4) = four " " " vpar(.,5) = five " " " vpar(.,6) = six " " " vpar(.,7) = seven " " " vpar(.,8) = eight " " " vpar(.,9) = nine " " " vpar(.,10) = ten " " " vpar(.,11) = vertical distance below staff line with text vpar(.,12) = vertical shift for printing two or more beams vpar(.,13) = not used vpar(.,14) = vertical distance below staff line without text vpar(.,15) = vert. shift for printing italic 8 under treble clef vpar(.,16) = height parameter for beams vpar(.,17) = decrease in vpar(16) when range of notes exceeds vpar(3) vpar(.,18) = cutoff of severe up-down pattern under beam vpar(.,19) = maximum rise in beam character vpar(.,20) = amount to add to beam height to get stradle vpar(.,21) = cutoff for shifting beams to middle of next line vpar(.,22) = fudge factor for two/more slanted beams on staff lines vpar(.,23) = fudge factor for one slanted beam on staff lines vpar(.,24) = maximum rise allowed for beam on one staff line vpar(.,25) = minimum rise allowed for beam crossing two staff lines vpar(.,26) = minimum rise allowed for beam crossing three staff lines vpar(.,27) = minimum for sum of two stems under 2-note beam vpar(.,28) = amount to extend stems in case vpar(27) is not reached vpar(.,29) = minimum stem length that triggers adding to 16th stem vpar(.,30) = adjustment for raising 16th beams because of short stems vpar(.,31) through vpar(34): beam spacing parameters ─────────────────────────────────────────────────── vpar(.,31) = beam thickness vpar(.,32) = offset between beams (if two or three) vpar(.,33) = offset between beams (if more than three in staff line) vpar(.,34) = amount by which a hanging beam exceeds line height Beam and line parameters ────────────────────────── Note Beam Beam large Hang Line size width offset offset delta width ────── ────── ────── ────── ────── ────── 12 7 10 11 1 1 14 8 11 12 1 1 16 9 13 14 1 1 18 10 14 16 1 1 20 11 16 17 1 1 22 12 18 19 2 2 24 13 19 21 2 2 26 14 21 23 2 2 28 15 22 24 2 2 30 16 24 26 3 2 Beam and line parameters ────────────────────────── (actual values) Note Beam Beam large Hang Line size width offset offset delta width ────── ────── ────── ────── ────── ────── 6 3 6 6 1 1 14 8 11 12 1 1 16 9 13 14 1 1 18 10 14 16 1 1 21 12 17 18 2 3 vpar(.,35) = maximum beam slope for short beams vpar(.,36) = vertical location of level 1 of figures vpar(.,37) = height of figures vpar(.,38) = height of tuplet numbers vpar(.,39) = placement of tuplet numbers above notes or beams vpar(.,40) = bracket shift, when combined with tuplets vpar(.,41) = thickness of staff line (1 for notesize = 14, etc.) Fixed Horizontal Parameters ─────────────────────────── hxpar(1) = length of standard beam character hxpar(2) = shift after key signature hxpar(3) = left margin for staff lines hxpar(4) = left margin + length of staff lines hxpar(5) = increment after key signature for lines 2 ... hxpar(6) = minimum space taken up by whole measure rest hxpar(7) = shift after bar line hxpar(8) = location for starting - or _ on new line (run time set) hxpar(9) = indent margin for first line hxpar(10) = distance from beginning of staff line to first character hxpar(11) = shift forward to print double bar at beginning of line hxpar(12) = shift following common or cut time signature hxpar(13) = shift after time signature hxpar(14) = minimum extra shift after note with stem-up flag (hpar(28) in autoset) hxpar(15) = maximum value of hpar(.,15): shift after big clef sign hxpar(16) = maximum value of hpar(.,16) hxpar(17) = maximum value of hpar(.,17): heavy/light spacing + thickness of light line hxpar(18) = maximum value of hpar(.,18): shift back to print double dot repeat hxpar(19) = maximum value of hpar(.,19): shift for large number hxpar(20) = maximum value of hpar(.,20): half shift for large number hxpar(21) = maximum value of hpar(.,21): shift to middle of double digit time signature hxpar(22) = maximum value of hpar(.,22): shift to middle of single digit time signature Variable Horizontal Parameters ────────────────────────────── hpar(.,1) = pseudo distance of continuation tie hpar(.,2) = overhang of underline past x-position of last note hpar(.,3) = skip before starting an underline hpar(.,4) = minimum space between underline and following syllable hpar(.,5) = horizontal shift for printing small italic 8 under treble clef hpar(.,6) = shift following sharp or natural in key signature hpar(.,7) = shift following flat in key signature hpar(.,8) = width of quarter note, minus thickness of stem hpar(.,9) = olddist adjustment following common/cut time on new line hpar(.,10) = shift following time number hpar(.,11) = shift following double dot or double bar hpar(.,12) = approximate width of grace note hpar(.,13) = shift to commom time signature on new line hpar(.,14) = pseudo distance of continuation slur hpar(.,15) = shift after big clef sign hpar(.,16) = thickness of heavy vertical line - thickness of light vertical line + 1 hpar(.,17) = heavy/light spacing + thickness of light line hpar(.,18) = shift back to print double dot repeat hpar(.,19) = shift for large number hpar(.,20) = half shift for large number hpar(.,21) = shift to middle of double digit time signature hpar(.,22) = shift to middle of single digit time signature hpar(.,23) = right shift of continuo figures placed above notes Line and measure arrays ─────────────────────── larr(.,1) = distance between this proper object node and the previous proper object node larr(.,2) = smallest object type for objects in this object node Type # object ──────── ──────── 1 256th note 2 128th " 3 64th " 4 32nd " 5 16th " 6 eighth " 7 quarter " 8 half " 9 whole " 10 breve " 11 longa " 12 extended rest 13 whole measure rest 14 clef signature 15 key signature 16 time signature 17 other objects,directives 18 bar line 21-31 syncopated note 40 conflicting n-tuple larr(.,3) = recomputed distance increment flag for this node larr(.,4) = space node number for this node larr(.,5) = parts active on this node (for snode = 6913 only) larr(.,6) = space modification flag: New 05/25/03 0 = O.K. to modify spacing in this measure 1 = don't modify spacings in this measure Space adjustment array ────────────────────── adjarr(.,1) = number in larr array adjarr(.,2) = maximum possible distance to add adjarr(.,3) = current largest distance for node of this type adjarr(.,4) = final distance to add to node Explanation of Variables brought over from ESKPAGE ─────────────────────────────────────────────────────────── I. Horizontal distance related esksp = x co-ordinate of line obx = object x co-ordinate sobx = sub-object x co-ordinte x = x co-ordinate for typesetting x1,x2 = postx = post adjustment to x co-ordinate after automatic computation of position II. Vertical distance related esksq(32) = y co-ordinate of line (.) eskvst(32) = y displacement to virtual staff (if present, 0 otherwise) oby = object y co-ordinate soby = sub-object y co-ordinate y = y co-ordinate for typesetting y1,y2 = eskdyoff(10) = y offset for directive thrown to next line posty = post adjustment to y co-ordinate after automatic computation of position figoff(32) = additional off-set for figured harmony nsz(32) = notesize for each staff line in a system govstaff = staff number whose notesize should be used for printing the left system bar, etc. savensz = temporary variable for saving notesize III. Record related eskrec = next record in file esksaverec = place to save current value of rec while browsing IV. Counting and space related tarr(32) = temporary array (1) = length of measure (2) = node number for terminating bar line (3) = type for terminating bar line IV. Type related jtype.1 = type of object htype.1 = type of super-object stave_type = type of line: 0 = "L" or 1 = "l" ntype = field three in an object record V. Super-object related supernum = super-object number esksupermap(50) = mapping pointer (SUPERMAX simultaneous super-objects) esksuperpnt(50) = pointer into esksuperdata storage array esksuperdata(50,128) = information for compiling super-object SUPERMAX SUPERSIZE supcnt = number of super-objects attached to an object VI. Beam related beamdata(32,2) = data for typesetting beam MAX_BNOTES beamcode.6(32) = beamcode MAX_BNOTES bcount = number of notes under a beam beamfont = font for printing beam bthick = thickness of beamfont - 1 beamt = vertical space between beams beamh = height parameter for beams beamfy = y co-ordinate of first note under beam qwid = width of quarter note stem = stem direction flag stemchar = character number for stem tupldata(7) = data for typesetting tuplet at beam time tbflag = flag for setting tuplet with beam beamext(435,12) = parameters for beam extension eskhpar(59) = white space on either side of repeater beam VII. Tie related hd = horizontal displacement of tie from first note vd = vertical displacement of tie from first note tiechar = tie character tpost_x = post adjustment to left x position tpost_y = post adjustment to y position tpost_leng = post adjustment to right x position sitflag = situation flag for ties tcnt = counter for extending ties tspan = distance spanned by tie expar(8) = extension parameters for ties textend = tie extension character tiefile(4) = names of the four tie extension files tiearr(#,4,#,12) = parameters for choosing ties (for three notesizes 14, 21, 6) eskhpar(60) = length beyond which ties for C5,D5 (tips up) and A4,G4 (tips down) are no longer constrained by staff lines eskhpar(61) = smallest distance between notes for which a tie may be printed eskhpar(62) = distance increment in tiearr data eskhpar(63) = last tie glyph number for a complete tie (longer ties are divided) VIII. Text related textline.232 = working string for text ttext.80 = text to typeset ntext = number of text lines for a particular music line tlevel = level number for line of text (field 3 of TEXT sub-object) eskxbyte.1(10) = extension byte (-_,.;:!?) (ten strophies) eskbackloc(10) = location of first space beyond last syllable ibackloc(10) = backloc(.) read from L record eskuxstart(10) = x-coord. of first space beyond last syllable eskuxstop(10) = x-coordinate of end of underline buxstop(10) = eskuxstop at bar line IX. Character related hyphspc(12) = space for text hyphon underspc(12) = space for text underline character urpos(256) = vertical offsets for music font characters (basic units) pos(256) = vertical offsets for music font characters (notesize included) notesize = size of note z = number of character to typeset z1,z3,z3 = X. Parameters eskhpar(63) = horizontal spacing parameters eskvpar(45) = vertical spacing parameters wak(9) = character extension values (upper range) XI. Flags eskf(32,*) = vertical position (offset) of line * of text f01 = page number f03 = page counter f04 = number of records in table eskf11 = number of parts eskf12 = current part number underflag = execution flag for setunder XII. Variables related to editing list_order(.,.) = link information for entries in table (1) previous entry in table (2) next entry in table (3) modified printing flag 0 = skip record -1 = use record (4) >0 = index to alternate record (5) copy of (3); used to make save command work properly pointers(.,.) = pointers relating to objects (1) pointer back to object in table (record pointer) (2) second pointer (barlines) (3) pointer to next object in line (index in pointers array) (4) pointer to previous object in line (index in pointers array) (5) pointer to object above (index in pointers array) (6) pointer to object below (index in pointers array) (7) pointer to line record (record pointer) (8) pointer to system record (record pointer) (9) modified node number (10) larr index that helped generate obx super_pointers(.,.) = pointers relating to super-objects (1) pointer back to super-object in table (record pointer) (2) second pointer (3) pointer into array containing lists of objects (related_objects()) (4) number of objects related to this super_object related_objects(.) = (table) addresses of objects connected to super-objects nodelist(.,.) = list of node numbers and corresponding index in pointers array numbers for a system (1) node number (2) index in pointers array temp_store_ob(.,.) = list of objects having super objects (1) object address in table (2) super-object number barlinks(.) = list of bar objects in a system barlink_cnt = counter into barlinks list system_rec(.) = pointers to system records in X table system_cnt = number of systems on page object_count = number of objects on the page super_count = number of super-objects on the page nodenum = object node number curnode = modified-node-number (includes measure number) savecurnode = first modified-node-number in a group xsavecurnode = index in pointers array of first node in group xbacknode = index in pointers array of first node in previous group xupnode = index in pointers array of node in line above this group measnum = measure number in line linepoint = record number of last line record syspoint = record number of last system record trigger = flag for recognizing new measure in line obcursor = run-time pointer into pointers() array (location of cursor) supercursor = run-time pointer into super_pointers() array (location of cursor) Vertical Parameters ─────────────────── eskvpar(1) = one vertical note space eskvpar(2) = two " " spaces eskvpar(3) = three " " " eskvpar(4) = four " " " eskvpar(5) = five " " " eskvpar(6) = six " " " eskvpar(7) = seven " " " eskvpar(8) = eight " " " eskvpar(9) = nine " " " eskvpar(10) = ten " " " eskvpar(11) = vertical distance below staff line with text eskvpar(12) = vertical shift for printing two or more beams eskvpar(13) = vertical shift for printing ___ eskvpar(14) = vertical distance below staff line without text eskvpar(15) = vert. shift for printing italic 8 under treble clef eskvpar(16) = height parameter for beams eskvpar(17) = decrease in eskvpar(16) when range of notes exceeds eskvpar(3) eskvpar(18) = cutoff of wevere up-down pattern under beam eskvpar(19) = maximum rise in beam character eskvpar(20) = amount to add to beam height to get stradle eskvpar(21) = cutoff for shifting beams to middle of next line eskvpar(22) = fudge factor for two/more slanted beams on staff lines eskvpar(23) = fudge factor for one slanted beam on staff lines eskvpar(24) = maximum rise allowed for beam on one staff line eskvpar(25) = minimum rise allowed for beam crossing two staff lines eskvpar(26) = minimum rise allowed for beam crossing three staff lines eskvpar(27) = minimum for sum of two stems under 2-note beam eskvpar(28) = amount to extend stems in case vpar(27) is not reached eskvpar(29) = minimum stem length that triggers adding to 16th stem eskvpar(30) = adjustment for raising 16th beams because of short stems eskvpar(31) through vpar(34): beam spacing parameters ─────────────────────────────────────────────────── eskvpar(31) = beam thickness eskvpar(32) = offset between beams (if two or three) eskvpar(33) = offset between beams (if more than three in staff line) eskvpar(34) = amount by which a hanging beam exceeds line height Beam and line parameters ────────────────────────── Note Beam Beam large Hang Line size width offset offset delta width ────── ────── ────── ────── ────── ────── 12 7 10 11 1 1 14 8 11 12 1 1 16 9 13 14 1 1 18 10 14 16 1 1 20 11 16 17 1 1 22 12 18 19 2 2 24 13 19 21 2 2 26 14 21 23 2 2 28 15 22 24 2 2 30 16 24 26 3 2 eskvpar(35) = maximum beam slope for short beams eskvpar(36) = vertical location of level 1 of figures eskvpar(37) = height of figures eskvpar(38) = height of tuplet numbers eskvpar(39) = placement of tuplet numbers above notes or beams eskvpar(40) = bracket shift, when combined with tuplets eskvpar(41) = default offset increment (height) of text line eskvpar(42) = amount to shorten stems protruding into beams eskvpar(43) = size of vertical shift in display mode eskvpar(44) = width of staff line eskvpar(45) = placement of accidentals above trills (vpar(53) in AUTOSET) Horizontal Parameters ───────────────────── eskhpar(1) = length of standard beam character eskhpar(2) = length of beam hook character eskhpar(3) = width of quarter note (approximately) eskhpar(4) = back shift before concatination character eskhpar(5) = approximate width of grace note eskhpar(6) = hyphon spacing parameter (1/3 min distance for two hyp.) eskhpar(7) = overhang of underline past x-position of last note eskhpar(8) = left margin for staff lines eskhpar(9) = left margin + length of staff lines eskhpar(10) = increment after key signature for lines 2 ... eskhpar(11) = minimum space taken up by whole measure rest eskhpar(12) = amount by which a whole measure rest can be enlarged eskhpar(13) = distance between bar and multiple rest (run time set) eskhpar(14) = pseudo distance of continuation tie eskhpar(15) = (no longer used; replaced by ibackloc(.) ) eskhpar(16) = shift after bar line eskhpar(17) = minimum space for hyphon eskhpar(18) = minimum space for underline eskhpar(19) = skip before starting an underline eskhpar(20) = minimum space between underline and following syllable eskhpar(21) = indent margin for first line eskhpar(22) = not used eskhpar(23) = not used eskhpar(24) = not used eskhpar(25) = not used eskhpar(26) = not used eskhpar(27) = not used eskhpar(28) = not used eskhpar(29) = thickness of stem eskhpar(30) = backward shift for printing backward hook eskhpar(31) = olddist adjustment following common/cut time on new line eskhpar(32) = shift following time number eskhpar(33) = thickness of heavy vertical line - thickness of light vertical line + 1 eskhpar(34) = heavy/light spacing + thickness of light line eskhpar(35) = shift back to print double dot repeat eskhpar(36) = shift forward to print double dot repeat eskhpar(37) = shift forward to print double bar at beginning of line eskhpar(38) = shift following double dot or double bar eskhpar(39) = minimum wedge length eskhpar(40) = length of trill extension character eskhpar(41) = advance after tr. character eskhpar(42) = width of 8av character eskhpar(43) = shift in printing dash character (font dependent) eskhpar(44) = length of figure line generation character eskhpar(45) = width of tuplet number eskhpar(46) = backshift for heavy vertical brace eskhpar(47) = backshift for bracket eskhpar(48) = space between double light bar lines + thickness of light line eskhpar(49) = shift for large number eskhpar(50) = half shift for large number eskhpar(51) = shift to middle of double digit time signature eskhpar(52) = shift to middle of single digit time signature eskhpar(53) = shift following common or cut time signature eskhpar(54) = shift after time signature eskhpar(55) = shift to commom time signature on new line eskhpar(56) = distance from end of continuation line to bar at end of line eskhpar(57) = same as above, but for case where line does not continue in next system eskhpar(58) = size of horizontal shift in display mode eskhpar(59) = white space on either side of a repeater beam eskhpar(60) = special case tie length for C5,D5 (tips up) and A4,G4 (tips down) eskhpar(61) = smallest distance between notes for which a tie may be printed eskhpar(62) = distance increment in tiearr data eskhpar(63) = last tie glyph number for a complete tie (longer ties are divided) Line and measure arrays ─────────────────────── Type # object ──────── ──────── 1 256th note 2 128th " 3 64th " 4 32nd " 5 16th " 6 eighth " 7 quarter " 8 half " 9 whole " 10 breve " 11 longa " 12 extended rest 13 whole measure rest 14 clef signature 15 key signature 16 time signature 17 other objects,directives 18 bar line 21-31 syncopated note 40 conflicting n-tuple Explanation of Variables for NEWFONTS ─────────────────────────────────────────── nsizes(12) = The 12 available note sizes only sizes 3 [06], 8 [14], and 11 [21] are currently available revsizes(24) = The reverse map to nsizes XFonts(12,19) = The number of 10s and the 6 x 3 (sizes, styles) for each notesize XFontstr.76(12) = XFont data in string form Fspacex(90) = index from (TMS font number - 50) to record in fontspac(.) wedgefont(24) = font number for wedges for each notesize scfont(24) = fixed pitch font number for each notesize