&dA &dA &d@ Program to display and edit a score from &dA &d@ page specific intermediate files &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ This program will display pages of music from page files in &dA &d@ score format. The program asks for the library and number of &dA &d@ pages, then proceeds to display these one page at a time. &dA &d@ Pages consist of one or more systems, each of which is &dA &d@ handled independently by the print program. This means that &dA &d@ systems can be moved from page to page with window editor &dA &dA &d@ After displaying a page, the program gives the user the &dA &d@ opportunity to move various things around the screen. &dA &d@ The intention is that the result of these moves be written &dA &d@ back into the page file &dA #define UP 0 #define DOWN 1 #define REPORT 0 #define SUPERSIZE 128 #define SUPERMAX 50 #define MAX_BNOTES 32 #define LMARG 30 #define RMARG 1200 #define TMARG 50 #define BMARG 820 #define LMARG2 400 #define RMARG2 800 #define TMARG2 300 #define BMARG2 600 #define MSGTAB1 20 #define MSGTAB2 280 #define MSGTAB2A 400 #define MSGTAB2B 350 #define MSGROW1 25 #define MSGROW2 50 #define MSGROW3 75 #define MSGROW4 100 #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 str outfile.100 str file.100,out.10000,line.180,line2.180,temp.180,tiefile.80(4) str sourcelib.100,tline.80,destlib.100 str textline.232,ttext.80 str jtype.1,htype.1,xbyte.1(10),cjtype.1,tbyte.1 str beamcode.6(MAX_BNOTES),syscode.40 int tarr(32) int dyoff(10) int rec,saverec,trec,trec2 int beamh,beamt,beamfy,qwid,beamfont,stemchar,bthick int backloc(10),uxstart(10),uxstop(10) int buxstop(10) int savenoby int underflag int pos(256),urpos(256),underspc(3),hyphspc(3) int wak(9),hpar(59),vpar(45),zak(2,6),vpar20 int a,b,c,d,e,g,h,i,j,k,n,x,y,z int q(12),beamext(435,12),tiearr(3,4,162,12) int sizenum int df int sk int @a,@b,@c,@d,@e,@k,@m,@q,@r int a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 int c1,c2,c3,c4,c5,c6,c7,c8,c9 int f(32,10),f1,f2,f3,f4,f5,f11,f12,f13 int notesize,mtfont,supcnt,fsub,textlen int superdata(SUPERMAX,SUPERSIZE),supermap(SUPERMAX),superpnt(SUPERMAX) int tupldata(7),tbflag int sp,sq(32),sx,sy,vst(32) int x1,x2,y1,y2,z1,z2,z3 int bcount,beamdata(MAX_BNOTES,2) int d1,d2,d3 int ntype,stem int oby,sobx,soby,supernum int hd,vd,tiechar,sitflag,tcnt,textend,expar(8),tspan int sysy,sysh,syslen,sysflag,sysnum int barbreak(10,2),brkcnt int obx,dv3,dv4 int lpt,addcurve int firstbarflag int fontmap(400),music_con(255) int ntext,tlevel str esc.1,ff.1,quote.1 table X(100000) table X2(1000) int postx,posty int multiflag int naming_method &dA &d@ variables added to make screen display work int FA(250000) int activefont str gstr.2800000,tstr2.260000,tstr3.170000,tstr4.150000 str red_gstr.940000,red_tstr2.260000,red_tstr3.170000,red_tstr4.150000 str blue_horiz1t.400,blue_horiz2t.200,blue_horiz3t.150,blue_horiz4t.130 str blue_horiz1b.400,blue_horiz2b.200,blue_horiz3b.150,blue_horiz4b.130 str blue_vert1v.3500,blue_vert2v.1850,blue_vert3v.1300,blue_vert4v.1020 str blue_vert1r.3500,blue_vert2r.1850,blue_vert3r.1300,blue_vert4r.1020 int xco, yco int xze, yze str zline.80 int curdist int altflag int revmap(400) int scx,scy,scf,scb &dA &d@ variables added for printing long slurs str longslur.320(250) int slur_edit_flag bstr bt.2500(250) bstr dotted.2500 int gapsize * &dA &d@ variables added for editing int pointers(2000,9) 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) str messages.80(40),sub_def.30(255),obj_def.30(15),super_def.30(12) str cmode.1,newcmode.1,rectype.1 str current_line.80,new_line.80 str current_def.80,new_def.80 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(51),dpth(51) int incre,textoff int aa,gg,hh str ttline.120 &dA &d@ int @a,@b,@c,@d,@e,@f,@g,@h,@i,@j,@k,@m,@n,@q,@r,@s,@t &dA &d@ int @@n,@@g,@@q,@@b &dA &dA &d@ Explanation of Variables &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ &dA &d@ I. Horizontal distance related &dA &dA &d@ sp = x co-ordinate of line &dA &d@ obx = object x co-ordinate &dA &d@ sobx = sub-object x co-ordinte &dA &d@ x = x co-ordinate for typesetting &dA &d@ x1,x2 = &dA &d@ firstbarflag = 0: first bar on a line; 1: subsequent bars on a line (print loop) &dA &d@ postx = post adjustment to x co-ordinate after automatic computation of position &dA &dA &d@ II. Vertical distance related &dA &dA &d@ sq(32) = y co-ordinate of line (.) &dA &d@ vst(32) = y displacement to virtual staff (if present, 0 otherwise) &dA &d@ oby = object y co-ordinate &dA &d@ soby = sub-object y co-ordinate &dA &d@ y = y co-ordinate for typesetting &dA &d@ y1,y2 = &dA &d@ sy = post adjusted y for typesetting &dA &d@ savenoby = save variable for oby &dA &d@ dyoff(10) = y offset for directive thrown to next line &dA &d@ posty = post adjustment to y co-ordinate after automatic computation of position &dA &dA &d@ III. Record related &dA &dA &d@ rec = next record in file &dA &d@ saverec = place to save current value of rec while browsing &dA &dA &d@ IV. Counting and space related &dA &dA &d@ tarr(32) = temporary array &dA &d@ (1) = length of measure &dA &d@ (2) = node number for terminating bar line &dA &d@ (3) = type for terminating bar line &dA &dA &d@ IV. Type related &dA &dA &d@ jtype.1 = type of object &dA &d@ cjtype.1 = type of object (control) &dA &d@ htype.1 = type of super-object &dA &d@ ntype = field three in an object record &dA &dA &d@ V. Super-object related &dA &dA &d@ supernum = super-object number &dA &d@ supermap(50) = mapping pointer (SUPERMAX simultaneous super-objects) &dA &d@ superpnt(50) = pointer into superdata storage array &dA &d@ superdata(50,128)= information for compiling super-object SUPERMAX SUPERSIZE &dA &d@ supcnt = number of super-objects attached to an object &dA &dA &d@ VI. Beam related &dA &dA &d@ beamdata(32,2) = data for typesetting beam MAX_BNOTES &dA &d@ beamcode.6(32) = beamcode MAX_BNOTES &dA &d@ bcount = number of notes under a beam &dA &d@ beamfont = font for printing beam &dA &d@ bthick = thickness of beamfont - 1 &dA &d@ beamt = vertical space between beams &dA &d@ beamh = height parameter for beams &dA &d@ beamfy = y co-ordinate of first note under beam &dA &d@ qwid = width of quarter note &dA &d@ stem = stem direction flag &dA &d@ stemchar = character number for stem &dA &d@ tupldata(7) = data for typesetting tuplet at beam time &dA &d@ tbflag = flag for setting tuplet with beam &dA &d@ beamext(435,12) = parameters for beam extension &dA &d@ hpar(59) = white space on either side of repeater beam &dA &dA &d@ VII. Tie related &dA &dA &d@ hd = horizontal displacement of tie from first note &dA &d@ vd = vertical displacement of tie from first note &dA &d@ tiechar = tie character &dA &d@ sitflag = situation flag for ties &dA &d@ tcnt = counter for extending ties &dA &d@ tspan = distance spanned by tie &dA &d@ expar(8) = extension parameters for ties &dA &d@ textend = tie extension character &dA &d@ tiefile(4) = names of the four tie extension files &dA &d@ tiearr(3,4,162,12) = parameters for choosing ties (for three notesizes 14, 21, 6) &dA &dA &d@ VIII. Text related &dA &dA &d@ textline.232 = working string for text &dA &d@ ttext.80 = text to typeset &dA &d@ ntext = number of text lines for a particular music line &dA &d@ tlevel = level number for line of text (field 3 of TEXT sub-object) &dA &d@ xbyte.1(10) = extension byte (-_,.;:!?) (ten strophies) &dA &d@ textlen = length of syllable to typeset &dA &d@ backloc(10) = location of first space beyond last syllable &dA &d@ uxstart(10) = x-coord. of first space beyond last syllable &dA &d@ uxstop(10) = x-coordinate of end of underline &dA &d@ buxstop(10) = uxstop at bar line &dA &dA &d@ IX. Character related &dA &dA &d@ hyphspc(3) = space for text hyphon (for the three notesizes: 14, 21, 6) &dA &d@ underspc(3) = space for text underline character (for the three notesizes 14, 21 6) &dA &d@ urpos(256) = vertical offsets for music font characters (basic units) &dA &d@ pos(256) = vertical offsets for music font characters (notesize included) &dA &d@ notesize = size of note &dA &d@ mtfont = text font number &dA &d@ z = number of character to typeset &dA &d@ z1,z3,z3 = &dA &d@ fsub = pointer into pos array &dA &dA &d@ X. Parameters &dA &dA &d@ hpar(58) = horizontal spacing parameters &dA &d@ vpar(45) = vertical spacing parameters &dA &d@ wak(9) = character extension values (upper range) &dA &d@ zak(2,6) = accidental placement parameters &dA &dA &d@ XI. Flags &dA &dA &d@ f(32,*) = vertical position (offset) of line * of text &dA &d@ f1 = page number &dA &d@ f2 = number of pages &dA &d@ f3 = page counter &dA &d@ f4 = number of records in table &dA &d@ f5 = &dA &d@ f11 = number of parts &dA &d@ f12 = current part number &dA &d@ underflag = &dA &dA &d@ XII. Variables related to editing &dA &dA &d@ list_order(.,.) = link information for entries in table &dA &d@ (1) previous entry in table &dA &d@ (2) next entry in table &dA &d@ (3) modified printing flag &dA &d@ 0 = skip record &dA &d@ -1 = use record &dA &d@ (4) >0 = index to alternate record &dA &d@ &dA &d@ pointers(.,.) = pointers relating to objects &dA &d@ (1) pointer back to object in table (record pointer) &dA &d@ (2) second pointer (barlines) &dA &d@ (3) pointer to next object in line (index in pointers array) &dA &d@ (4) pointer to previous object in line (index in pointers array) &dA &d@ (5) pointer to object above (index in pointers array) &dA &d@ (6) pointer to object below (index in pointers array) &dA &d@ (7) pointer to line record (record pointer) &dA &d@ (8) pointer to system record (record pointer) &dA &d@ (9) modified node number &dA &d@ super_pointers(.,.) = pointers relating to super-objects &dA &d@ (1) pointer back to super-object in table (record pointer) &dA &d@ (2) second pointer &dA &d@ (3) pointer into array containing lists of objects (related_objects()) &dA &d@ (4) number of objects related to this super_object &dA &d@ related_objects(.) = (table) addresses of objects connected to super-objects &dA &d@ nodelist(.,.) = list of node numbers and corresponding index in pointers array &dA &d@ numbers for a system &dA &d@ (1) node number &dA &d@ (2) index in pointers array &dA &d@ temp_store_ob(.,.) = list of objects having super objects &dA &d@ (1) object address in table &dA &d@ (2) super-object number &dA &d@ system_rec(.) = pointers to system records in X table &dA &d@ system_cnt = number of systems on page &dA &d@ object_count = number of objects on the page &dA &d@ super_count = number of super-objects on the page &dA &d@ nodenum = object node number &dA &d@ curnode = modified-node-number (includes measure number) &dA &d@ savecurnode = first modified-node-number in a group &dA &d@ xsavecurnode = index in pointers array of first node in group &dA &d@ xbacknode = index in pointers array of first node in previous group &dA &d@ xupnode = index in pointers array of node in line above this group &dA &d@ measnum = measure number in line &dA &d@ linepoint = record number of last line record &dA &d@ syspoint = record number of last system record &dA &d@ trigger = flag for recognizing new measure in line &dA &d@ obcursor = run-time pointer into pointers() array (location of cursor) &dA &d@ supercursor = run-time pointer into super_pointers() array (location of cursor) &dA &dA Q1: multiflag = 0 notesize = 14 putc Enter note size ( = 14; x = mixed sizes) getc line line = trm(line) if line <> "" if line = "x" multiflag = 1 else notesize = int(line) if chr(notesize) not_in [6,14,21] putc Note size of ~notesize is not supported at this time. putc Supported sizes are 6, 14, and 21 putc goto Q1 end end end if notesize = 14 sizenum = 1 end if notesize = 21 sizenum = 2 end if notesize = 6 sizenum = 3 end mtfont = 31 &dA &dA &dA &d@ Vertical Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ vpar(1) = one vertical note space &dA &d@ vpar(2) = two " " spaces &dA &d@ vpar(3) = three " " " &dA &d@ vpar(4) = four " " " &dA &d@ vpar(5) = five " " " &dA &d@ vpar(6) = six " " " &dA &d@ vpar(7) = seven " " " &dA &d@ vpar(8) = eight " " " &dA &d@ vpar(9) = nine " " " &dA &d@ vpar(10) = ten " " " &dA &d@ vpar(11) = vertical distance below staff line with text &dA &d@ vpar(12) = vertical shift for printing two or more beams &dA &d@ vpar(13) = vertical shift for printing ___ &dA &d@ vpar(14) = vertical distance below staff line without text &dA &d@ vpar(15) = vert. shift for printing italic 8 under treble clef &dA &d@ vpar(16) = height parameter for beams &dA &d@ vpar(17) = decrease in vpar(16) when range of notes exceeds vpar(3) &dA &d@ vpar(18) = cutoff of wevere up-down pattern under beam &dA &d@ vpar(19) = maximum rise in beam character &dA &d@ vpar(20) = amount to add to beam height to get stradle &dA &d@ vpar(21) = cutoff for shifting beams to middle of next line &dA &d@ vpar(22) = fudge factor for two/more slanted beams on staff lines &dA &d@ vpar(23) = fudge factor for one slanted beam on staff lines &dA &d@ vpar(24) = maximum rise allowed for beam on one staff line &dA &d@ vpar(25) = minimum rise allowed for beam crossing two staff lines &dA &d@ vpar(26) = minimum rise allowed for beam crossing three staff lines &dA &d@ vpar(27) = minimum for sum of two stems under 2-note beam &dA &d@ vpar(28) = amount to extend stems in case vpar(27) is not reached &dA &d@ vpar(29) = minimum stem length that triggers adding to 16th stem &dA &d@ vpar(30) = adjustment for raising 16th beams because of short stems &dA &d@ vpar(31) through vpar(34): beam spacing parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ vpar(31) = beam thickness &dA &d@ vpar(32) = offset between beams (if two or three) &dA &d@ vpar(33) = offset between beams (if more than three in staff line) &dA &d@ vpar(34) = amount by which a hanging beam exceeds line height &dA &dA &d@ Beam and line parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ Note Beam Beam large Hang Line &dA &d@ size width offset offset delta width &dA &d@ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ ÄÄÄÄÄÄ &dA &d@ 12 7 10 11 1 1 &dA &d@ 14 8 11 12 1 1 &dA &d@ 16 9 13 14 1 1 &dA &d@ 18 10 14 16 1 1 &dA &d@ 20 11 16 17 1 1 &dA &d@ 22 12 18 19 2 2 &dA &d@ 24 13 19 21 2 2 &dA &d@ 26 14 21 23 2 2 &dA &d@ 28 15 22 24 2 2 &dA &d@ 30 16 24 26 3 2 &dA &dA &d@ vpar(35) = maximum beam slope for short beams &dA &d@ vpar(36) = vertical location of level 1 of figures &dA &d@ vpar(37) = height of figures &dA &d@ vpar(38) = height of tuplet numbers &dA &d@ vpar(39) = placement of tuplet numbers above notes or beams &dA &d@ vpar(40) = bracket shift, when combined with tuplets &dA &d@ vpar(41) = default offset increment (height) of text line &dA &d@ vpar(42) = amount to shorten stems protruding into beams &dA &d@ vpar(43) = size of vertical shift in display mode &dA &d@ vpar(44) = width of staff line &dA &d@ vpar(45) = placement of accidentals above trills (vpar(53) in AUTOSET) &dA &dA &dA &d@ Horizontal Parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ hpar(1) = length of standard beam character &dA &d@ hpar(2) = length of beam hook character &dA &d@ hpar(3) = width of quarter note (approximately) &dA &d@ hpar(4) = back shift before concatination character &dA &d@ hpar(5) = approximate width of grace note &dA &d@ hpar(6) = hyphon spacing parameter (1/3 min distance for two hyp.) &dA &d@ hpar(7) = overhang of underline past x-position of last note &dA &d@ hpar(8) = left margin for staff lines &dA &d@ hpar(9) = left margin + length of staff lines &dA &d@ hpar(10) = increment after key signature for lines 2 ... &dA &d@ hpar(11) = minimum space taken up by whole measure rest &dA &d@ hpar(12) = amount by which a whole measure rest can be enlarged &dA &d@ hpar(13) = distance between bar and multiple rest (run time set) &dA &d@ hpar(14) = pseudo distance of continuation tie &dA &d@ hpar(15) = location for starting - or _ on new line (run time set) &dA &d@ hpar(16) = shift after bar line &dA &d@ hpar(17) = minimum space for hyphon &dA &d@ hpar(18) = minimum space for underline &dA &d@ hpar(19) = skip before starting an underline &dA &d@ hpar(20) = minimum space between underline and following syllable &dA &d@ hpar(21) = indent margin for first line &dA &d@ hpar(22) = distance from beginning of staff line to first character &dA &d@ hpar(23) = shift after big clef sign &dA &d@ hpar(24) = hor. shift for printing small italic 8 under treble clef &dA &d@ hpar(25) = not used &dA &d@ hpar(26) = not used &dA &d@ hpar(27) = shift after key signature &dA &d@ hpar(28) = shift if no key signature or key change &dA &d@ hpar(29) = thickness of stem &dA &d@ hpar(30) = backward shift for printing backward hook &dA &d@ hpar(31) = olddist adjustment following common/cut time on new line &dA &d@ hpar(32) = shift following time number &dA &d@ hpar(33) = thickness of heavy vertical line - thickness of light vertical line + 1 &dA &d@ hpar(34) = heavy/light spacing + thickness of light line &dA &d@ hpar(35) = shift back to print double dot repeat &dA &d@ hpar(36) = shift forward to print double dot repeat &dA &d@ hpar(37) = shift forward to print double bar at beginning of line &dA &d@ hpar(38) = shift following double dot or double bar &dA &d@ hpar(39) = minimum wedge length &dA &d@ hpar(40) = length of trill extension character &dA &d@ hpar(41) = advance after tr. character &dA &d@ hpar(42) = width of 8av character &dA &d@ hpar(43) = shift in print -- character &dA &d@ hpar(44) = length of figure line generation character &dA &d@ hpar(45) = width of tuplet number &dA &d@ hpar(46) = backshift for heavy vertical brace &dA &d@ hpar(47) = backshift for bracket &dA &d@ hpar(48) = space between double light bar lines + thickness of light line &dA &d@ hpar(49) = shift for large number &dA &d@ hpar(50) = half shift for large number &dA &d@ hpar(51) = shift to middle of double digit time signature &dA &d@ hpar(52) = shift to middle of single digit time signature &dA &d@ hpar(53) = shift following common or cut time signature &dA &d@ hpar(54) = shift after time signature &dA &d@ hpar(55) = shift to commom time signature on new line &dA &d@ hpar(56) = distance from end of continuation line to bar at end of line &dA &d@ hpar(57) = same as above, but for case where line does not continue in next system &dA &d@ hpar(58) = size of horizontal shift in display mode &dA &d@ hpar(59) = white space on either side of a repeater beam &dA &dA &dA &d@ Line and measure arrays &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ Type # object &dA &d@ ÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 1 256th note &dA &d@ 2 128th " &dA &d@ 3 64th " &dA &d@ 4 32nd " &dA &d@ 5 16th " &dA &d@ 6 eighth " &dA &d@ 7 quarter " &dA &d@ 8 half " &dA &d@ 9 whole " &dA &d@ 10 breve " &dA &d@ 11 longa " &dA &d@ 12 extended rest &dA &d@ 13 whole measure rest &dA &d@ 14 clef signature &dA &d@ 15 key signature &dA &d@ 16 time signature &dA &d@ 17 other objects,directives &dA &d@ 18 bar line &dA &d@ 21-31 syncopated note &dA &d@ 40 conflicting n-tuple &dA &dA &d@ Initialize Vertical and Horizontal Parameters &dA &d@ zak(.,.) expar(.) fontmap(.) &dA &dA &dA &d@ get shift parameters for music font &dA file = "c:\musprint\param\ex\pos3" &dA &d@ file = "c:\wbh\res\mus\prnt\xmus\progs\newph2\ex\pos3" open [1,1] file loop for i = 1 to 223 getf [1] .t39 a urpos(i) = a repeat close [1] perform init_par &dA &d@ Outputs: vpar(.) &dA &d@ hpar(.) &dA &d@ vpar20 &dA &d@ zak(.,.) &dA &d@ expar(.) &dA &d@ fontmap(.) &dA &d@ revmap(.) &dA &d@ 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 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 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) 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) = " " 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) = MSGROW2 message_row(3) = MSGROW3 message_row(4) = MSGROW4 quote = chr(34) esc = chr(27) ff = chr(12) 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 &dK &d@ trace conx1 &dK &d@ trace conx2 &dK &d@ trace cony1 &dK &d@ trace cony2 putc getting fonts . . . ... &dA &dA &d@ Get screen fonts &dA if multiflag = 1 open [1,5] "c:\zprogs\apps\scrftsxx.fnt" else if notesize = 14 open [1,5] "c:\zprogs\apps\scrfonts.fnt" end if notesize = 6 open [1,5] "c:\zprogs\apps\scrfts06.fnt" end if notesize = 21 open [1,5] "c:\zprogs\apps\scrfts21.fnt" end revmap(31) = 1 revmap(32) = 2 revmap(33) = 3 revmap(34) = 4 revmap(37) = 5 revmap(38) = 6 revmap(39) = 7 revmap(44) = 8 revmap(46) = 9 revmap(06) = 10 revmap(14) = 10 revmap(21) = 10 revmap(102) = 11 revmap(103) = 12 revmap(106) = 11 revmap(108) = 12 revmap(109) = 11 revmap(112) = 12 revmap(300) = 13 revmap(400) = 14 revmap(131) = 15 revmap(137) = 16 revmap(200) = 17 revmap(320) = 18 end &dA &dA &d@ Parameters used in estimating size of scaling section after a change &dA if multiflag = 1 &dA &dA &d@ Maximum height of screen fonts above cursor position (2nd parameter in font header record) &dA hght(1) = 31 hght(2) = 30 hght(3) = 30 hght(4) = 36 hght(5) = 38 hght(6) = 38 hght(7) = 38 hght(8) = 46 hght(9) = 54 hght(10) = 29 + 28 hght(11) = 15 hght(12) = 15 hght(13) = 23 hght(14) = 7 hght(15) = 15 hght(16) = 19 hght(17) = 19 hght(18) = 46 hght(19) = 47 hght(20) = 49 hght(21) = 52 hght(22) = 57 hght(23) = 60 hght(24) = 58 hght(25) = 72 hght(26) = 80 hght(27) = 44 + 42 hght(28) = 15 hght(29) = 15 hght(30) = 69 hght(31) = 8 hght(32) = 6 hght(33) = 19 hght(34) = 16 hght(35) = 13 hght(36) = 12 hght(37) = 12 hght(38) = 15 hght(39) = 16 hght(40) = 16 hght(41) = 16 hght(42) = 19 hght(43) = 23 hght(44) = 13 + 12 hght(45) = 15 hght(46) = 15 hght(47) = 23 hght(48) = 5 hght(49) = 6 hght(50) = 8 hght(51) = 8 &dA &dA &d@ Maximum depth of screen fonts below cursor position (4th - 2nd parameter) &dA dpth(1) = 11 dpth(2) = 12 dpth(3) = 11 dpth(4) = 12 dpth(5) = 14 dpth(6) = 14 dpth(7) = 14 dpth(8) = 17 dpth(9) = 19 dpth(10) = 35 + 28 dpth(11) = 21 dpth(12) = 23 dpth(13) = 24 dpth(14) = 7 dpth(15) = 6 dpth(16) = 7 dpth(17) = 7 dpth(18) = 16 dpth(19) = 17 dpth(20) = 15 dpth(21) = 17 dpth(22) = 19 dpth(23) = 19 dpth(24) = 21 dpth(25) = 24 dpth(26) = 27 dpth(27) = 52 + 42 dpth(28) = 24 dpth(29) = 27 dpth(30) = 72 dpth(31) = 8 dpth(32) = 6 dpth(33) = 7 dpth(34) = 6 dpth(35) = 4 dpth(36) = 4 dpth(37) = 4 dpth(38) = 4 dpth(39) = 5 dpth(40) = 5 dpth(41) = 5 dpth(42) = 6 dpth(43) = 7 dpth(44) = 15 + 12 dpth(45) = 17 dpth(46) = 18 dpth(47) = 24 dpth(48) = 6 dpth(49) = 2 dpth(50) = 3 dpth(51) = 3 else &dA &dA &d@ Maximum height of screen fonts above cursor position (2nd parameter in font header record) &dA if notesize = 14 hght(1) = 31 hght(2) = 30 hght(3) = 30 hght(4) = 36 hght(5) = 38 hght(6) = 38 hght(7) = 38 hght(8) = 46 hght(9) = 54 hght(10) = 29 + 28 hght(11) = 15 hght(12) = 15 hght(13) = 23 hght(14) = 7 hght(15) = 15 hght(16) = 19 hght(17) = 19 end if notesize = 21 hght(1) = 46 hght(2) = 47 hght(3) = 49 hght(4) = 52 hght(5) = 57 hght(6) = 60 hght(7) = 58 hght(8) = 72 hght(9) = 80 hght(10) = 44 + 42 hght(11) = 15 hght(12) = 15 hght(13) = 69 hght(14) = 8 hght(15) = 6 hght(16) = 19 hght(17) = 16 end if notesize = 6 hght(1) = 13 hght(2) = 12 hght(3) = 12 hght(4) = 15 hght(5) = 16 hght(6) = 16 hght(7) = 16 hght(8) = 19 hght(9) = 23 hght(10) = 13 + 12 hght(11) = 15 hght(12) = 15 hght(13) = 23 hght(14) = 5 hght(15) = 6 hght(16) = 8 hght(17) = 8 end &dA &dA &d@ Maximum depth of screen fonts below cursor position (4th - 2nd parameter) &dA if notesize = 14 dpth(1) = 11 dpth(2) = 12 dpth(3) = 11 dpth(4) = 12 dpth(5) = 14 dpth(6) = 14 dpth(7) = 14 dpth(8) = 17 dpth(9) = 19 dpth(10) = 35 + 28 dpth(11) = 21 dpth(12) = 23 dpth(13) = 24 dpth(14) = 7 dpth(15) = 6 dpth(16) = 7 dpth(17) = 7 end if notesize = 21 dpth(1) = 16 dpth(2) = 17 dpth(3) = 15 dpth(4) = 17 dpth(5) = 19 dpth(6) = 19 dpth(7) = 21 dpth(8) = 24 dpth(9) = 27 dpth(10) = 52 + 42 dpth(11) = 24 dpth(12) = 27 dpth(13) = 72 dpth(14) = 8 dpth(15) = 6 dpth(16) = 7 dpth(17) = 6 end if notesize = 6 dpth(1) = 4 dpth(2) = 4 dpth(3) = 4 dpth(4) = 4 dpth(5) = 5 dpth(6) = 5 dpth(7) = 5 dpth(8) = 6 dpth(9) = 7 dpth(10) = 15 + 12 dpth(11) = 17 dpth(12) = 18 dpth(13) = 24 dpth(14) = 6 dpth(15) = 2 dpth(16) = 3 dpth(17) = 3 end end len(gstr) = sze read [1,1] gstr j = 1 loop for i = 1 to len(gstr) step 4 FA(j) = ors(gstr{i,4}) ++j repeat close [1] putc done! &dA &dA &d@ get spacing parameters for hyphon and underline characters (text font) &dA &dA &d@ file = "c:\wbh\res\mus\prnt\xmus\progs\newph2\fontspac" file = "c:\musprint\param\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(1) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(1) = int(line{10,2}) close [1] file = "c:\musprint\param21\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(2) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(2) = int(line{10,2}) close [1] file = "c:\musprint\param06\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(3) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(3) = int(line{10,2}) close [1] &dA &dA &d@ get beam generation parameters &dA file = "c:\musprint\param\beamexs" &dA &d@ file = "c:\wbh\res\mus\prnt\xmus\progs\newph2\beamexs" open [1,1] file loop for i = 1 to 435 getf [1] q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for j = 1 to 12 beamext(i,j) = q(j) repeat repeat close [1] &dA &dA &d@ get tie placement parameters &dA &dA &d@ file = "c:\wbh\res\mus\prnt\xmus\progs\newph2\" &dA file = "c:\musprint\param\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\tu-nl" * loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to 162 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(1,i,j,k) = q(k) repeat repeat close [1] repeat file = "c:\musprint\param21\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\tu-nl" * loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to 162 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(2,i,j,k) = q(k) repeat repeat close [1] repeat file = "c:\musprint\param06\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\tu-nl" * loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to 162 getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(3,i,j,k) = q(k) repeat repeat close [1] repeat &dA &dA &d@ &dE &dA &d@ &dE End of Initialization of parameters &dA &d@ &dE &dA putc Print score page(s) from Intermediate files putc LIBQ1: putc Source library? getc sourcelib sourcelib = trm(sourcelib) if sourcelib = "" goto LIBQ1 end if sourcelib con ":" or sourcelib{1} = "\" else getdir line sourcelib = line // "\" // sourcelib end putc starting page number getc f1 putc number of pages getc f2 &dA &dA &d@ Determine page labeling method &dA open [1,1] sourcelib LOOK_AGAIN: getf [1] temp temp = temp // pad(8) temp = temp{1,8} temp = trm(temp) i = int(temp) if i = 0 goto LOOK_AGAIN end naming_method = len(temp) close [1] sourcelib = sourcelib // "\" putc putc Since this is an edit program, we assume that you will be putc changing some files. You have the choice of overwriting the putc original files or of putting the modified files into a new library. putc If you specify a destination library, it must already exist; the putc program will not create it for you. putc putc Destination library? ( = overwrite sources) getc destlib destlib = trm(destlib) if destlib = "" destlib = sourcelib else if destlib con ":" or destlib{1} = "\" or destlib{1} = "/" else getdir line destlib = line // "\" // destlib end destlib = destlib // "\" end f3 = 0 BIG: f3 = f3 + 1 if f3 > f2 putc .b27 Y.b27 F... stop end file = sourcelib outfile = destlib if f1 < 10 and naming_method > 1 file = file // "0" outfile = outfile // "0" end if f1 < 100 and naming_method > 2 file = file // "0" outfile = outfile // "0" end if f1 < 1000 and naming_method > 3 file = file // "0" outfile = outfile // "0" end outfile = outfile // chs(f1) &dK &d@ if f1 < 10 &dK &d@ file = sourcelib // "0" // chs(f1) &dK &d@ else &dK &d@ file = sourcelib // chs(f1) &dK &d@ end &dK &d@ if f1 < 10 &dK &d@ outfile = destlib // "0" // chs(f1) &dK &d@ else &dK &d@ outfile = destlib // chs(f1) &dK &d@ end &dA &dA &d@ Initialize display strings &dA setup curstr,5,32,1,0,0,160,904 setup msgstr,160,120,1 setup redmsgstr,160,120,1 msgstr{341,160} = gline{1,160} msgstr{821,160} = gline{1,160} perform setupmsg activate msgstr,0,904,1 activate redmsgstr,0,904,4 setup gstr,300,3100,3,0,0,160,904 setup tstr2,160,1600,1,0,0,160,904 setup tstr3,160,1040,1,0,0,160,904 setup tstr4,160,910,1,0,0,160,904 setup red_gstr,300,3100,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 setup red_tstr3,160,1040,1,0,0,160,904 setup red_tstr4,160,910,1,0,0,160,904 bitmode 2, xze, yze xze >>= 3 &dA &dA &d@ Transfer source file to X table &dA #if REPORT putc Transferring page ~f1 to memory ... #endif ++f1 open [1,1] file treset [X] object_count = 0 super_count = 0 savecurnode = 0 loop for i = 1 to 2000 loop for k = 1 to 9 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 system_cnt = 0 nodelistcnt = 0 relob_cnt = 0 current_line = "" current_def = "" loop for k = 1 to 50000 getf [1] line 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 if trigger > 0 if nodenum < 6913 if trigger = 1 ++measnum trigger = 0 end if trigger = 2 if jtype = "R" and ntype = 9 and nodenum = 1 and oldrestx <> obx ++measnum else trigger = 0 end end end end curnode = 10000 * measnum + nodenum if jtype = "M" and curnode <> savecurnode and nodenum = 6913 i = savecurnode / 10000 if rem <> 6913 curnode = savecurnode end end pointers(object_count,9) = curnode if curnode <> savecurnode if savecurnode <> 0 i = object_count - 1 loop while pointers(i,9) = savecurnode pointers(i,3) = object_count /* forward pointer --i repeat while i > 0 xbacknode = xsavecurnode else xbacknode = object_count end savecurnode = curnode xsavecurnode = object_count &dA &dA &d@ Look for this node in the node list &dA xupnode = object_count loop for i = 1 to nodelistcnt if nodelist(i,1) = curnode /* this node has occured before xupnode = nodelist(i,2) nodelist(i,2) = object_count j = xupnode loop while pointers(j,9) = pointers(xupnode,9) pointers(j,6) = object_count /* adjust pointers from line above ++j /* to this line repeat goto NODEFOUND end repeat ++nodelistcnt /* add new node to list nodelist(nodelistcnt,1) = curnode nodelist(nodelistcnt,2) = object_count NODEFOUND: end pointers(object_count,4) = xbacknode /* backward pointer pointers(object_count,5) = xupnode /* pointer to line above pointers(object_count,6) = xsavecurnode /* pointer to line below if jtype = "B" and nodenum = 6913 trigger = 1 end if jtype = "R" and ntype = 9 and nodenum = 1 trigger = 2 oldrestx = obx end else if line{1} = "H" ++super_count supernum = int(line{3..}) tput [X,k] H ~super_count .t8 ~line{3..} super_pointers(super_count,1) = k super_pointers(super_count,3) = relob_cnt + 1 j = 0 loop for i = 1 to 200 if temp_store_ob(i,2) = supernum ++relob_cnt ++j related_objects(relob_cnt) = temp_store_ob(i,1) temp_store_ob(i,1) = 0 temp_store_ob(i,2) = 0 end repeat super_pointers(super_count,4) = j else tput [X,k] ~line if line{1} = "S" 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 end if line{1} = "L" linepoint = k measnum = 0 trigger = 1 list_order(k,3) = -1 list_order(k,5) = -1 end end end repeat eof1: close [1] list_order(1,1) = TOP_FLAG /* top of list indicator list_order(k-1,2) = BOTTOM_FLAG /* bottom of list indicator table_size = k - 1 obcursor = 1 if super_count = 0 supercursor = 0 else supercursor = 1 end perform setcurloc (obcursor,X_point) /* Start at first object #if REPORT putc Done! #endif f4 = k - 1 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 if i = 1 if f1 = 2 f1 = 1 f3 -= 1 else f1 -= 2 f3 -= 2 end else if i = 2 --f1 --f3 end end trap: if trp = 1 putc You have pushed to stop the program. You must now putc type "y" if you want the editing of current page to putc be stored in the output library. Any other key will exit putc without storing the edited version. putc Type "y" to save editing of the current page. getk k if k <> 0x010059 and k <> 0x010079 /* y or Y = yes putc .b27 Y.b27 F... putc putc &dA P R O G R A M H A L T E D putc stop end end if trp = 10 putc putc &dE TERMINATION NOTICE !!! putc putc The ESKPAGE program is unfortunately about to terminate abnormally. putc You have the option of saving the editing you have done on the current putc page. Type "y" to save editing of the current page. putc getk k if k <> 0x010059 and k <> 0x010079 /* y or Y = yes putc .b27 Y.b27 F... putc putc &dA P R O G R A M H A L T E D putc stop end end h = 1 TR1: g = list_order(h,1) if g <> TOP_FLAG h = g goto TR1 end open [8,2] outfile 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 putf [8] ~line g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto TR2 end close [8] if trp = 1 or trp = 10 putc .b27 Y.b27 F... putc putc Results saved in &dI~outfile putc putc &dA P R O G R A M H A L T E D putc stop end goto BIG &dAÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dAº º&d@ &dAº P R O C E D U R E S º&d@ &dAº º&d@ &dAÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ &dA &d@ &dA &dA &d@*P&dA 1. setbeam &dA &d@ &dA &dA &d@ Purpose: Typeset beams and accompanying notes and &dA &d@ stems. Also typeset accompanying tuplet, if present &dA &dA &d@ Note: There are two possible calling situations for this &dA &d@ procedure: (1) the slope and location of the beam &dA &d@ have already been determined, and (2) the slope and &dA &d@ location of the beam have not yet been determined. &dA &d@ The distinction can be made by looking at the value &dA &d@ of the @k calling variable. &dA &dA &dK &d@ Situation I: @k = stem direction for first note under &dA &dK &d@ &dKThis situation &d@ beam (0 = up; 1 = down) &dA &dK &d@ &dKno longer accepted&d@ @m = stem direction for second note under &dA &dK &d@ beam (0 = up; 1 = down) &dA &dA &d@ Situation II: @k = distance from first object (oby of &dA &d@ note group) to top of top beam (for &dA &d@ stems up) or bottom of bottom beam &dA &d@ (for stems down). @k > 0 means &dA &d@ stem up. &dA &d@ @m = number of dots the beam falls &dA &d@ (rises = negative) in a distance &dA &d@ of 30 horizontal dots. (i.e. &dA &d@ slope * 30) &dA &dA &d@ Inputs: bcount = number of notes under beam &dA &d@ beamdata(.,1) = x-position of note &dA &d@ beamdata(.,2) = y-position of note &dA &d@ beamcode(.) = beam code &dA &dA &d@ beam code = 6 digit number (string) &dA &dA &d@ 0 = no beam &dA &d@ 1 = continue beam &dA &d@ 2 = begin beam &dA &d@ 3 = end beam &dA &d@ 4 = forward hook &dA &d@ 5 = backward hook &dA &d@ 6 = single stem repeater &dA &d@ 7 = begin repeated beam &dA &d@ 8 = end repeated beam &dA &dA &d@ 100000's digit = eighth level beams &dA &d@ 10000's digit = 16th level beams &dA &d@ 1000's digit = 32nd level beams &dA &d@ 100's digit = 64th level beams &dA &d@ 10's digit = 128th level beams &dA &d@ 1's digit = 256th level beams &dA &dA &dA &d@ @k = (see note above) &dA &d@ @m = (see note above) &dA &d@ beamfont = font for printing beam &dA &d@ stemchar = character number for stem &dA &d@ beamh = height parameter for beams &dA &d@ beamt = vertical space between beams (normally vpar(32)) &dA &d@ qwid = width of quarter note (normally hpar(3)) &dA &d@ tupldata(1) = tuplet situation flag &dA &d@ tupldata(2) = tuplet number &dA &d@ tupldata(3) = x1 offset &dA &d@ tupldata(4) = x2 offset &dA &d@ tupldata(6) = y1 offset / For case where tuple goes over &dA &d@ tupldata(7) = y2 offset \ note heads &dAand&d@ there are chords. &dA &d@ tbflag = print tuplet flag &dA &dA &d@ Outputs: prints out beams, stems and notes by means of &dA &d@ procedures, printbeam, hook and revset. &dA &dA &d@ Internal variables: beamfy = y coordinate of first note under beam &dA &d@ @b = y-intercept of beam &dA &d@ @f = temporary variable &dA &d@ @g = temporary variable (related to @@g) &dA &d@ @h = temporary variable &dA &d@ @i = temporary variable &dA &d@ @j = temporary counter &dA &d@ @k = |@m| &dA &d@ @n = temporary variable &dA &d@ @q = temporary counter &dA &d@ @s = temporary variable &dA &d@ @t = temporary variable &dA &d@ @@b = vertical range of note set &dA &d@ @@g = top of staff line &dA &d@ @@n = temporary variable &dA &d@ @@q = temporary variable &dA &d@ bthick = thickness of beam - 1 &dA &d@ (x1,y1) = temporary coordinates &dA &d@ (x2,y2) = temporary coordinates &dA &d@ z1,z2,z3 = temporary character numbers &dA &d@ stemdir(80) = stem directions for mixed direction case &dA &d@ stemends(80) = stem endpoints for mixed direction case &dA &d@ beampos(8) = position of beam (mixed stem dir) &dA &d@ beamlevel = index into beampos(one for each note belonging to beam) &dA &d@ procedure setbeam 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 &dK &dK &d@ calling information &dK &dK &d@ dputc Calling information &dK &d@ loop for @b = 1 to bcount &dK &d@ putc .t10 x = ~beamdata(@b,1) .t20 y = ~beamdata(@b,2) .t30 beamcode = ~beamcode(@b) &dK &d@ repeat &dK &d@ dputc &dK &dA &dA &d@ check for errors in beam repeaters &dA loop for @j = 1 to bcount if beamcode(@j) con "7" or beamcode(@j) con "8" if bcount <> 2 putc Improper use of beam repeaters goto BERR end loop for @j = 1 to 6 if "270" con beamcode(1){@j} if beamcode(1){@j} = "2" if beamcode(2){@j} <> "3" putc Mismatching beamcodes goto BERR end end if beamcode(1){@j} = "7" if beamcode(2){@j} <> "8" putc Mismatching beamcodes goto BERR end end if beamcode(1){@j} = "0" if beamcode(2){@j} <> "0" putc Mismatching beamcodes goto BERR end end else putc Improper use of beam repeaters goto BERR end repeat @j = 10000 end repeat &dA &dA &d@ Determine direction of first stem &dA if @k = 0 or @k = 1 putc Old format for beams. This code has been disabled. putc Please run mskpage on data to get current format. putc putc &dAProgram Halted&d@ putc stop end if @k > 0 stem = UP else stem = DOWN end &dA &dA &d@ Check for situation where notes span two staves (grand staff) &dA staff_height = 0 if vst(f12) > 0 @g = beamdata(1,2) loop for @j = 2 to bcount if abs(beamdata(@j,2) - @g) > 500 staff_height = 10000 @j = 10000 end repeat end &dA &dA &d@ Adjust all y coordinates be relative to the top staff &dA loop for @j = 1 to bcount if beamdata(@j,2) - sq(f12) > 700 beamdata(@j,2) -= 1000 beamdata(@j,2) += vst(f12) if staff_height <> 10000 staff_height = vst(f12) end end repeat &dA &dA &d@ Check for mixed stem directions &dA mixflag = 0 loop for @j = 2 to bcount @h = beamdata(@j,1) - beamdata(1,1) * @m / 30 @h = @h + beamdata(1,2) - @k - beamdata(@j,2) if @h < 0 if stem = DOWN mixflag = 1 @j = 10000 end else if stem = UP mixflag = 1 @j = 10000 end end repeat &dA &dA &d@ Deal with tuplets attached to &dAnote heads&d@ &dA if tbflag = 1 @f = beamdata(bcount,1) - beamdata(1,1) @g = beamdata(bcount,2) - beamdata(1,2) * 30 @t = @g / @f @s = 0 @n = bcount - 1 loop for @i = 2 to @n @h = beamdata(@i,1) - beamdata(1,1) * @t / 30 + beamdata(1,2) @q = beamdata(@i,2) - @h if stem = DOWN @q = 0 - @q end if @q > @s @s = @q end repeat if stem = DOWN @j = vpar(39) + @s + sq(f12) y1 = beamdata(1,2) - @j y2 = beamdata(bcount,2) - @j if staff_height <> 10000 @h = 0 - notesize * 2 / 3 + staff_height if y1 > @h y1 = @h end if y2 > @h y2 = @h end end else @j = vpar(39) + vpar(38) + @s - sq(f12) y1 = beamdata(1,2) + @j y2 = beamdata(bcount,2) + @j if staff_height <> 10000 @h = 11 * notesize / 2 + staff_height if y1 < @h y1 = @h end if y2 < @h y2 = @h end end end sitflag = tupldata(1) a1 = tupldata(2) x1 = tupldata(3) + beamdata(1,1) - sp x2 = tupldata(4) + beamdata(bcount,1) - sp y1 += tupldata(6) y2 += tupldata(7) perform puttuplet end bthick = beamfont - 101 beamfy = beamdata(1,2) &dA &dA &d@ Reverse all y co-ordinates if first stem is down &dA @g = sq(f12) if stem = DOWN &dK &d@ @g = vpar(1) * 1000 - vpar(8) - @g @g = vpar(2) * 500 - vpar(8) - @g loop for @j = 1 to bcount &dK &d@ beamdata(@j,2) = vpar(1) * 1000 - beamdata(@j,2) beamdata(@j,2) = vpar(2) * 500 - beamdata(@j,2) repeat end @@g = @g &dA &dA &d@ Situation II: slope and location already determined &dA if stem = 1 @m = 0 - @m @k = 0 - @k end dv3 = @m * beamdata(1,1) dv3 = beamdata(1,2) - @k * hpar(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 = vpar(33) end &dA &dA &d@ End of situation II. &dA &dA &dA &d@ &dA &dA &d@ This is the printout portion of the procedure &dA &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ @m = hpar(1) * slope of beam &dA &dA &d@ @k = |@m| &dA &dA &d@ dv3 = y-intercept of top of beam (times hpar(1)) &dA &dA &d@ &dA &dA &dA &dA &d@ identify beam characters &dA z1 = @k + 33 if @m > 0 z1 += 128 end z2 = @k + 49 if @m > 0 z2 += 128 end &dA &dA &d@ check for tuplet over beam &dA if tbflag = 2 sitflag = tupldata(1) if bit(7,sitflag) = 1 /* curved bracket &dA03/15/97&d@ a4 = 0 - 2 * qwid / 3 if stem = UP a4 = qwid / 3 end else a4 = 0 - qwid / 3 if stem = UP a4 = 2 * qwid / 3 end end a1 = tupldata(2) x1 = beamdata(1,1) + a4 - sp + tupldata(3) x2 = beamdata(bcount,1) + a4 - sp + tupldata(4) y1 = @m * beamdata(1,1) + dv3 / hpar(1) y2 = @m * beamdata(bcount,1) + dv3 / hpar(1) if stem = DOWN &dK &d@ y1 = vpar(1) * 1000 - y1 - bthick - sq(f12) + vpar(39) + vpar(38) &dK &d@ y2 = vpar(1) * 1000 - y2 - bthick - sq(f12) + vpar(39) + vpar(38) y1 = vpar(2) * 500 - y1 - bthick - sq(f12) + vpar(39) + vpar(38) y2 = vpar(2) * 500 - y2 - bthick - sq(f12) + vpar(39) + vpar(38) else y1 = y1 - vpar(39) - sq(f12) y2 = y2 - vpar(39) - sq(f12) end y1 += tupldata(6) y2 += tupldata(7) perform puttuplet end &dA &dA &d@ Here the situation diverges &dA &dA &d@ Case I: all stems go in the same direction &dA &d@ Case II: stem directions are mixed &dA &dA &dA &d@ Case I: all stems go in the same direction &dA if mixflag = 0 &dA &dA &d@ put in first beam &dA x1 = beamdata(1,1) x2 = beamdata(bcount,1) if beamcode(1){1} = "7" x1 += hpar(59) x2 -= hpar(59) end perform printbeam &dA &dA &d@ put in vertical stems &dA loop for @j = 1 to bcount x1 = beamdata(@j,1) y1 = @m * x1 + dv3 / hpar(1) + vpar(42) y1 += vpar(4) y2 = beamdata(@j,2) z3 = stemchar if y1 >= y2 z3 += 2 y1 -= vpar(2) loop while y1 < y2 perform revset y1 += vpar(2) repeat else loop while y1 < y2 perform revset y1 += vpar(4) repeat end y1 = y2 perform revset repeat &dA &d@ &dA &d@ put in other beams &dA loop for @q = 2 to @@q if beamcode(1){@q} = "6" dv3 = vpar(2) * hpar(1) + dv3 else dv3 = beamt * hpar(1) + dv3 end loop for @j = 1 to bcount if "123456780" con beamcode(@j){@q} if mpt = 2 @i = @j BB1: ++@j if @j > bcount goto BERR end if "1234560" con beamcode(@j){@q} if mpt = 1 goto BB1 else if mpt = 3 * // print beam x1 = beamdata(@i,1) x2 = beamdata(@j,1) perform printbeam goto BBR * \\ else goto BERR end end end end if mpt = 7 * // print beam x1 = beamdata(1,1) + hpar(59) x2 = beamdata(2,1) - hpar(59) perform printbeam goto BBR * \\ end if mpt = 1 goto BERR end if mpt = 3 goto BERR end t1 = hpar(1) >> 1 if mpt = 4 * // print forward hook x1 = beamdata(@j,1) + hpar(29) y = @m * x1 + dv3 + t1 / hpar(1) z = z2 + 16 perform hook * \\ end if mpt = 5 * // print backward hook x1 = beamdata(@j,1) y = @m * x1 + dv3 + t1 / hpar(1) x1 -= hpar(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 / hpar(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 -= hpar(30) - hpar(29) - 10 /* = 7 y = y1 if @m > 0 y += int("000111111222222"{@m}) end if @m < 0 y -= int("000111111222222"{0-@m}) end z = z2 perform hook * \\ end end BBR: repeat repeat else &dA &dA &d@ Case II: stem directions are mixed &dA &dKDEBUG&d@ &dK &d@ dputc Calling information &dK &d@ loop for @b = 1 to bcount &dK &d@ putc .t10 x = ~beamdata(@b,1) .t20 y = ~beamdata(@b,2) .t30 beamcode = ~beamcode(@b) &dK &d@ repeat &dK &d@ dputc &dK &d@ getc &dKEND DEBUG&d@ &dA &dA &d@ 1. Determine definitive stem directions and end points &dA &d@ on main staff. &dA loop for @j = 1 to bcount x1 = beamdata(@j,1) y1 = @m * x1 + dv3 / hpar(1) + 4 /* middle of main beam y2 = beamdata(@j,2) /* oby of note if y1 < y2 stemdir(@j) = UP else stemdir(@j) = DOWN /* different x intersection if stem = UP /* direction of &dAfirst&d@ stem x1 -= qwid - hpar(29) else x1 += qwid - hpar(29) end y1 = @m * x1 + dv3 / hpar(1) + 4 end stemends(@j) = y1 repeat &dA &dA &d@ 2. Put in first beam &dA x1 = beamdata(1,1) /* stemdir(1) is always UP x2 = beamdata(bcount,1) if stemdir(bcount) = DOWN if stem = UP x2 -= qwid - hpar(29) else x2 += qwid - hpar(29) end end perform printbeam beampos(1) = dv3 &dA &dA &d@ 2a. Set beamlevel = 1 for all notes. beamlevel for notes will change &dA &d@ as we move through the beam. Basically, if notes A and B start &dA &d@ and end a beam respectively, then beamlevel will be given the &dA &d@ same value for all of these notes and any that might be in between. &dA &d@ If another beam extends between notes C and B, then beamlevel &dA &d@ for these notes will be increased. In the end, beamlevel for each &dA &d@ note will be the number of beams connecting or going through the &dA &d@ stem for that note. &dA loop for @j = 1 to bcount beamlevel(@j) = 1 repeat &dA &dA &d@ 3. Loop through notes, one at a time &dA loop for @j = 1 to bcount &dA &dA &d@ a. put in stem &dA x1 = beamdata(@j,1) if stemdir(@j) = DOWN if stem = UP x1 -= qwid - hpar(29) else x1 += qwid - hpar(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 += vpar(4) z3 = stemchar if y1 >= y2 z3 += 2 y1 -= vpar(2) loop while y1 < y2 perform revset y1 += vpar(2) repeat else loop while y1 < y2 perform revset y1 += vpar(4) repeat end y1 = y2 perform revset &dA &dA &d@ b. add &dAall&d@ extra beams starting at this note (and increase beamlevel accordingly) &dA &dA loop for @h = beamlevel(@j) + 1 to 6 if beamcode(@j){@h} = "2" /* begin beam ++beamlevel(@j) /* increment beamlevel for starting point loop for @g = @j + 1 to bcount if beamcode(@g){@h} = "3" /* end beam x1 = savex1 /* x1 needs to be reset for each beam x2 = beamdata(@g,1) /* if stemdir(bcount) = DOWN if stemdir(@g) = DOWN /* Correction &dA9-21-96&d@ if stem = UP x2 -= qwid - hpar(29) else x2 += qwid - hpar(29) end end dv3 = beampos(1) 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 * hpar(1)) else dv3 -= (beamt * hpar(1)) end beampos(beamlevel(@g)) = dv3 * // print beam perform printbeam &dA &dA &d@ c. adjust stem ends for notes under (over) this beam &dA loop for @f = @j + 1 to @g if stemdir(@j) = UP if stemdir(@f) = DOWN stemends(@f) += beamt end else if stemdir(@f) = UP stemends(@f) -= beamt end end repeat @g = 10000 else &dA &dA &d@ Increment beamlevel for all notes between endpoints of this beam &dA ++beamlevel(@g) end repeat if @g <> 10000 putc No termination found for beam goto BERR end else @h = 6 end repeat &dA &dA &d@ d. put in any hooks that might go with this note &dA loop for @h = beamlevel(@j) + 1 to 6 if "456" con beamcode(@j){@h} /* begin beam @g = mpt loop for @f = 1 to beamlevel(@j) if stemdir(@j) = UP if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat if @g = 3 t1 = vpar(2) * hpar(1) else t1 = beamt * hpar(1) end if stemdir(@j) = UP dv3 += t1 else dv3 -= t1 end t1 = hpar(1) >> 1 if @g = 1 * // print forward hook x1 = savex1 + hpar(29) y = @m * x1 + dv3 + t1 / hpar(1) z = z2 + 16 perform hook end if @g = 2 * // print backward hook x1 = savex1 y = @m * x1 + dv3 + t1 / hpar(1) x1 -= hpar(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 / hpar(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 -= hpar(30) - hpar(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 &dK &dK &d@ e. adjust beam level in case beams stop at this note &dK &dK &d@ if beamcode(@j) con "3" &dKThis code is superceded by making &dK &d@ beamlevel = mpt - 1 &dKbeamlevel an array variable, with &dK &d@ end &dKa value attached to every note &dK repeat end return BERR: putc Beam format error, printbeam aborted return &dA &d@ &dA &dA &d@*P&dA 2. hook &dA &d@ &dA &dA &d@ Purpose: Typeset hook beam &dA &dA &d@ Inputs: @m = slope * hpar(1) &dA &d@ x1 = horizontal position of note &dA &d@ y = vertical position of hook attachment &dA &d@ stem = stem direction &dA &d@ z = hook character &dA &d@ beamfont = type of font for beam &dA procedure hook x = x1 if stem = 1 &dK &d@ y = vpar(1) * 1000 - y - bthick y = vpar(2) * 500 - y - bthick z += 128 z &= 0xff else x += qwid - hpar(29) end scf = beamfont scx = x scy = y scb = z perform charout scf = notesize return &dA &d@ &dA &dA &d@*P&dA 3. printbeam &dA &d@ &dA &dA &d@ Purpose: Typeset beam &dA &dA &d@ Inputs: @m = slope * hpar(1) &dA &d@ x1 = starting point of beam &dA &d@ x2 = end point of beam &dA &d@ dv3 = y intercept of beam (times hpar(1)) &dA &d@ stem = stem direction &dA &d@ z1 = beam character number for this slop &dA &dA procedure printbeam int x3 x = x1 if stem = UP x += qwid - hpar(29) end scf = beamfont scx = x x2 = x2 + hpar(29) - hpar(1) y1 = @m * x1 + dv3 / hpar(1) if x2 < x1 and @k = 0 x2 = hpar(1) - hpar(2) + x2 /* no beam shorter than a "hook" y = y1 /* put out "overlapping" hooks if stem = DOWN &dK &d@ y = vpar(1) * 1000 - y - bthick y = vpar(2) * 500 - y - bthick else x2 += qwid - hpar(29) end PBEAM01: scy = y scb = 65 perform charout x += hpar(2) if x < x2 goto PBEAM01 end scx = x2 scb = 65 perform charout scf = notesize return end z = z1 if stem = DOWN z += 128 z &= 0xff end loop while x1 <= x2 y = y1 if stem = DOWN &dK &d@ y = vpar(1) * 1000 - y - bthick y = vpar(2) * 500 - y - bthick end scy = y scb = z perform charout x1 += hpar(1) y1 += @m repeat y2 = x2 + hpar(1) - x1 &dA &dA &d@ print fraction of beam &dA &d@ y2 = extra length needed to complete beam &dA if y2 = 0 scf = notesize return end y = y1 if stem = DOWN &dK &d@ y = vpar(1) * 1000 - y - bthick y = vpar(2) * 500 - y - bthick end &dA &d@ y = starting point if @k = 0 x = x1 - 30 + y2 if stem = UP x += qwid - hpar(29) end scx = x scy = y scb = 33 perform charout scf = notesize return end scy = y x3 = @k - 1 * 29 + y2 x2 = beamext(x3,1) y1 = 2 loop for y2 = 1 to x2 z = beamext(x3,y1) if @m > 0 z += 128 z &= 0xff end if stem = 1 z += 128 z &= 0xff end scb = z perform charout if y2 < x2 ++y1 x1 = beamext(x3,y1) if stem = 1 x1 = 0 - x1 end if @m > 0 x1 = 0 - x1 end y -= x1 scy = y ++y1 end repeat scf = notesize return &dA &d@ &dA &dA &d@*P&dA 4. revset &dA &d@ &dA &dA &d@ Purpose: Check for reversal of page and correct x y and z &dA &dA &d@ Inputs: x1 = horizontal position of note &dA &d@ y1 = vertical position of note &dA &d@ z3 = character to typeset &dA &d@ stem = stem direction &dA procedure revset x = x1 y = y1 z = z3 if stem = DOWN if z = 59 or z = 61 or z = 187 or z = 189 ++z end &dK &d@ y = vpar(1) * 1000 - y y = vpar(2) * 500 - y end perform setmus return &dA &d@ &dA &dA &d@*P&dA 5. setmus &dA &d@ &dA &dA &d@ Purpose: Typeset character &dA &dA &d@ Inputs: x = horizontal position of note &dA &d@ y = vertical position of note &dA &d@ z = character to typeset &dA procedure setmus int sy sy = y - pos(z-32) scx = x scy = sy scb = z perform charout return &dA &d@ &dA &dA &d@*P&dA 6. setwords &dA &d@ &dA &dA &d@ Purpose: Typeset words &dA &dA &d@ Inputs: x = horizontal position of words &dA &d@ y = vertical position of words &dA &d@ z = font number for words &dA &d@ line = words to set &dA &dA procedure setwords str textline.300 int t1 scx = x scy = y scf = z textline = line // " " A11: if textline con "\" if mpt > 1 t1 = mpt line2 = textline{1,mpt-1} perform lineout textline = textline{t1..} end if textline{2,2} in ['0'..'9'] if "123456789" con textline{3} t1 = mpt else if "123456789" con textline{2} t1 = mpt else t1 = 0 end end t1 += 176 line2 = chr(t1) else if textline{2} in ['0'..'9'] d1 = ors(textline{3}) if textline{2} = "0" d1 += 128 line2 = "" if d1 = 171 scx -= hpar(4) end if chr(d1) in [161..164,167,170,171,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] line2 = line2 // chr(d1) end else if textline{2} = "2" and "Oos" con textline{3} if mpt < 3 line2 = chr(d1+143) // "Oo"{mpt} else line2 = chr(175) end else if textline{2} = "7" and "Yy" con textline{3} line2 = chr(d1+124) // "Yy"{mpt} else d2 = int(textline{2}) d1 += wak(d2) if chr(d1) in [161..164,167,170,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] if textline{3} = "i" line2 = chr(d1) // chr(163) else line2 = chr(d1) // textline{3} end else line2 = textline{3} end end end end else d1 = ors(textline{2}) if textline{3} = "0" d1 += 128 line2 = "" if d1 = 171 scx -= hpar(4) end if chr(d1) in [161..164,167,170,171,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] line2 = line2 // chr(d1) end else if textline{3} = "2" and "Oos" con textline{2} if mpt < 3 line2 = chr(d1+143) // "Oo"{mpt} else line2 = chr(175) end else if textline{3} = "7" and "Yy" con textline{2} line2 = chr(d1+124) // "Yy"{mpt} else if textline{3} in ['1'..'9'] d2 = int(textline{3}) d1 += wak(d2) if chr(d1) in [161..164,167,170,173,175..191,193..205,207..211,213..223,225..237,239..243,245..255] if textline{2} = "i" line2 = chr(d1) // chr(163) else line2 = chr(d1) // textline{2} end else line2 = textline{2} end end end end end end end perform lineout if len(textline) > 3 textline = textline{4..} else textline = "" end goto A11 else line2 = textline perform lineout end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 6a. lineout &dA &d@ &dA &dA &d@ Purpose: Send a line of text to output device &dA &dA &d@ Inputs: line2 &dA &d@ z = font number for words &dA &dA &d@ Side effects: value of z may be changed &dA &d@ value of scf may be changed &dA procedure lineout int t1, t2, t3 str textline.300 AAA111: if line2 con "!" t1 = mpt if t1 > 1 if z <> notesize 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..}) z = fontmap(z) scf = z if sub <= len(line2) line2 = line2{sub..} goto AAA111 else return end else if z <> notesize 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 textline = line2 else textline = "" loop for t2 = 1 to len(line2) t3 = ors(line2{t2}) t3 = music_con(t3) textline = textline // chr(t3) repeat end perform stringout (textline) return &dA &d@ &dA &dA &d@*P&dA 7. settext &dA &d@ &dA &dA &d@ Purpose: Typeset text &dA &dA &d@ Inputs: x = horizontal position of note &dA &d@ y = vertical position of note &dA &d@ ttext = text to typeset &dA &dA &d@ Internal varibles: d1 = temporary variable &dA &d@ d2 = temporary variable &dA &d@ textline = working text string &dA &d@ line2 = text out string &dA &d@ out = command string &dA &dA procedure settext int t1 scx = x scy = y scf = mtfont textline = ttext // " " A1: if textline con "\" if mpt > 1 t1 = mpt line2 = textline{1,mpt-1} perform stringout (line2) textline = textline{t1..} end if textline{2,2} in ['0'..'9'] if "123456789" con textline{3} t1 = mpt else if "123456789" con textline{2} t1 = mpt else t1 = 0 end end t1 += 176 line2 = chr(t1) else if textline{2} in ['0'..'9'] d1 = ors(textline{3}) if textline{2} = "0" d1 += 128 line2 = "" if d1 = 171 scx -= hpar(4) end line2 = line2 // chr(d1) else if textline{2,2} = "2s" line2 = chr(175) else d2 = int(textline{2}) d1 += wak(d2) line2 = chr(d1) // textline{3} end end else d1 = ors(textline{2}) if textline{3} = "0" d1 += 128 line2 = "" if d1 = 171 scx -= hpar(4) end line2 = line2 // chr(d1) else if textline{2,2} = "s2" line2 = chr(175) else d2 = int(textline{3}) d1 += wak(d2) line2 = chr(d1) // textline{2} end end end end perform stringout (line2) textline = textline{4..} goto A1 else perform stringout (textline) end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 8. staff &dA &d@ &dA &dA &d@ Purpose: Typeset staff &dA &dA &d@ Inputs: y = absolute vertical location &dA &d@ sp = starting point of staff lines &dA &d@ syslen = length of staff lines &dA procedure staff int slen if notesize = 14 slen = 64 end if notesize = 6 slen = 32 end if notesize = 21 slen = 64 end d2 = sp + syslen - slen z = 81 loop for x = sp to d2 step slen perform setmus repeat x = d2 perform setmus return &dA &d@ &dA &dA &d@*P&dA 9. settie &dA &d@ &dA &dA &d@ Purpose: Typeset typeset tie &dA &dA &d@ Inputs: x1 = x-object coordinate of first note &dA &d@ y1 = y-object coordinate of first note (+1000 if on virtual staff) &dA &d@ tspan = distance spanned by tie &dA &d@ sitflag = situation flag &dA &d@ f12 = staff number &dA &dA &d@ Internal varibles: d1 = temporary variable &dA &d@ d2 = temporary variable &dA &d@ tiechar = first tie character &dA &d@ textend = tie extention character &dA &d@ hd = horizontal displacement &dA &d@ vd = vertical displacement &dA &d@ out = output string &dA procedure settie int d1,d2,d3,d4,d5 int virtoff label STL(4) &dA &dA &d@ 1) decode y-object coordinate of first note &dA virtoff = 0 if y1 > 700 y1 -= 1000 virtoff = vst(f12) end &dA &dA &d@ 2) complete sitflag &dA if notesize = 14 d5 = 254 end if notesize = 6 d5 = 110 end if notesize = 21 d5 = 381 end d1 = sitflag - 1 & 0x0c >> 2 + 1 goto STL(d1) STL(1): /* tips down, space if y1 < vpar(2) ++sitflag else if y1 = vpar(3) and tspan > d5 ++sitflag end end goto STLE STL(2): /* tips down, line if y1 < vpar(1) ++sitflag else if y1 = vpar(2) and tspan > d5 ++sitflag end end goto STLE STL(3): /* tips up, space if y1 > vpar(6) ++sitflag else if y1 = vpar(7) and tspan > d5 ++sitflag end end goto STLE STL(4): /* tips, line if y1 > vpar(5) ++sitflag else if y1 = vpar(6) and tspan > d5 ++sitflag end end STLE: &dA &dA &d@ 3) from sitflag and tspan, get tiechar, hd and vd &dA * putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag if tspan < 20 and notesize = 14 putc Error: Tie too short to print putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag getc return end if tspan < 10 and notesize = 6 putc Error: Tie too short to print putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag getc return end if tspan < 30 and notesize = 21 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 = 1 if notesize = 14 if tspan < 340 d2 = tspan / 2 - 8 end end if notesize = 6 if tspan < 170 d2 = tspan - 8 end end if notesize = 21 if tspan < 510 d2 = tspan + 1 / 3 - 8 end end *old d1 = (sitflag - 1) * 3 + 1 tiechar = tiearr(sizenum,d1,d2,d3) hd = tiearr(sizenum,d1,d2,d3+1) vd = tiearr(sizenum,d1,d2,d3+2) if sitflag > 8 vd = 0 - vd end &dA &dA &d@ 4) typeset tie &dA &d@ x = x1 + hd + sp y = y1 - vd + sq(f12) + virtoff scf = 300 scx = x scy = y scb = tiechar perform charout d1 = tiechar & 0x7f if notesize = 21 if d1 = 119 textend = tiechar + 5 ++tiechar goto EXT end if d1 = 121 textend = tiechar + 1 tiechar += 2 goto EXT end else if d1 = 109 textend = tiechar + 5 ++tiechar goto EXT end if d1 = 111 textend = tiechar + 1 tiechar += 2 goto EXT end end if notesize = 21 if d1 > 80 ++tiechar scb = tiechar perform charout end else if d1 > 90 ++tiechar scb = tiechar perform charout end end goto EXTa * EXT: vd = sitflag - 1 / 8 sitflag = rem + 1 hd = tspan vd = hd - expar(sitflag) + 8 / 8 scb = textend loop for tcnt = 1 to vd perform charout repeat vd = hd - expar(sitflag) + 16 / 8 vd = 16 - rem scx -= vd scb = tiechar perform charout * EXTa: scf = notesize return &dA &d@ &dA &dA &d@*P&dA 10. sethyph (level) &dA &d@ &dA &dA &d@ Purpose: Typeset hyphons &dA &dA &d@ Inputs: level = level of text line (usually 1) &dA &d@ x = absolute coordinate of terminating syllable &dA &d@ y = absolute coordinate text line &dA &d@ backloc(.) = location first space beyond last syllable &dA &d@ or location of first hyphon on next line &dA &dA &d@ Internal varibles: a,b,c,d &dA procedure sethyph (level) int level getvalue level scf = mtfont scy = y a = x - backloc(level) * a = distance over which to set hyphons b = 3 * hpar(6) if a < b if a >= hpar(17) if backloc(level) = hpar(15) scx = backloc(level) scb = ors("-") if a < hpar(6) perform charout goto CM end end b /= 2 if a > b b = a - hpar(17) + 3 * 2 / 5 a = b + backloc(level) scx = a scb = ors("-") perform charout a += b else a = a - hpar(17) + 3 / 2 + backloc(level) end scx = a scb = ors("-") perform charout else if x = hpar(9) scx = backloc(level) scb = ors("-") perform charout goto CM end end else if backloc(level) = hpar(15) b = 2 * a / hpar(6) + 1 c = a / b backloc(level) -= c a += c end b = a / hpar(6) c = a / b --b backloc(level) += c / 2 scx = backloc(level) scb = ors("-") perform charout loop for d = 1 to b backloc(level) += c scx = backloc(level) scb = ors("-") perform charout repeat end CM: scf = notesize return &dA &d@ &dA &dA &d@*P&dA 11. setunder (level) &dA &d@ &dA &dA &d@ Purpose: Typeset underline &dA &dA &d@ Inputs: level = level of text line (usually 1) &dA &d@ uxstop(.) = x-coordinate of end of line &dA &d@ uxstart(.) = x-coord. of first space beyond last syllable &dA &d@ or location of first hyphon on next line &dA &d@ y = y-coordinate for text line &dA &d@ underflag = execution flag, currently set for ties and &dA &d@ melismas &dA &d@ xbyte(.) = ending punctuation &dA &dA &d@ Internal varibles: a,b,c,d &dA procedure setunder (level) int level getvalue level if underflag = 0 return end x = uxstart(level) - hpar(19) scf = mtfont scx = x scy = y a = uxstop(level) - uxstart(level) * a = distance over which to set hyphons if a >= hpar(18) y -= vpar(13) scx = uxstart(level) scy = y scb = ors("_") b = uxstop(level) - underspc(sizenum) d = underspc(sizenum) loop for c = uxstart(level) to b step d perform charout repeat scx = b perform charout scx += 5 scy += vpar(13) end if underflag = 1 and xbyte(level) <> "_" scb = ors(xbyte(level)) perform charout end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 14. putslur &dA &d@ &dA &dA &dA &d@ Purpose: Typeset slur &dA &dA &d@ Inputs: (x1,y1) = starting note head &dA &d@ (x2,y2) = terminating note head &dA &d@ slur_edit_flag = flag indicating that y1 and/or y2 have been altered &dA &d@ postx = horiz. movement of slur after it has been chosen &dA &d@ posty = vert. movement of slur after it has been chosen &dA &d@ addcurve = flag indicating the curvature should be added &dA &d@ sitflag = situation flag &dA &d@ &dA &d@ bit clear bit set &dA &d@ -------------- ------------- &dA &d@ bit 0: full slur dotted slur &dA &d@ bit 1: stock slur custom slur &dA &d@ bit 2: first tip down first tip up &dA &d@ (*) bit 3: second tip down second tip up &dA &d@ (+) bit 4: compute stock slur hold stock slur &dA &d@ &dA &d@ (*) used on custom slurs only &dA &d@ (+) used on stock slurs only &dA &dA &d@ bit 5: continuous slur broken slur /* &dA03/15/97 &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA &d@ &dA &d@ &dA &d@ Internal variables: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 &dA &d@ c1,c2,c3,c4,c5,c6,c7 &dA procedure putslur &dA &dA &d@ determine case &dA a9 = bit(2,sitflag) a1 = a9 * 2 + 1 /* 1,1,3,3 if y1 < y2 ++a1 /* 1,2,3,4 = tips down rising, tips down falling, etc. end &dA &dA &d@ determine method of dealing with slurs stock vs. custon &dA if notesize = 14 a5 = 800 /* changed from 801 on &dA9-12-97&d@ end if notesize = 6 a5 = 400 /* changed from 801 on &dA9-12-97&d@ end if notesize = 21 a5 = 600 /* changed from 601 on &dA9-12-97&d@ end if x2 - x1 < a5 /* stock slurs SR5: &dK &d@ a5 = vpar(10) - y1 / vpar(1) /* height par of 1st note &dK &d@ a6 = vpar(10) - y2 / vpar(1) /* height par of 2nd note a5 = vpar(10) + vpar20 - y1 * 2 + 1 / vpar(2) - 20 a6 = vpar(10) + vpar20 - y2 * 2 + 1 / vpar(2) - 20 a7 = abs(a5-a6) &dA &dA &d@ determine whether to use the parametric method of slur placement &dA if a7 < 11 or (x2 - x1 < 100 and slur_edit_flag = 0) /* protopar file specific if a7 > 10 a7 -= 10 &dK &d@ a7 *= vpar(1) a7 = a7 + 20 * vpar(2) / 2 - vpar20 if a1 = 1 y1 -= a7 else if a1 = 2 y2 -= a7 else if a1 = 3 y2 += a7 else /* a1 = 4 y1 += a7 end end end goto SR5 end if a5 < 1 or a6 < 1 goto SR1 end if a5 > 11 or a6 > 11 goto SR2 end goto SR3 * adjust parameters upward SR1: a10 = a5 a11 = a6 if a6 < a5 a10 = a6 a11 = a5 end a10 = 1 - a10 /* minimum amount to raise pars if a7 < 10 a12 = a10 / 2 if a9 = 0 /* convex slur a10 += rem else if a11 + a10 > 3 a10 += rem end end end a5 += a10 a6 += a10 goto SR3 * adjust parameters downward SR2: a10 = a5 a11 = a6 if a6 > a5 a10 = a6 a11 = a5 end a10 -= 11 /* minimum amount to lower pars if a7 < 10 a12 = a10 / 2 if a9 = 1 /* concave slur a10 += rem else if a11 - a10 < 9 a10 += rem end end end a5 -= a10 a6 -= a10 SR3: &dA &dA &d@ get stock slur number and location &dA SR4: a7 = x2 - x1 if notesize = 14 if a7 < 10 --x1 ++x2 goto SR4 end end if notesize = 21 if a7 < 15 --x1 ++x2 goto SR4 end end if notesize = 6 if a7 < 5 --x1 ++x2 goto SR4 end end if notesize = 14 a7 = x2 - x1 / 2 - 2 /* a7 should be less than 399 end if notesize = 21 a7 = x2 - x1 + 1 / 3 - 2 /* a7 should be less than 199 end if notesize = 6 a7 = x2 - x1 - 2 /* a7 should be less than 399 end if notesize = 14 or notesize = 6 if a7 >= 399 putc Program Error examine return 10 end end if notesize = 21 if a7 >= 199 putc Program Error examine return 10 end end if notesize = 14 line2 = "c:\musprint\bitmap\slurs\c\" end if notesize = 21 line2 = "c:\musprint\bitmap21\slurs\c\" end if notesize = 6 line2 = "c:\musprint\bitmap06\slurs\c\" end &dA &d@ line2 = "c:\wbh\res\mus\prnt\bitmap\slurs\protopar\c\" line2 = line2 // chs(a5) // "\" // chs(a6) open [3,1] line2 loop for a8 = 1 to a7 getf [3] repeat getf [3] c1 c2 c3 c4 c5 c6 c7 .t1 line2 if a1 < 3 x1 += c2 y1 -= c3 a3 = c4 else x1 += c5 y1 += c6 a3 = c7 end close [3] x = x1 + sp y = y1 + sq(f12) else /* we don't use parametric method if a1 < 3 /* tips down c1 = y1 / vpar(2) if y1 > vpar(1) and rem = 0 &dK &d@ y1 -= vpar(1) y1 = (c1 - 1) * vpar(2) + vpar(1) end c1 = y2 / vpar(2) if y2 > vpar(1) and rem = 0 &dK &d@ y2 -= vpar(1) y2 = (c1 - 1) * vpar(2) + vpar(1) end a3 = abs(y1 - y2) /* rise y1 -= vpar(2) else c1 = y1 / vpar(2) if y1 < vpar(8) and rem = 0 y1 += vpar(1) /* OK 04-24-95 end c1 = y2 / vpar(2) if y2 < vpar(8) and rem = 0 y2 += vpar(1) /* OK 04-24-95 end a3 = abs(y1 - y2) /* rise y1 += vpar(2) end x = x1 + sp + vpar(2) y = y1 + sq(f12) a7 = x2 - x1 - vpar(1) /* length if notesize = 14 &dA &dA &dA &d@ For 14-dot slurs, the distribution of length for stock slurs is a follows &dA &dA &d@ Lengths Length Rise Number &dA &d@ in dots increments increments of types (possible) &dA &d@ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 8 to 18 2 2 6 &dA &d@ 20 to 196 4 2 12 &dA &d@ 200 to 392 8 2 24 &dA &d@ 400 to 784 16 2 48 &dA if a7 < 8 a7 = 8 end if a7 < 20 c1 = a7 / 2 if rem > 1 ++a7 end else if a7 < 200 c1 = a7 / 4 if rem > 1 ++x end a7 -= rem else if a7 < 400 c1 = a7 / 8 x += (rem >> 1) a7 -= rem else c1 = a7 / 16 x += (rem >> 1) a7 -= rem if rem > 11 x -= 8 a7 += 16 end if a7 >= 784 a7 = 784 end end end end &dA &dA &d@ For 14-dot slurs, &dA &dA &d@ Slur number = (rise * 1200) + (length * 3) + type number &dA &d@ number ranges from 8 to 143999 &dA c1 = a3 / 4 a3 -= rem if a1 > 2 y += rem end a3 = a3 * 1200 + (a7 * 3) + 1 end if notesize = 21 &dA &dA &dA &d@ For 21-dot slurs, the distribution of length for stock slurs is a follows &dA &dA &d@ Lengths Length Rise Number &dA &d@ in dots increments increments of types (possible) &dA &d@ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 12 to 27 3 2 6 &dA &d@ 30 to 294 6 2 12 &dA &d@ 300 to 600 12 2 24 &dA if a7 < 12 a7 = 12 end if a7 < 30 a7 = a7 + 1 / 3 * 3 else if a7 < 300 a7 = a7 + 1 / 6 * 6 rem >>= 1 x += rem else if a7 < 600 a7 = a7 + 3 / 12 * 12 rem >>= 1 x += rem else a7 = 600 end end end &dA &dA &d@ For 21-dot slurs, &dA &dA &d@ Slur number = (rise * 600) + (length * 2) + type number &dA &d@ number ranges from 8 to 143999 &dA c1 = a3 / 4 a3 -= rem if a1 > 2 y += rem end a3 = a3 * 600 + (a7 * 2) + 1 end end x += postx y += posty a3 += addcurve /* new 6-30-93 if notesize = 14 if a3 > 120000 goto NOSTOCK end end if notesize = 21 if a3 > 70000 goto NOSTOCK end end /* large gaps should now be supported &dA &dA &d@ a1 = case number &dA &d@ a3 = stock slur number &dA &d@ x = horizontal position &dA &d@ y = vertical position &dA &dA &dA &d@ Enter new code for acquiring and printing slur &dA perform printslur_screen (a1, a3, x, y, con3, sitflag) if a3 = 1000000 goto NOSTOCK end return end NOSTOCK: /* long slurs if a1 < 3 /* tips down c1 = y1 / vpar(2) if y1 > vpar(1) and rem = 0 y1 = (c1 - 1) * vpar(2) + vpar(1) end c1 = y2 / vpar(2) if y2 > vpar(1) and rem = 0 y2 = (c1 - 1) * vpar(2) + vpar(1) end a3 = abs(y1 - y2) /* rise y1 -= vpar(2) else c1 = y1 / vpar(2) if y1 < vpar(8) and rem = 0 y1 += vpar(1) /* OK 04-24-95 end c1 = y2 / vpar(2) if y2 < vpar(8) and rem = 0 y2 += vpar(1) /* OK 04-24-95 end a3 = abs(y1 - y2) /* rise y1 += vpar(2) end x = x1 + sp + vpar(2) + postx y = y1 + sq(f12) + posty a7 = x2 - x1 - vpar(1) /* length perform make_longslur (a7,a3,a1) /* length,rise,smode /* return: a7 = offset, a3 = height y = y - a7 scx = x scy = y c2 = 0 loop for i = 1 to a3 bt(i) = cbi(longslur(i)) c1 = bln(bt(i)) if c1 > c2 c2 = c1 end repeat * /* display slur contained in bt(a3) if con3 = 1 if con1 = 0 setb gstr,bt,scx,scy,a3,c2,1,3 else setb red_gstr,bt,scx,scy,a3,c2,1,1 end else if con1 = 0 clearb gstr,bt,scx,scy,a3,c2,1,3 else clearb red_gstr,bt,scx,scy,a3,c2,1,1 end end return &dA &d@ &dA &dA &d@*P&dA 15. puttuplet &dA &d@ &dA &dA &d@ Purpose: Typeset tuplet and/or bracket &dA &dA &d@ Inputs: x1 = horizontal starting point of tuplet/bracket &dA &d@ x2 = horizontal stopping point of tuplet/bracket &dA &d@ y1 = vertical starting point &dA &d@ y2 = vertical stopping point &dA &d@ a1 = tuplet number &dA &d@ &dA &d@ sitflag = situation flag bit clear bit set &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄ &dA &dA &d@ bit 0 no tuplet tuplet &dA &d@ bit 1 no bracket bracket &dA &d@ bit 2 tips down tips up &dA &dA &d@ bit 5 broken bracket continuous bracket /* &dA03/15/97 &dA &d@ bit 6 number outside number inside &dA &d@ bit 7 square bracket curved bracket &dA &d@ &dA &d@ &dA &d@ Calling variables to internal procedures: a1,a4,a5 &dA procedure puttuplet int f,xav,yav,h,k int t1,t2,t3,t4 x2 += notesize if bit(1,sitflag) = 1 &dK &d@ x2 = 2 * vpar(1) / 3 + x2 x2 = vpar(2) / 3 + x2 end a4 = x2 - x1 a4 = y2 - y1 * 60 / a4 xav = x1 + x2 / 2 yav = xav - x1 * a4 / 60 + y1 if and(3,sitflag) = 3 and yav < vpar(4) yav -= vpar(1) end &dA &d@ xav = x at center of tuplet/bracket &dA &d@ a4 = slope * 60 &dA &d@ yav = y at center of tuplet/bracket &dA &dA &d@ Part I: tuplet present &dA if bit(0,sitflag) = 1 x = xav y = yav + sq(f12) h = x - hpar(45) + (notesize / 3) k = x + hpar(45) - (notesize / 7) x = 0 - hpar(45) / 2 + x + sp &dA &dA &d@ New code (12/01/94) to deal with complex tuples &dA t4 = a1 t1 = t4 / 1000 t2 = rem if t1 > 0 t3 = 2 if t2 > 9 ++t3 end if t1 > 9 ++t3 end t4 = hpar(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 = hpar(45) * t3 + 1 >> 1 x -= t4 /* create space for double digits h -= t4 k += t4 end if bit(5,sitflag) = 1 /* &dA03/15/97&d@ numbers below or above if bit(6,sitflag) = 0 and bit(2,sitflag) = 0 y -= notesize else if bit(6,sitflag) = 1 and bit(2,sitflag) = 1 y -= notesize else y += notesize end end h = xav + 2 k = xav - 2 end scx = x scy = y &dA &dA &d@ Put out numerator of tuple &dA t3 = t2 / 10 t2 = rem if t3 > 0 a1 = t3 + 221 scb = a1 perform charout end a1 = t2 + 221 scb = a1 perform charout &dA &dA &d@ Put out denominator of tuple (if present) &dA if t1 > 0 a1 = 249 /* colon scb = a1 perform charout t3 = t1 / 10 t1 = rem if t3 > 0 a1 = t3 + 221 scb = a1 perform charout end a1 = t1 + 221 scb = a1 perform charout end end * * Part II: bracket present * if bit(1,sitflag) = 1 &dA &dA &d@ Square brackets &dA if bit(7,sitflag) = 0 * 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 * 2) case 1: tuplet present if bit(0,sitflag) = 1 yav -= vpar(40) 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 + sp y = y1 + sq(f12) 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: no tuplet present a1 = x2 - x1 + 2 / 3 * 3 x1 = 0 - a1 - 1 / 2 + xav y1 = x1 - xav * a4 + 6 / 12 + yav x = x1 + sp y = y1 + sq(f12) perform brackethook perform bracketline perform brackethook end else &dA &dA &d@ Curved brackets (slurs) /* &dA03/15/97&d@ &dA &dA &d@ Inputs: (x1,y1) = starting note head &dA &d@ (x2,y2) = terminating note head &dA &d@ slur_edit_flag = flag indicating that y1 and/or y2 have been altered &dA &d@ postx = horiz. movement of slur after it has been chosen &dA &d@ posty = vert. movement of slur after it has been chosen &dA &d@ addcurve = flag indicating the curvature should be added &dA &d@ sitflag = situation flag &dA &d@ &dA &d@ bit clear bit set &dA &d@ -------------- ------------- &dA &d@ bit 0: full slur dotted slur &dA &d@ bit 1: stock slur custom slur &dA &d@ bit 2: first tip down first tip up &dA &d@ (*) bit 3: second tip down second tip up &dA &d@ (+) bit 4: compute stock slur hold stock slur &dA &d@ &dA &d@ (*) used on custom slurs only &dA &d@ (+) used on stock slurs only &dA &dA &d@ bit 5: continuous slur broken slur /* &dA03/15/97 &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA &d@ t1 = sitflag x2 -= notesize if bit(2,t1) = 1 sitflag = 12 posty = 0 - vpar(5) else sitflag = 0 posty = vpar(3) end slur_edit_flag = 1 postx = 0 addcurve = 0 if bit(5,t1) = 0 /* broken slur t2 = k - h << 8 + 0x20 sitflag += t2 end perform putslur end end return * procedure brackethook if bit(2,sitflag) = 1 y = y - notesize + 2 end scx = x scy = y scb = 89 perform charout return &dA &d@ &dA &dA &d@*P&dA 16. bracketline &dA &d@ &dA &dA &d@ Purpose: typeset bracket line &dA &dA &d@ Inputs: a1 = length &dA &d@ a4 = slope &dA &d@ a5 = slope type 0,1,2,3,4,5 &dA &d@ x1 = x starting point &dA &d@ y1 = y starting point &dA &dA &d@ Outputs: x = x coordinate of end of line &dA &d@ y = y coordinate of end of line &dA procedure bracketline int h,i,k if a1 = 0 return end x = x1 + sp y = y1 + sq(f12) scf = 400 scx = x scy = y if a4 > 0 z = 184 + a5 end if a4 < 0 z = 164 + a5 end if a4 = 0 z = 161 end h = a1 / 12 k = rem if a4 = 0 loop for i = 1 to h x += 12 scb = z perform charout repeat else loop for i = 1 to h scb = z perform charout if a4 > 0 scy += a4 else h = 0 - a4 scy -= h end x += 12 y += a4 repeat end if k > 0 if k = 9 if a4 < 0 h = a4 - 1 * 2 / 3 z += 5 end if a4 > 0 h = a4 + 1 * 2 / 3 z += 5 end if a4 = 0 h = 0 ++z end end if k = 6 if a4 < 0 h = a4 - 1 / 2 z += 10 end if a4 > 0 h = a4 + 1 / 2 z += 10 end if a4 = 0 h = 0 z += 2 end end if k = 3 if a4 < 0 h = a4 - 1 / 3 z += 15 end if a4 > 0 h = a4 + 1 / 3 z += 15 end if a4 = 0 h = 0 z += 3 end end scb = z perform charout x += k y += h end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 17. putwedge &dA &d@ &dA &dA &d@ Purpose: Typeset wedge &dA &dA &d@ Inputs: x1 = horizontal starting point of wedge &dA &d@ x2 = horizontal stopping point of wedge &dA &d@ y1 = vertical starting point &dA &d@ y2 = vertical stopping point &dA &d@ c1 = starting spread of wedge &dA &d@ c2 = stopping spread of wedge &dA &d@ procedure putwedge int leng,slope,z1,clen,fullcnt int nex,h y1 -= vpar(1) y2 -= vpar(1) leng = x2 - x1 x = x1 + sp 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 + sq(f12) 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 + sq(f12) 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 + sq(f12) 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 + sq(f12) loop for h = 1 to nex z = tarr(h) scy = y scb = z perform charout repeat z = z1 + 31 loop for h = 1 to fullcnt scy = y scb = z perform charout --y repeat end scf = notesize return &dA &d@ &dA &dA &d@*P&dA 18. putfigcon &dA &d@ &dA &dA &d@ Purpose: Typeset figure continuation line &dA &dA &d@ Inputs: x1 = horizontal starting point of line &dA &d@ x2 = horizontal stopping point of line &dA &d@ a3 = vertical level of line &dA &d@ procedure putfigcon int g x = x1 + sp --a3 y = vpar(37) * a3 + vpar(36) + sq(f12) scx = x scy = y g = x2 - hpar(44) scb = 220 loop while x1 <= g perform charout x1 += hpar(44) repeat x = g + sp scx = x perform charout return &dA &d@ &dA &dA &d@*P&dA 19. puttrans &dA &d@ &dA &dA &d@ Purpose: Typeset octave transposition &dA &dA &d@ Inputs: x1 = horizontal starting point of transposition &dA &d@ x2 = horizontal stopping point of transposition &dA &d@ y1 = vertical level of transposition &dA &d@ a1 = length of ending hook &dA &d@ a3 = situation, 0 = 8av up, 1 = 8av down &dA &d@ procedure puttrans int h,j,k x = x1 + sp y = y1 + sq(f12) scx = x scy = y scb = 233 perform charout x += hpar(42) scx = x x1 += hpar(42) j = x2 - 20 k = 0 scb = 91 loop while x1 <= j k = 1 perform charout x1 += hpar(43) repeat h = hpar(43) / 2 x1 -= h if k = 1 if x1 <= j scx -= h perform charout end if a1 > 0 j = hpar(43) - hpar(1) scx -= j if a3 = 1 k = vpar(4) - 2 scy -= k end scb = 89 perform charout scy += notesize perform charout end end return &dA &d@ &dA &dA &d@*P&dA 20. putending &dA &d@ &dA &dA &d@ Purpose: Typeset ending &dA &dA &d@ Inputs: x1 = horizontal starting point of ending &dA &d@ x2 = horizontal stopping point of ending &dA &d@ y1 = vertical level of ending &dA &d@ a1 = length of start hook &dA &d@ a2 = length of ending hook &dA &d@ a3 = ending number, 0 = none &dA &d@ procedure putending int h if f12 > 1 return end x = x1 + sp y = y1 + sq(1) scx = x scy = y if a1 > 0 scb = 89 perform charout scy += notesize perform charout scy = y end if a3 > 0 scx += vpar(1) scy += vpar(4) scf = mtfont out = chs(a3) perform stringout (out) scb = 46 perform charout scf = notesize scx = x scy = y end h = x2 - hpar(1) scb = 90 loop while x1 <= h perform charout x1 += hpar(1) repeat x = h + sp scx = x perform charout if a2 > 0 scb = 89 perform charout scy += notesize perform charout end return &dA &d@ &dA &dA &d@*P&dA 21. putdashes &dA &d@ &dA &dA &d@ Purpose: Typeset dashes &dA &dA &d@ Inputs: x1 = horizontal starting point of dashes &dA &d@ x2 = horizontal stopping point of dashes &dA &d@ y1 = vertical level of dashes &dA &d@ a1 = spacing parameter &dA &d@ a2 = font designator &dA &d@ procedure putdashes int h int a,b,c,d,e b = x2 - x1 if b < 0 return end x = x1 + sp + hyphspc(sizenum) y = y1 + sq(f12) scf = a2 scx = x scy = y scb = 45 perform charout if a1 = 0 a = hyphspc(sizenum) * 5 c = b / a if c = 0 a1 = x2 - x1 c = 2 else if rem > hyphspc(sizenum) * 2 ++c end a1 = b / c end d = 1 else a = a1 c = b / a d = 0 end loop for e = 1 to c - 1 x += a1 scx = x perform charout if d = 1 b -= a1 --c if c > 0 a1 = b / c end end repeat scf = notesize return &dA &d@ &dA &dA &d@*P&dA 22. puttrill &dA &d@ &dA &dA &d@ Purpose: Typeset long trill &dA &dA &d@ Inputs: x1 = horizontal starting point of trill &dA &d@ x2 = horizontal stopping point of trill &dA &d@ y1 = vertical level of trill &dA &d@ a1 = situation 1 = no trill &dA &d@ 2 = trill with no accidental &dA &d@ 3 = trill with sharp &dA &d@ 4 = trill with natural &dA &d@ 5 = trill with flat &dA &d@ procedure puttrill int h x = x1 + sp y = y1 + sq(f12) h = x1 scx = x scy = y if a1 > 1 if a1 > 2 and a1 < 6 scb = int("..389"{a1}) + 210 /* music font scy = y - vpar(45) perform charout scy = y end x += hpar(41) scb = 236 perform charout scx = x h = x1 + hpar(41) end scb = 237 loop while h < x2 perform charout h += hpar(40) repeat return &dA &d@ &dA &dA &d@*P&dA 23. sysline &dA &d@ &dA &dA &d@ Purpose: Typeset left-hand system line &dA &dA &d@ Inputs: f11 = number of parts &dA &d@ sq(1) = y coordinate of first part &dA &d@ sq(f11) = y coordinate of last part &dA &d@ sp = x-coordinate of beginning of line &dA &d@ syscode = format for brace/bracket &dA &d@ procedure sysline int a1,a2,a3,a4,a5,a6,a7 if syscode = "" return end &dA &dA &d@ 1. typeset left-hand bar &dA x = sp z = 82 y1 = sq(1) y2 = sq(f11) brkcnt = 0 if f11 > 1 or vst(1) > 0 perform putbar (f11) end &dA &dA &d@ 2. typeset braces &dA a2 = 0 loop for a1 = 1 to len(syscode) if syscode{a1} = "[" x = sp - hpar(46) y1 = sq(a2+1) end if syscode{a1} = "]" y2 = sq(a2) z = 84 brkcnt = 0 perform putbar (a2) y = y1 z = 87 perform setmus y = y2 + vpar(8) + vst(a2) z = 88 perform setmus end if syscode{a1} = "." ++a2 end repeat &dA &dA &d@ 3. typeset brackets &dA x1 = x - hpar(47) a2 = 0 loop for a1 = 1 to len(syscode) if syscode{a1} = "{" y1 = sq(a2+1) end if syscode{a1} = "}" x = x1 y2 = sq(a2) + vpar(8) + vst(a2) a3 = y2 - y1 &dA &dA &d@ There are three cases: a3 <= 201 (one glyph) granularity = 6 &dA &d@ 202 <= a3 <= 402 (two glyphs) granularity = 12 &dA &d@ 403 <= a3 <= 570 (three glyphs) granularity = 12 &dA if a3 <= 201 a4 = a3 + 2 / 6 * 6 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 6 + 20 /* font number scx = x scy = y scb = a5 scf = 320 perform charout scf = notesize else if a3 <= 402 a4 = a3 + 5 / 12 * 12 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 12 + 10 * 2 /* font number a6 = a4 / 2 /* y increment to second glyph scx = x scy = y scb = a5 scf = 320 perform charout scy += a6 ++scb perform charout scf = notesize else a4 = a3 + 5 / 12 * 12 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 12 - 5 * 3 + 1 /* font number a6 = a4 - 384 /* y increment to third glyph scx = x scy = y scb = a5 scf = 320 perform charout scy += 192 ++scb perform charout scy += a6 ++scb perform charout scf = notesize end end end if syscode{a1} = "." ++a2 end repeat return &dA &d@ &dA &dA &d@*P&dA 24. putbar (t1) &dA &d@ &dA &dA &d@ Purpose: Typeset bar line &dA &dA &d@ Inputs: t1 = staff number of last line &dA &d@ y1 = coordinate of top of line &dA &d@ y2 = coordinate of last bar character &dA &d@ brkcnt = number of breaks in bar &dA &d@ barbreak(.,1) = y coordinate of top of break . &dA &d@ barbreak(.,2) = y coordinage of bottom of break . &dA &d@ x = x-coordinat of line &dA &d@ z = font character &dA procedure putbar (t1) int t1,t2 getvalue t1 if brkcnt = 0 t2 = y2 + vst(t1) loop for y = y1 to t2 step vpar(8) perform setmus repeat y = t2 perform setmus return end c3 = y1 loop for c1 = 1 to brkcnt c4 = barbreak(c1,1) - vpar(8) if c4 > c3 if c4 < y2 loop for y = c3 to c4 step vpar(8) perform setmus repeat y = c4 perform setmus c3 = barbreak(c1,2) end end repeat c4 = y2 + vst(t1) if c4 >= c3 loop for y = c3 to c4 step vpar(8) perform setmus repeat y = c4 perform setmus end return &dA &d@ &dA &dA &d@*P&dA 26a. printslur_screen &dA &d@ &dA &dA &d@ Purpose: read slur data from bigslur, compile and &dA &d@ send slur to screen &dA &dA &d@ Input: ori case: 1,2,3 or 4 &dA &d@ snum slur number &dA &d@ x x location &dA &d@ y y location &dA &d@ mode 1 = display, 0 = clear (cancel) &dA &d@ sitflag situation flag &dA &dA &d@ bit 5: continuous slur broken slur &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA procedure printslur_screen (ori,snum,x,y,mode,sitflag) str file.100,pointer.6,data.500 &dA &d@ bstr bt.800(150) &dAThis variable has been made 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 real rx * getvalue ori,snum,x,y,mode,sitflag if bit(5,sitflag) = 1 /* &dA03/15/97&d@ broksize = sitflag >> 8 else broksize = 0 end sitflag &= 0x01 &dA &d@ file = "c:\wbh\res\mus\prnt\bitmap\slurs\bigslur" if notesize = 14 file = "c:\musprint\bitmap\slurs\bigslur" end if notesize = 21 file = "c:\musprint\bitmap21\slurs\bigslur" end if notesize = 6 file = "c:\musprint\bitmap06\slurs\bigslur" end &dA &dA &d@ putc printslur called &dA &d@ putc file = ~file &dA &d@ putc ori = ~ori snum = ~snum x = ~x y = ~y &dA &d@ getc &dA open [1,5] file i = snum * 6 + 1 len(pointer) = 6 read [1,i] pointer offset = ors(pointer{1,4}) datalen = ors(pointer{5,2}) if datalen < 4 or datalen > 500 close [1] snum = 1000000 passback snum return end len(data) = datalen if offset = 0 close [1] snum = 1000000 passback snum return end read [1,offset] data n = ors(data{1,3}) if n <> snum close [1] snum = 1000000 passback snum return end nrows = ors(data{4}) slen = ors(data{5,2}) srise = ors(data{7}) bulge = ors(data{8}) slen += bulge /* &dAadded 11-19-92&d@ if bulge > 0 x -= bulge end i = 0 /* look for vert shift if ori = 1 i = nrows - 1 else if ori = 2 i = nrows - 1 - srise else if ori = 3 i = srise end end end y = y - i /* move screen cursor to point scx = x scy = y * if ori = 1 or ori = 2 dpnt = 9 else if slen < 256 dpnt = len(data) - 1 else dpnt = len(data) - 2 end end * maxn = 0 loop for i = 1 to nrows if slen < 256 cnt = 1 code = ors(data{dpnt,2}) if code & 0x8000 <> 0 cnt = 2 if ori > 2 dpnt = dpnt - 2 code = ors(data{dpnt,2}) end end sdpnt = dpnt loop for j = 1 to cnt code = code & 0x7fff rx = -.5 + sqt(flt(code)*2.0+.25) t = fix(rx+.0000001) kdata(j) = 255 - t t = t + 1 * t / 2 ndata(j) = code - t dpnt = dpnt + 2 if j < cnt code = ors(data{dpnt,2}) end repeat if ori > 2 dpnt = sdpnt - 2 end else cnt = 1 code = ors(data{dpnt,3}) if code & 0x800000 <> 0 cnt = 2 if ori > 2 dpnt = dpnt - 3 code = ors(data{dpnt,3}) end end sdpnt = dpnt loop for j = 1 to cnt code = code & 0x7fffff rx = -.5 + sqt(flt(code)*2.0+.25) t = fix(rx+.0000001) kdata(j) = 1000 - t t = t + 1 * t / 2 ndata(j) = code - t dpnt = dpnt + 3 if j < cnt code = ors(data{dpnt,3}) end repeat if ori > 2 dpnt = sdpnt - 3 end end * j = ndata(1) + kdata(1) bt(i) = zpd(ndata(1)) // npd(j) if cnt = 2 j = ndata(2) + kdata(2) bt(i) = bt(i) // zpd(ndata(2)) // npd(j) end if ori = 2 or ori = 3 bt(i) = bt(i) // zpd(slen) bt(i) = rev(bt(i)) bt(i) = trm(bt(i)) end n = bln(bt(i)) if n > maxn maxn = n end repeat * if sitflag = 1 j = maxn / gapsize if bit(0,j) = 0 --j end &dA &dA &d@ xxxxxxxxxxx....xxxx....xxxx....xxxx....xxxx....xxxxxxxxxxx &dA &d@ | odd number | &dA &d@ j = largest odd number of intervals that will fit inside maxn &dA j *= gapsize i = maxn - j i >>= 1 /* initial correction bt(250) = dup("1",i) // dotted{1,j} // dup("1",i+10) /* mask loop for i = 1 to nrows bt(i) = bnd(bt(i),bt(250)) repeat end * if broksize > 0 /* &dA03/15/97&d@ j = maxn - broksize >> 1 if j < 0 j = 0 end i = maxn - j - j bt(250) = dup("1",j) // dup("0",i) // dup("1",j) loop for i = 1 to nrows bt(i) = bnd(bt(i),bt(250)) repeat end close [1] /* display slur contained in bt(nrows) if mode = 1 /* con3 = 1 if con1 = 0 setb gstr,bt,scx,scy,nrows,maxn,1,3 else setb red_gstr,bt,scx,scy,nrows,maxn,1,1 end else if con1 = 0 clearb gstr,bt,scx,scy,nrows,maxn,1,3 else clearb red_gstr,bt,scx,scy,nrows,maxn,1,1 end end return * &dA &d@ &dA &dA &d@*P&dA 32. barline &dA &d@ &dA &dA &d@ Purpose: Typeset bar line &dA &dA &d@ Inputs: f11 = number of parts &dA &d@ sq(1) = y coordinate of first part &dA &d@ sq(f11) = y coordinate of last part &dA &d@ x = x-coordinate of line &dA &d@ z = bar character &dA &d@ syscode = format for bar &dA &d@ procedure barline int a1,a2 if z = 86 loop for a1 = 1 to f11 y = sq(a1) perform setmus repeat else a2 = 0 loop for a1 = 1 to len(syscode) if "[(" con syscode{a1} y1 = sq(a2+1) end if "])" con syscode{a1} y2 = sq(a2) + vpar(44) /* line thickness added &dA04-25-95&d@ perform putbar (a2) end if syscode{a1} = "." ++a2 end repeat end return &dA &dA &d@PEND &dA &dA &d@ ************************************************** &dA 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 strip6 if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure strip8 if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line{mpt} = "." end if line con " " line = line{mpt+1..} else line = "" end return * procedure save1 if htype = "V" &dA &dA &d@ structure of transp super-object: 4. situation: 0=8av up, 1=8av down &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from obj1 &dA &d@ 8. length of right vertical hook &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) tline = txt(line,[' '],lpt) y1 = int(tline) /* + superdata(k,2) if y1 > 700 y1 -= 1000 y1 += vst(f12) end tline = txt(line,[' '],lpt) a1 = int(tline) perform puttrans return end if htype = "E" &dA &dA &d@ structure of ending super-object: 4. ending number (0 = none) &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from staff lines &dA &d@ 8. length of left vertical hook &dA &d@ 9. length of right vertical hook &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) perform putending return end if htype = "D" &dA &dA &d@ structure of dashes super-object: 4. horiz. disp. from obj1 &dA &d@ 5. horiz. disp. from obj2 &dA &d@ 6. vert. disp. from staff lines &dA &d@ 7. spacing parameter &dA &d@ 8. font designator &dA tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) tline = txt(line,[' '],lpt) y1 = superdata(k,2) if y1 > 700 y1 = vst(f12) else y1 = 0 end y1 += int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) perform putdashes return end if htype = "R" &dA &dA &d@ structure of trill super-object: 4. situation: 1=no trill, 2=trill &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA &d@ 7. vert. disp. from obj1 &dA tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) tline = txt(line,[' '],lpt) y1 = int(tline) + superdata(k,2) if y1 > 700 y1 -= 1000 y1 += vst(f12) end perform puttrill return end if htype = "W" &dA &dA &d@ structure of wedge super-object: 4. left spread &dA &d@ 5. right spread &dA &d@ 6. horiz. disp. from obj1 &dA &d@ 7. beg. vert. disp. from staff &dA &d@ 8. horiz. disp. from obj2 &dA &d@ 9. end. vert. disp. from staff &dA tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) c3 = superdata(k,2) if c3 > 700 c3 = vst(f12) else c3 = 0 end y1 = int(tline) + c3 tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) a1 = x2 - x1 if a1 < hpar(39) x2 = x1 + hpar(39) end tline = txt(line,[' '],lpt) y2 = int(tline) + c3 perform putwedge return end return &dAÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dAº L O N G S L U R C O N S T R U C T I O N º&d@ &dAÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ procedure make_longslur (length,rise,smode) str out.2500 str map.2500(250),zeros.2500 bstr temp.2500 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(2500) &dA* I. Determine scaling factor if notesize = 14 SCALE = 1.0 else SCALE = flt(notesize) / 14.0 end &dA* II. Get rise and length limits getvalue length,rise,smode i = length - 1 X = flt(i) Y = flt(rise) X = X / SCALE /* &dA05-12-95&d@ all computations done Y = Y / SCALE /* at original size. length = length * 14 / notesize /* clear slur array loop for i = 1 to 250 map(i) = pad(2500) repeat &dA &dA &d@ &dEBeginning of slur generation&d@ &dA &dAÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dA³ P A R A M E T R I C M A G I C ³&d@ &dAÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ rtype = 2.0 if X < 600.0 H = X * .03 + 9.0 + (1.9 * rtype) else H = 27.0 + (1.9 * rtype) end if X > 1200.0 H = H + (X - 1200.0 / 200.0) end rtype -= 1.0 L = X * X + (Y * Y) L = sqt(L) a = rtype / 75. W = L * (.66 - a) /* experimental value &dA &dA &d@ compute R, P, A, B, Cx, Cy, Ca, Cb and check limitations &dA &dA &d@ 1. Q: &dA if X > 300.0 Q = 15.0 else Q = 13.0 end LS_PAA: &dA &dA &d@ 2. R = L*L/Q/8 + Q/2 &dA &d@ x = L * L / Q / 8.0 y = Q / 2.0 R = x + y &dA &dA &d@ 3. P = R - (R*R - (W*W/4))^1/2 component of height from &dA &d@ middle section x = (R * R) - (W * W / 4.0) P = R - sqt(x) y = (L - W) / 2.0 + P if H > y H = y end if H < Q H = dec(Q) + .5 end &dA &dA &d@ 4. A = (L - W) / 2 B = H - P = transition point &dA A = (L - W) / 2.0 B = H - P &dA &dA &d@ 5. Cx = X/2 Cy = R - H = center of main arc &dA Cx = L / 2.0 Cy = H - R /* a negative number &dA &dA &d@ 6. Compute = center of starting arc &dA &dA &d@ [ B*(Cx-A)/(Cy-B) + (A*A + B*B)/2/A - A ] &dA &d@ Cb = ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ [ B/A + (Cx-A)/(Cy-B) ] &dA &dA &d@ Ca = (A*A + B*B)/2/A - B*(Cb)/ A &dA a = (Cx - A) / (Cy - B) b = (A * A) + (B * B) b = b / 2.0 / A Cb = (B * a + b - A) / (B / A + a) Ca = b - (B * Cb / A) &dA &dA &d@ normalize D-function &dA xx = L / 2.0 D = sqt(xx) / 4.8 if D > 1.50 D -= .16 /* radical if H / L > .200 D -= .10 end end if D > 1.70 D = D - 1.70 * .2 + 1.70 end if D > 1.95 D = D - 1.95 * .3 + 1.95 end if D > 2.25 D = D - 2.25 * .4 + 2.25 end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 1 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ º sqt(A*A + B*B) º &dA &d@ 1. compute beta = 2 * sin-1ºÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĺ sweep angle &dA &d@ º 2*sqt(Ca*Ca + Cb*Cb)º &dA a = A * A + (B * B) b = Ca * Ca + (Cb * Cb) c = sqt(b) beta = rtype / 7.5 if L >= 400. delta = L * .001 else delta = L * .006 - 2.00 end if R / c > 3.00 - beta + delta Q += .1 if Q < H - .5 goto LS_PAA end end c = sqt(a/b) beta = 2.0 * ars(c/2.0) &dA &dA &d@ 2. compute delta so that sweep hits every dot &dA a = sqt(a) /* length of arc (approx) delta = beta / a / 2.0 scnt = 0 alpha = 0.0 &dA &dA &d@ 3. begin sweep &dA LS_SW1A: a = 1.0 - cos(alpha) b = sin(alpha) x = Ca * a - (Cb * b) y = Ca * b + (Cb * a) if x < A ++scnt sx(scnt) = x sy(scnt) = y alpha += delta goto LS_SW1A end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 2 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. compute beta2 = sin-1{ [(L/2)-A] / R } &dA a = L / 2.0 - A / R beta2 = ars(a) &dA &dA &d@ 2. compute delta so that sweep hits every dot &dA delta2 = beta2 * 2.0 / W / 2.0 alpha = 0.0 - beta2 &dA &dA &d@ 3. begin sweep &dA LS_SW2A: x = R * sin(alpha) + Cx y = R * cos(alpha) + Cy if x < L - A ++scnt sx(scnt) = x sy(scnt) = y alpha += delta2 goto LS_SW2A end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 3 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. beta and delta already computed &dA alpha = beta &dA &dA &d@ 2. begin sweep &dA LS_SW3A: a = 1.0 - cos(alpha) b = sin(alpha) x = L - (Ca * a) + (Cb * b) y = Ca * b + (Cb * a) if x < L ++scnt sx(scnt) = x sy(scnt) = y alpha -= delta goto LS_SW3A end ++scnt sx(scnt) = L sy(scnt) = 0.0 &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ E N D O F S W E E P S. C O N S T R U C T S L U R ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. rotate data to produce rise &dA a = X / L b = Y / L loop for i = 1 to scnt x = sx(i) * a - (sy(i) * b) y = sx(i) * b + (sy(i) * a) sx(i) = x sy(i) = y repeat &dA &dA &d@ 2. setup thickness parameters &dA pc = length * 60 / (length + 400) /* carefully worked out formula &dA05/13/95 pd = pc * 3 / 10 pe = scnt - pc pf = scnt - pd pg = 50 * scnt / 100 if length < 400 ph = 0 else ph = (length - 400) * scnt * 4 / 40000 end &dA &dA &d@ 3. compute ind, outd &dA loop for i = 1 to scnt if i < pc /* left hand side of slur ind = 0.6 if i < pd /* extreme left end outd = flt(i) / flt(pc) + .1 else outd = 0.4 end if notesize = 14 outd += .4 end goto LS_PCD end if i > pe /* right hand side of slur ind = 0.6 if i >= pf /* extreme right end j = scnt - i outd = flt(j) / flt(pc) + .1 else outd = 0.4 end if notesize = 14 outd += .4 end goto LS_PCD end /* middle of slur if i > pg + ph /* right side j = pe - i s = pe - pg - ph else /* left side if i < pg - ph j = i - pc s = pg - pc - ph else s = 10000 j = 9999 end end b = flt(j) * ars(1.0) / flt(s) /* max(b) = sin-1(1) a = sin(b) if notesize = 14 outd = D - .8 * a + .8 ind = D - .6 * a + .6 end if notesize = 21 outd = D - 0.4 * a + 0.4 ind = D - 0.6 * a + 0.6 outd += .29000 ind += .89000 end &dA &dA &d@ 4. compute outside point, inside point &dA LS_PCD: x = sx(i) y = sy(i) &dA &dA &d@ give finite width to slur &dA if i < scnt u = sx(i+1) v = sy(i+1) else u = x v = y end if i > 1 xx = sx(i-1) yy = sy(i-1) else xx = x yy = y end u -= xx /* delta x v -= yy /* delta y c = u * u + (v * v) c = sqt(c) /* delta hypotinus a = outd / c b = ind / c outpx = x - (a * v) outpy = y + (a * u) inpx = x + (b * v) inpy = y - (b * u) &dA &dA &d@ 5. compute box coordinates &dA if outpx < inpx a = outpx outpx = inpx inpx = a end if outpy < inpy a = outpy outpy = inpy inpy = a end outpx = outpx + 30.0 /* - .5 inpx = inpx + 30.0 /* - .5 outpy = outpy + 20.0 - 1.0 inpy = inpy + 20.0 + .5 x1 = fix(inpx) x2 = fix(outpx) y1 = fix(inpy) y2 = fix(outpy) if x2 - x1 < 2 ++y2 /* radical end &dA &dA &d@ 6. set points inside box to 1 (with inverted vertical axis) &dA &dA &dA &d@ Here is where you scale the slur back to its original size &dA x1 = x1 * notesize / 14 x2 = x2 * notesize / 14 y1 = y1 * notesize / 14 y2 = y2 * notesize / 14 loop for j = y1 to y2 q = 250 - j loop for k = x1 to x2 map(q){k} = "x" repeat repeat repeat &dA &dA &d@ &dEEnd of slur generation&d@ &dA /* determine size of map display loop for i = 1 to 250 map(i) = trm(map(i)) if map(i) <> "" goto LS_CE end repeat LS_CE: y1 = i loop for j = i to 249 map(j+1) = trm(map(j+1)) if map(j) = "" and map(j+1) = "" goto LS_CF end repeat LS_CF: y2 = j - 1 loop for j = 1 to 2500 loop for i = y1 to y2 if map(i){j} = "x" goto LS_CH end repeat repeat LS_CH: x1 = j x2 = 0 loop for i = y1 to y2 if x2 < len(map(i)) x2 = len(map(i)) end repeat /* write slur to newout x2 = x2 - x1 /* x range j = 0 if smode < 3 loop for i = y1 to y2 map(i) = map(i) // pad(2500) 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(2500) out = map(i){x1,x2} if smode = 3 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat end if smode = 1 length = j - 1 else if smode = 2 length = j - 1 - rise else if smode = 3 length = rise else length = 0 end end end rise = j passback length,rise /* length = initial offset; rise = number of rows return &dA &d@ &dIÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dA &d@ &dIº º&d@ &dA &d@ &dIº PROCEDURES ADDED FOR SCREEN DISPLAY º&d@ &dA &d@ &dIº º&d@ &dA &d@ &dIÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ * procedure stringout (out) str out.100 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}) + fontoff setb gstr,FA,scx,scy,k,1 repeat else loop for i = 1 to len(out) k = ors(out{i}) + fontoff setb red_gstr,FA,scx,scy,k,1 repeat end if con2 > 0 and conx2 < scx + 10 conx2 = scx + 10 end else if con1 = 0 loop for i = 1 to len(out) k = ors(out{i}) + fontoff clearb gstr,FA,scx,scy,k,1 repeat else loop for i = 1 to len(out) k = ors(out{i}) + fontoff clearb red_gstr,FA,scx,scy,k,1 repeat end end return procedure charout int font,k,i,j font = revmap(scf) k = font - 1 * 256 + scb &dA &dA &d@ putc k = ~k font = ~font /* &dADEBUG&d@ &dA if con3 = 1 if con2 > 0 and con2 <> 5 if conx1 > scx - 10 conx1 = scx - 10 end if cony1 > scy - hght(font) cony1 = scy - hght(font) end if cony2 < scy + dpth(font) cony2 = scy + dpth(font) end end if con1 = 0 setb gstr,FA,scx,scy,k,1 else setb red_gstr,FA,scx,scy,k,1 end if con2 > 0 and conx2 < scx + 40 conx2 = scx + 40 end else if con1 = 0 clearb gstr,FA,scx,scy,k,1 else clearb red_gstr,FA,scx,scy,k,1 end end return procedure pan (flag) int k,h,j int x(4),y(4) int flag int sflag,oldsflag int wflag2,wflag3,wflag4 int px,py int t1,t2 int font,color,scflag 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,904,1 activate redmsgstr,0,904,4 PPQ: if sflag = 1 x2cur = 8 * px + xcur y2cur = py + ycur else if sflag = 2 x2cur = 8 * px + (xcur / 2) y2cur = py + (ycur / 2) else if sflag = 3 x2cur = 8 * px + (xcur / 3) y2cur = py + (ycur / 3) else x2cur = 8 * px + (xcur / 4) y2cur = py + (ycur / 4) end end end if x2cur < LMARG h = LMARG - x2cur + 7 / 8 + 9 / 10 * 10 x(sflag) += h goto PPP end if x2cur > RMARG h = x2cur - RMARG + 7 / 8 + 9 / 10 * 10 x(sflag) -= h goto PPP end if y2cur < TMARG h = TMARG - y2cur + 79 / 80 * 80 y(sflag) += h goto PPP end if y2cur > BMARG h = y2cur - BMARG + 79 / 80 * 80 y(sflag) -= h goto PPP end clearb curstr, CURSOR, acur, bcur, 1, 1 x2cur -= 30 y2cur -= 10 x2cur = x2cur / 8 acur = rem bcur = 0 setb curstr, CURSOR, acur, bcur, 1, 1 activate curstr, x2cur, y2cur, 3 &dA &dA &d@ Display current line &dA if cmode = "h" and supercursor > 0 a = super_pointers(supercursor,1) else a = X_point end tget [X,a] new_line .t8 jtype .t8 temp .t3 g g g if "JH" con new_line{1} new_line = new_line{1,2} // new_line{8..} end font = 200 color = 4 scflag = 0 scx = MSGTAB2B scy = MSGROW2 perform msgout (current_line,font,color,scflag) scflag = 1 scx = MSGTAB2B scy = MSGROW2 perform msgout (new_line,font,color,scflag) current_line = new_line &dA &dA &d@ Display current definition &dA new_def = "" if current_line{1} = "K" new_def = sub_def(g) // " sub-object" end if current_line{1} = "J" if "BCKTDSNRGQFIM" con jtype new_def = obj_def(mpt) // " object" end end if current_line{1} = "H" mpt = 1 line = txt(temp,[' ']) line = txt(temp,[' ']) if "BTSXWDERVFN" con line{1} new_def = super_def(mpt) // " super-object" end end if current_line{1} = "W" new_def = "Word(s) sub-object" end if current_line{1} = "T" new_def = "Text sub-object" end if current_line{1} = "L" new_def = "Lines (musical staff)" 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 = 137 color = 4 scflag = 0 scx = MSGTAB2A scy = MSGROW1 perform msgout (current_def,font,color,scflag) scflag = 1 scx = MSGTAB2A scy = MSGROW1 perform msgout (new_def,font,color,scflag) current_def = new_def NOOP: getk k oldsflag = sflag NEWK: if k = 0x03040a /* activate gstr,0,0,5 activate gstr,0,0,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 flag = 1 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x030810 /* activate gstr,0,0,5 activate gstr,0,0,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 flag = 2 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x03080c /* activate gstr,0,0,5 activate gstr,0,0,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x01001b /* putc .b27 Y.b27 F... return 1 end &dA &dA &d@ &dA ReDraw Command &dA if k = 0x010052 or k = 0x010072 /* r or R = redraw activate gstr,0,0,0 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct goto PPP end &dA &dA &d@ &dA Cancel Command &dA if k = 0x010043 /* C = cancel if trecord_cnt = 0 goto NOOP end h = 1 CC1: g = list_order(h,1) if g <> TOP_FLAG h = g goto CC1 end &dA &dA &d@ Here is where you cancel all changes &dA CC3: a = list_order(h,4) if a <> 0 list_order(h,4) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto CC3 end setup red_gstr,300,3100,1,0,0,160,904 if wflag4 <> 0 setup red_tstr4,160,910,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 else if wflag2 <> 0 setup red_tstr2,160,1600,1,0,0,160,904 end end if wflag3 <> 0 setup red_tstr3,160,1040,1,0,0,160,904 end activate red_gstr,px,py,4 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 treset [X2] trecord_cnt = 0 con1 = 0 /* construct on gstr con2 = 0 /* full construction con3 = 1 /* use setb con4 = 0 /* display entire page perform construct goto PPP end &dA &dA &d@ &dA Save Command &dA if k = 0x010053 or k = 0x010073 /* s or S = save if trecord_cnt = 0 goto NOOP end h = 1 SS1: g = list_order(h,1) if g <> TOP_FLAG h = g goto SS1 end hh = h SS2: if list_order(h,5) = -1 list_order(h,3) = -1 list_order(h,5) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto SS2 end &dA &d@ &dA &d@ Here is where you turn off the things that have been moved &dA &d@ con1 = 0 /* construct on black con2 = 5 con3 = 0 /* use clearb con4 = 0 perform construct &dA &d@ &dA &d@ Here is where you re-display the things that are moved &dA &d@ con1 = 0 /* construct on black con2 = 3 /* selective construction, with staff lines con3 = 1 /* use setb perform construct &dA &dA &d@ Here is where you copy modified records back to the main table &dA h = hh SS3: a = list_order(h,4) if a <> 0 tget [X2,a] line line = trm(line) tput [X,h] ~line list_order(h,4) = 0 end g = list_order(h,2) if g <> BOTTOM_FLAG h = g goto SS3 end setup red_gstr,300,3100,1,0,0,160,904 if wflag4 <> 0 setup red_tstr4,160,910,1,0,0,160,904 setup red_tstr2,160,1600,1,0,0,160,904 else if wflag2 <> 0 setup red_tstr2,160,1600,1,0,0,160,904 end end if wflag3 <> 0 setup red_tstr3,160,1040,1,0,0,160,904 end activate red_gstr,px,py,4 sflag = 1 if oldsflag = 1 or oldsflag = 0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 oldsflag = 1 end wflag2 = 0 wflag3 = 0 wflag4 = 0 treset [X2] trecord_cnt = 0 goto PPP end &dA &dA &d@ &dA &dA &d@ &dA Editing commands &dA &d@ &dA &dA if (k >= 0x03010d and k <= 0x03011c) /* various combinations of alt     /* also cont-shft     if (k >= 0x03010d and k <= 0x030110) incre = 1 else incre = 3 end if cmode = "g" if (k = 0x03010d or k = 0x03010f or (k >= 0x030111 and k <= 0x030114)) else goto PPQ end &dA &dA &d@ Flag all members of "group" for purposes of turning off glyphs &dA g = pointers(obcursor,5) loop h = g g = pointers(h,5) repeat while g <> h con4 = pointers(h,8) /* pointer to system record for this system GRP11: g = pointers(h,1) /* pointer to table a = list_order(g,4) if a = 0 tget [X,g] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X2,a] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end list_order(g,3) = -1 list_order(g,5) = -1 &dA &dA &d@ Flag all super-objects &dA if supcnt > 0 b = g a = 0 /* super-object counter GRP13: b = list_order(b,2) c = list_order(b,4) if c > 0 tget [X2,c] tbyte .t8 supernum else tget [X,b] tbyte .t8 supernum end if tbyte <> "H" goto GRP13 end loop for d = 1 to supcnt if o(d) = supernum list_order(b,3) = -1 /* flag super object record list_order(b,5) = -1 o(d) = 0 ++a /* increment super-object counter if a = supcnt goto GRP12 else goto GRP13 end end repeat goto GRP13 /* this super-object is not on list end &dA &dA &d@ Flag all associated sub-object &dA GRP12: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte list_order(g,3) = -1 list_order(g,5) = -1 goto GRP12 end if pointers(h+1,9) = pointers(h,9) ++h goto GRP11 end g = h h = pointers(g,6) if h > g goto GRP11 end &dA &d@ &dA &d@ Here is where you turn off the things that will be moved &dA &d@ con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct &dA &dA &d@ Now look at group again; adjust position of members of "group" &dA g = pointers(obcursor,5) loop h = g g = pointers(h,5) repeat while g <> h GRP1: g = pointers(h,1) /* pointer to table a = list_order(g,4) if a = 0 ++trecord_cnt list_order(g,4) = trecord_cnt tget [X,g] line .t10 line2 a = trecord_cnt else tget [X2,a] line .t10 line2 end &dA &dA &d@ Increase (decrease) the x-coordinate of this object &dA sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 c += incre else c -= incre end line = line{1,9} // chs(b) // " " // chs(c) // line2{sub..} tput [X2,a] ~line &dA &dA &d@ Incremented backward (forward) all associated text records &dA GRP2: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte if mpt = 2 &dA &dA &d@ Backup (advance) x-coordinate of text sub-object &dA 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 GRP2 end if pointers(h+1,9) = pointers(h,9) ++h goto GRP1 end g = h h = pointers(g,6) if h > g goto GRP1 end &dA &d@ &dA &d@ Here is where you re-display the things that are moved &dA &d@ con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 1 /* use setb perform construct if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,4 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,4 end end if wflag4 = 1 conx1 >>= 1 cony1 >>= 1 conx2 >>= 1 cony2 >>= 1 dscale2 red_tstr2, red_tstr4, conx1, cony1, conx2, cony2 if sflag = 4 activate red_tstr4,px,py,4 end end goto PPQ end &dA &dA &d@ End of "group" movement &dA if cmode = "j" goto JAC0 end if cmode = "x" tget [X,X_point] line if line{1} = "J" goto JAC00 end if "X" con line{1} con4 = X_point /* pointer to system record for this system list_order(X_point,3) = -1 list_order(X_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end sub = 3 b = int(line{sub..}) c = int(line{sub..}) d = int(line{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 or k = 0x030117 c += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 or k = 0x030115 c -= incre else if k = 0x03010e or k = 0x030119 or k = 0x03011b or k = 0x030116 d -= incre else d += incre end end end tput [X2,a] X ~b ~c ~d ~line{sub..} con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ End of "X" movement in mode "x" &dA if "KWT" con line{1} d = mpt h = X_point KAC1: /* attempt to set obcursor correctly g = list_order(h,1) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "J" goto KAC1 end b = int(line{3..}) con4 = pointers(b,8) /* pointer to system record for this system if d = 3 a = pointers(b,7) c = list_order(a,4) if c = 0 tget [X,a] .t3 c textoff else tget [X2,c] .t3 c textoff end end list_order(h,3) = -1 list_order(h,5) = -1 list_order(X_point,3) = -1 list_order(X_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 2 /* selective construction, no super-objects con3 = 0 /* use clearb perform construct a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line .t3 line2 a = trecord_cnt else tget [X2,a] line .t3 line2 end sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) if k = 0x03010f or k = 0x030112 or k = 0x030114 or k = 0x030117 b += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 or k = 0x030115 b -= incre else if d = 3 and c < 11 c = c - 1 * vpar(41) + textoff + 1000 end if k = 0x03010e or k = 0x030119 or k = 0x03011b or k = 0x030116 c -= incre else c += incre end end end line = line{1,2} // chs(b) // " " // chs(c) // line2{sub..} tput [X2,a] ~line con2 = 2 /* selective construction, omit super-objects goto REDIS end &dA &dA &d@ End of sub-object movement in mode "x" &dA if line{1} = "L" h = X_point b = 0 LAC1: /* mark all elements on line g = list_order(h,2) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if b = 0 and line{1} = "J" b = int(line{3..}) con4 = pointers(b,8) /* pointer to system record for this system end list_order(h,3) = -1 list_order(h,5) = -1 if line{1} <> "E" goto LAC1 end &dA &dA &d@ Flag barline records for this system &dA LAC1A: g = list_order(h,2) a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "B" goto LAC1A end list_order(h,3) = -1 list_order(h,5) = -1 LAC1B: g = list_order(h,2) if g <> BOTTOM_FLAG a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} = "B" list_order(h,3) = -1 list_order(h,5) = -1 goto LAC1B end end &dA &dA &d@ Turn off all red on this line &dA con1 = 1 /* construct on red_gstr con2 = 3 /* selective construction, including redrawn staff line con3 = 0 /* use clearb sysflag = 0 perform construct a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end line = line // " " &dA &d@ Field 2: y off-set in system b = int(line{3..}) &dA &d@ Field 3: text off-set(s) from line (separated by |) &dA &d@ Field 4: dyoff(s) separated by | &dA &d@ Field 5: uxstart(s) separated by | &dA &d@ Field 6: backloc(s) spearated by | &dA &d@ Field 7: xbyte(s) (length of field = number of bytes) line = line{sub..} line = mrt(line) lpt = 1 tline = txt(line,[' '],lpt) /* lpt -> beyond field 3 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 3 through 7 line = line{lpt..} line = mrt(line) &dA &d@ Field 8: y off-set to virtual staff line (0 = none) if line = "" putc Format Error in Line Record return 10 end d = int(line) &dA &d@ Field 9: notesize (0 = not specified; i.e., no change) line = line{sub..} line = mrt(line) if line = "" c = 0 else c = int(line) end if k >= 0x030115 and k <= 0x030118 if k = 0x030115 d -= vpar(2) else if k = 0x030116 b -= vpar(2) else if k = 0x030117 d += vpar(2) else b += vpar(2) end end end else 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 end tput [X2,a] L ~b ~tline ~d ~c con2 = 3 /* selective construction; including redrawn staff line sysflag = 0 goto REDIS end &dA &dA &d@ End of staff line movement in mode "x" &dA if line{1} = "S" h = X_point con4 = X_point SAC1: /* mark all elements in system g = list_order(h,2) if g = BOTTOM_FLAG goto SAC2 end a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "S" list_order(h,3) = -1 list_order(h,5) = -1 goto SAC1 end SAC2: &dA &dA &d@ Turn off all red and all black on this system &dA if list_order(X_point,4) = 0 con1 = 0 /* erasing black system con2 = 0 /* redraw entire system con3 = 0 /* use clearb perform construct if wflag2 = 1 dscale2 gstr, tstr2 if sflag = 2 activate tstr2,px,py,1 end end if wflag3 = 1 dscale3 gstr, tstr3 if sflag = 3 activate tstr3,px,py,1 end end if wflag4 = 1 dscale2 tstr2, tstr4 if sflag = 4 activate tstr4,px,py,1 end end end con1 = 1 /* construct on red_gstr con2 = 4 /* redraw entire system; use updated records con3 = 0 /* use clearb perform construct a = list_order(X_point,4) if a = 0 ++trecord_cnt list_order(X_point,4) = trecord_cnt tget [X,X_point] line a = trecord_cnt else tget [X2,a] line end lpt = 5 tline = txt(line,[' '],lpt) sp = int(tline) tline = txt(line,[' '],lpt) sysy = int(tline) tline = txt(line,[' '],lpt) syslen = int(tline) tline = txt(line,[' '],lpt) sysh = int(tline) tline = txt(line,[' '],lpt) f11 = int(tline) tline = txt(line,[' '],lpt) tline = tline // pad(2) syscode = tline{2..} if syscode con quote syscode = syscode{1,mpt-1} end if k >= 0x030115 and k <= 0x030118 if k = 0x030116 sysy -= vpar(2) end if k = 0x030118 sysy += vpar(2) end else if k = 0x03010f or k = 0x030112 or k = 0x030114 sysh += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 sysh -= incre else if k = 0x03010e or k = 0x030119 or k = 0x03011b sysy -= incre else sysy += incre end end end end tput [X2,a] S 0 ~sp ~sysy ~syslen ~sysh ~f11 "~syscode " con2 = 4 /* redraw entire system; use updated records goto REDIS end &dA &dA &d@ End of system movement in mode "x" &dA if line{1} = "H" SX_point = X_point goto HAC1000 end &dA &dA &d@ End of super-object movement in mode "x" &dA goto PPQ end if cmode = "h" SX_point = super_pointers(supercursor,1) goto HAC1000 end &dA &dA &d@ &dASUPER-OBJECT MOVEMENT&d@ &dA HAC1000: a = list_order(SX_point,4) if a = 0 tget [X,SX_point] line else tget [X2,a] line end lpt = 8 tline = txt(line,[' '],lpt) supernum = int(tline) /* supernum htype = txt(line,[' '],lpt) &dA &dA &d@ All objects associated with this super-object, which have previously been &dA &d@ moved (and are now drawn in &dAred&d@, must be identified. &dA if htype = "B" line2 = line{lpt..} a3 = int(line2) /* stem length a3 = int(line2{sub..}) /* slope a3 = int(line2{sub..}) /* font a3 = int(line2{sub..}) /* number of objects else a3 = 2 end /* a3 = number of objects a1 = 0 h = SX_point HAC1: /* looking backward through file g = list_order(h,1) a = list_order(g,4) if a = 0 tget [X,g] tline .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X2,a] tline .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end h = g if tline{1} <> "J" goto HAC1 end if supcnt > 0 loop for c = 1 to supcnt if o(c) = supernum /* this object is related to supernum goto HAC3 end repeat end goto HAC1 HAC3: if a1 = 0 list_order(g,3) = -1 /* at least one object must be flagged list_order(g,5) = -1 a1 = 1 end if a > 0 list_order(g,3) = -1 list_order(g,5) = -1 HAC2: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte else tget [X,g] tbyte end if "KTWA" con tbyte list_order(g,3) = -1 /* flag all sub-objects related to this object list_order(g,5) = -1 goto HAC2 end end --a3 if a3 > 0 goto HAC1 end c = int(tline{3..}) con4 = pointers(c,8) /* pointer to system record for this system &dA &dA &d@ If this super-object is a tuple and the tuple is associated with a beam, &dA &d@ then the beam must be flagged, or else the tuple will not turn off. &dA if htype = "X" /* tuple a1 = lpt tline = txt(line,[' '],a1) sitflag = int(tline) if bit(3,sitflag) = 1 /* associated with a beam tline = txt(line,[' '],a1) a3 = int(tline) tline = txt(line,[' '],a1) x1 = int(tline) tline = txt(line,[' '],a1) y1 = int(tline) tline = txt(line,[' '],a1) x2 = int(tline) tline = txt(line,[' '],a1) y2 = int(tline) tline = txt(line,[' '],a1) a2 = int(tline) &dA &dA &d@ get stem direction (a2 = beam super number) and flag beam &dA &d@ hh = SX_point HAC101: &dA &d@ The following code could cause a problem if records get out of order if a2 > supernum /* usually the case gg = list_order(hh,2) /* looking forward through file else gg = list_order(hh,1) /* looking backward through file end &dA if gg < 1 or gg > 10000 putc putc Problem with finding Beam associated with Tuple super-object return 10 end aa = list_order(gg,4) if aa = 0 tget [X,gg] ttline .t8 a3 else tget [X2,aa] ttline .t8 a3 end hh = gg if ttline{1} <> "H" goto HAC101 end if a3 <> a2 goto HAC101 end if ttline con "B" list_order(hh,3) = -1 /* flag beam list_order(hh,5) = -1 end end end &dA &dA &d@ End of code which flags the beam assocated with a tuplet &dA list_order(SX_point,3) = -1 list_order(SX_point,5) = -1 con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct a = list_order(SX_point,4) /* better get line again! if a = 0 tget [X,SX_point] line else tget [X2,a] line end lpt = 8 tline = txt(line,[' '],lpt) supernum = int(tline) /* supernum htype = txt(line,[' '],lpt) &dA &dA &d@ &dD Ties &dA if htype = "T" tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = line line = line{lpt+1..} perform strip3 sitflag = int(line) --sitflag if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 if k = 0x03010e sitflag &= 0xf7 else if k = 0x030110 sitflag |= 0x08 else if k = 0x03010d sitflag &= 0xfb else sitflag |= 0x04 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 or k = 0x03011b --y1 else ++y1 end end end end ++sitflag a = list_order(SX_point,4) b = supernum if a > 0 tput [X2,a] ~tline{1,7} ~b T ~y1 ~x1 ~x2 0 0 0 ~sitflag 0 else ++trecord_cnt tput [X2,trecord_cnt] ~tline{1,7} ~b T ~y1 ~x1 ~x2 0 0 0 ~sitflag 0 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Beams &dA if htype = "B" tline = txt(line,[' '],lpt) @k = int(tline) /* length of first stem (positive = stem up) tline = txt(line,[' '],lpt) @m = int(tline) /* slope of beam if k >= 0x030111 and k <= 0x030114 /* do nothing else if k >= 0x03010d and k <= 0x030110 if k = 0x03010e @k += incre if @k < 0 and @k > 0 - vpar(2) @k = vpar(2) end else if k = 0x030110 @k -= incre if @k > 0 and @k < vpar(2) @k = 0 - vpar(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 - vpar(2) @k = vpar(2) end else @k -= incre if @k > 0 and @k < vpar(2) @k = 0 - vpar(2) end end end end end a = list_order(SX_point,4) b = supernum if a > 0 tput [X2,a] ~line{1,7} ~b B ~@k ~@m ~line{lpt..} else ++trecord_cnt tput [X2,trecord_cnt] ~line{1,7} ~b B ~@k ~@m ~line{lpt..} list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Slurs &dA if htype = "S" tline = txt(line,[' '],lpt) sitflag = int(tline) /* situation flag tline = txt(line,[' '],lpt) x1 = int(tline) /* horizontal adjustment to start tline = txt(line,[' '],lpt) y1 = int(tline) /* vertical adjustment to start tline = txt(line,[' '],lpt) x2 = int(tline) /* horizontal adjustment to end tline = txt(line,[' '],lpt) y2 = int(tline) /* vertical adjustment to end tline = txt(line,[' '],lpt) addcurve = int(tline) /* post adjustment to curvature tline = txt(line,[' '],lpt) a = int(tline) postx = 0 /* post adjustment to x position posty = 0 /* post adjustment to y position if lpt < len(line) tline = txt(line,[' '],lpt) postx = int(tline) end if lpt < len(line) tline = txt(line,[' '],lpt) posty = int(tline) end if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  sitflag &= 0xf3 else if k = 0x030110 /*  sitflag |= 0x0c else if k = 0x03010d /*  decrease addcurve --addcurve &dA &d@ sitflag &= 0xfe else /*  increase addcurve ++addcurve &dA &d@ sitflag |= 0x01 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --postx else if k = 0x030116 --posty else if k = 0x030117 ++postx else ++posty end end end else if sitflag < 4 a1 = vpar(1) else a1 = 0 - vpar(1) end if k = 0x030119 y1 -= a1 else if k = 0x03011a y1 += a1 else if k = 0x03011b y2 -= a1 else y2 += a1 end end end end end end line = line{1,7} // chs(supernum) // " S " // chs(sitflag) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~y1 ~x2 ~y2 ~addcurve 0 ~postx ~posty else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~y1 ~x2 ~y2 ~addcurve 0 ~postx ~posty list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Figure continuation lines &dA if htype = "F" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) 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 a3 > 1 --a3 end else if k = 0x030110 /*  if a3 < 4 ++a3 end 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 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Tuplets &dA if htype = "X" tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y2 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if bit(3,sitflag) = 1 &dA &dA &d@ get stem direction (a2 = beam super number) and flag beam &dA &d@ hh = SX_point HAC100: &dA &d@ The following code could cause a problem if records get out of order if a2 > supernum /* usually the case gg = list_order(hh,2) /* looking forward through file else gg = list_order(hh,1) /* looking backward through file end &dA aa = list_order(gg,4) if aa = 0 tget [X,gg] ttline .t8 a3 else tget [X2,aa] ttline .t8 a3 end hh = gg if ttline{1} <> "H" goto HAC100 end if a3 <> a2 goto HAC100 end if ttline con "B" a3 = int(ttline{mpt+1..}) if a3 < 0 a3 = DOWN else a3 = UP end list_order(hh,3) = -1 /* flag beam also list_order(hh,5) = -1 end end if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e or k = 0x030110 /*   if bit(3,sitflag) = 1 if k = 0x03010e /*  if a3 = UP sitflag |= 0x10 /* tuple near beam else sitflag &= 0xef /* tuple near notes end else /*  if a3 = DOWN sitflag |= 0x10 /* tuple near beam else sitflag &= 0xef /* tuple near notes end end end else if k = 0x03010d /*  bracket tips up or no bracket if bit(1,sitflag) = 1 if bit(2,sitflag) = 0 sitflag |= 0x04 /* tips up else sitflag &= 0xfd /* no bracket end end else /*  add bracket or bracket tips down if bit(1,sitflag) = 0 sitflag |= 0x02 /* add bracket else sitflag &= 0xfb /* bracket tips down end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 --y2 else if k = 0x030117 ++x1 ++x2 else ++y1 ++y2 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y2 else ++y2 end end end end end end line = line{1,7} // chs(supernum) // " X " // chs(sitflag) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~a1 ~x1 ~y1 ~x2 ~y2 ~a2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~a1 ~x1 ~y1 ~x2 ~y2 ~a2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Transpositions &dA if htype = "V" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  ++a1 else if k = 0x030110 /*  --a1 else if k = 0x03010d /*  if a3 > 0 --a3 end else /*  if a3 < 3 ++a3 end end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else ++y1 end end end end end end line = line{1,7} // chs(supernum) // " V " // chs(a3) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 ~a1 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 ~a1 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Endings &dA if htype = "E" tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  ++a1 else if k = 0x030110 /*  --a1 else if k = 0x03010d /*  --a2 else /*  ++a2 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else ++y1 end end end end end end line = line{1,7} // chs(supernum) // " E " // chs(a3) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 ~a1 ~a2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 ~a1 ~a2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Dashes associated with text or directives (dynamics, tempo, etc) &dA if htype = "D" tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  /* do nothing else if k = 0x030110 /*  /* do nothing else if a1 = 0 a1 = hyphspc(sizenum) * 3 end if k = 0x03010d /*  --a1 else /*  ++a1 end end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else ++y1 end end end end end end line = line{1,7} // chs(supernum) // " D " a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 ~a1 ~a2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 ~a1 ~a2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Wavey line trills ~~~~~~ &dA if htype = "R" tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  ++y1 else if k = 0x030110 /*  --y1 end end else if k >= 0x030115 and k <= 0x030118 if k = 0x030115 --x1 --x2 else if k = 0x030116 --y1 else if k = 0x030117 ++x1 ++x2 else ++y1 end end end else if k = 0x030119 --y1 else if k = 0x03011a ++y1 else if k = 0x03011b --y1 else ++y1 end end end end end end line = line{1,7} // chs(supernum) // " E " // chs(a1) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~x1 ~x2 ~y1 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~x1 ~x2 ~y1 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end &dA &dA &d@ &dD Wedges &dA if htype = "W" tline = txt(line,[' '],lpt) c1 = int(tline) tline = txt(line,[' '],lpt) c2 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y2 = int(tline) if k >= 0x030111 and k <= 0x030114 if k = 0x030111 --x1 else if k = 0x030112 ++x1 else if k = 0x030113 --x2 else ++x2 end end end else if k >= 0x03010d and k <= 0x030110 /* Alt     if k = 0x03010e /*  if c1 < vpar(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 < vpar(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 ++y2 end end end end end end line = line{1,7} // chs(supernum) // " W " // chs(c1) a = list_order(SX_point,4) if a > 0 tput [X2,a] ~line ~c2 ~x1 ~y1 ~x2 ~y2 else ++trecord_cnt tput [X2,trecord_cnt] ~line ~c2 ~x1 ~y1 ~x2 ~y2 list_order(SX_point,4) = trecord_cnt end con2 = 1 /* selective construction goto REDIS end goto PPQ &dA &dA &d@ &dAEND OF SUPER-OBJECT MOVEMENT&d@ &dA &dA &dA &d@ &dAObject Movement&d@ &dA JAC0: if pointers(obcursor,1) <> X_point h = X_point JAC1: /* attempt to set obcursor correctly g = list_order(h,1) if g <> TOP_FLAG /* top of list a = list_order(g,4) if a = 0 tget [X,g] line else tget [X2,a] line end h = g if line{1} <> "J" goto JAC1 end obcursor = int(line{3..}) end end con4 = pointers(obcursor,8) /* pointer to system record for this system JAC00: g = pointers(obcursor,1) /* pointer to table a = list_order(g,4) if a = 0 tget [X,g] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) else tget [X2,a] line .t10 line2 .t10 ntype obx oby z i i supcnt o(1) o(2) o(3) o(4) o(5) o(6) o(7) o(8) end list_order(g,3) = -1 list_order(g,5) = -1 &dA &dA &d@ Flag all super-objects &dA if supcnt > 0 b = g a = 0 /* super-object counter JAC2: b = list_order(b,2) c = list_order(b,4) if c > 0 tget [X2,c] tbyte .t8 supernum else tget [X,b] tbyte .t8 supernum end if tbyte <> "H" goto JAC2 end loop for d = 1 to supcnt if o(d) = supernum list_order(b,3) = -1 /* flag super object record list_order(b,5) = -1 o(d) = 0 ++a /* increment super-object counter if a = supcnt goto JAC3 else goto JAC2 end end repeat goto JAC2 /* this super-object is not on list end &dA &dA &d@ Flag all associated sub-objects &dA JAC3: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte list_order(g,3) = -1 list_order(g,5) = -1 goto JAC3 end &dA &d@ &dA &d@ Here is where you turn off the things that will be moved &dA &d@ con1 = 1 /* construct on red_gstr con2 = 1 /* selective construction con3 = 0 /* use clearb perform construct &dA &dA &d@ Now look at object again; adjust position of object &dA g = pointers(obcursor,1) /* pointer to table a = list_order(g,4) if a = 0 ++trecord_cnt list_order(g,4) = trecord_cnt tget [X,g] line .t10 line2 a = trecord_cnt else tget [X2,a] line .t10 line2 end &dA &dA &d@ Increase (decrease, raise, lower) the x-coordinate of this object &dA sub = 1 b = int(line2{sub..}) c = int(line2{sub..}) d = int(line2{sub..}) if k >= 0x030115 and k <= 0x030118 if k = 0x030115 c -= incre else if k = 0x030116 d -= incre else if k = 0x030117 c += incre else d += incre end end end else if k = 0x03010f or k = 0x030112 or k = 0x030114 c += incre else if k = 0x03010d or k = 0x030111 or k = 0x030113 c -= incre else if k = 0x03010e or k = 0x030119 or k = 0x0311b d -= incre else d += incre end end end end line = line{1,9} // chs(b) // " " // chs(c) // " " // chs(d) // line2{sub..} tput [X2,a] ~line &dA &dA &d@ Incremented backward (forward) all associated text records &dA JAC4: g = list_order(g,2) /* next record in table a = list_order(g,4) if a > 0 tget [X2,a] tbyte .t3 line else tget [X,g] tbyte .t3 line end if "KTWA" con tbyte if mpt = 2 &dA &dA &d@ Backup (advance) x-coordinate of text sub-object &dA b = int(line) if k = 0x03010f or k = 0x030112 or k = 0x030114 b -= incre else b += incre end line = tbyte // " " // chs(b) // line{sub..} if a > 0 tput [X2,a] ~line else ++trecord_cnt tput [X2,trecord_cnt] ~line list_order(g,4) = trecord_cnt end end goto JAC4 end con2 = 1 /* selective construction &dA &dA &d@ End of "object" movement &dA REDIS: &dA &d@ &dA &d@ Here is where you re-display the things that are moved &dA &d@ con1 = 1 /* construct on red_gstr /* con2 = 1 or 2 or 3 or 4. This has been set earlier con3 = 1 /* use setb perform construct if wflag2 = 1 dscale2 red_gstr, red_tstr2, conx1, cony1, conx2, cony2 if sflag = 2 activate red_tstr2,px,py,4 end end if wflag3 = 1 dscale3 red_gstr, red_tstr3, conx1, cony1, conx2, cony2 if sflag = 3 activate red_tstr3,px,py,4 end end if wflag4 = 1 conx1 >>= 1 cony1 >>= 1 conx2 >>= 1 cony2 >>= 1 dscale2 red_tstr2, red_tstr4, conx1, cony1, conx2, cony2 if sflag = 4 activate red_tstr4,px,py,4 end end goto PPQ end if k = 0x03010b /* ctrl  if x(sflag) < 40 x(sflag) += 10 end end if k = 0x030109 /* ctrl  if x(sflag) > xze - 340 x(sflag) -= 10 end end if k = 0x03010a /* ctrl  if y(sflag) > yze - 3500 y(sflag) -= 80 end end if k = 0x03010c /* ctrl  if y(sflag) < 320 y(sflag) += 80 end end if k = 0x010067 /* g newcmode = "g" perform change_cmode end if k = 0x01006a /* j newcmode = "j" perform change_cmode end if k = 0x010068 /* h newcmode = "h" perform change_cmode a = pointers(obcursor,1) loop while list_order(a,1) <> TOP_FLAG a = list_order(a,1) tget [X,a] tbyte repeat while tbyte <> "H" if tbyte <> "H" loop while list_order(a,2) <> BOTTOM_FLAG a = list_order(a,2) tget [X,a] tbyte repeat while tbyte <> "H" end if tbyte = "H" tget [X,a] .t3 supercursor .t8 line &dA &dA &d@ Set cursor at new location &dA a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += hpar(3) end end goto PPQ end end if k = 0x010078 /* x newcmode = "x" perform change_cmode end if k >= 0x030101 and k <= 0x030104 if k = 0x030101 /*  if cmode = "g" h = pointers(obcursor,4) if h > 0 and h <= object_count obcursor = h goto SETCUR end end if cmode = "j" if obcursor > 1 --obcursor goto SETCUR end end if cmode = "x" BWXP: if list_order(X_point,1) = TOP_FLAG /* top of list goto PPQ else X_point = list_order(X_point,1) end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) goto SETCUR end if "WTK" con rectype perform getobposition (X_point,obcursor) tget [X,X_point] .t3 t1 t2 xcur += t1 ycur += t2 goto PPQ end if "H" = rectype tget [X,X_point] .t3 supercursor .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += hpar(3) end end goto PPQ end if rectype = "L" h = X_point loop g = list_order(h,2) tget [X,g] line .t3 a if line{1} = "J" c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 b xcur ycur tget [X,c] .t3 c ycur += c end h = g repeat while "JE" not_con line{1} goto PPQ end if "SX" con rectype tget [X,X_point] .t3 g xcur ycur goto PPQ end if "AEB" con rectype goto BWXP end end if cmode = "h" if supercursor <= 1 goto PPQ end --supercursor a1 = super_pointers(supercursor,1) tget [X,a1] .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 obcursor .t8 jtype .t10 c d oby perform setcurloc (obcursor,X_point) /* return new X_point if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += hpar(3) end end goto PPQ end end if k = 0x030102 /*  if "gj" con cmode obcursor = pointers(obcursor,5) goto SETCUR end if cmode = "x" UPXP: if list_order(X_point,1) = TOP_FLAG /* top of list goto PPQ end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) if obcursor > 1 --obcursor end goto SETCUR end if "WTK" con rectype perform getobposition (X_point,obcursor) rectype = "J" goto PPQ end if "AEB" con rectype X_point = list_order(X_point,1) goto UPXP end if "HLSX" con rectype X_point = list_order(X_point,1) goto UPXP end end end if k = 0x030103 /*  if cmode = "g" h = pointers(obcursor,3) if h > 0 and h <= object_count obcursor = h goto SETCUR end end if cmode = "j" if obcursor < object_count ++obcursor goto SETCUR end end if cmode = "x" FWXP: if list_order(X_point,2) = BOTTOM_FLAG goto PPQ end X_point = list_order(X_point,2) tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) goto SETCUR end if "WTK" con rectype perform getobposition (X_point,obcursor) tget [X,X_point] .t3 t1 t2 xcur += t1 ycur += t2 goto PPQ end if "H" = rectype tget [X,X_point] .t3 supercursor .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 a .t8 jtype .t10 c d oby perform setcurloc (a,b) if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += hpar(3) end end goto PPQ end if rectype = "L" h = X_point loop g = list_order(h,2) tget [X,g] line .t3 a if line{1} = "J" c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 b xcur ycur tget [X,c] .t3 c ycur += c end h = g repeat while "JE" not_con line{1} goto PPQ end if "SX" con rectype tget [X,X_point] .t3 g xcur ycur goto PPQ end if "AEB" con rectype goto FWXP end end if cmode = "h" if supercursor = super_count or supercursor = 0 goto PPQ end ++supercursor a1 = super_pointers(supercursor,1) tget [X,a1] .t8 line a1 = 10000 if line con "T" a1 = int(line{mpt+1..}) end n = 1000000 h = super_pointers(supercursor,3) g = h + super_pointers(supercursor,4) - 1 &dA &dA &d@ Get object with smallest x position &dA loop for a = h to g b = related_objects(a) tget [X,b] .t10 c d if d < n n = d e = b end repeat tget [X,e] .t3 obcursor .t8 jtype .t10 c d oby perform setcurloc (obcursor,X_point) /* return new X_point if a1 <> 10000 /* this is a tie if jtype <> "M" ycur = ycur - oby + a1 else if a1 > 700 a1 = a1 - 1000 + grand_space end ycur += a1 xcur += hpar(3) end end goto PPQ end end if k = 0x030104 /*  if "gj" con cmode obcursor = pointers(obcursor,6) goto SETCUR end if cmode = "x" DOWNXP: if list_order(X_point,2) = BOTTOM_FLAG goto PPQ end tget [X,X_point] rectype .t3 line if rectype = "J" obcursor = int(line) if obcursor < object_count ++obcursor end goto SETCUR end if "WTK" con rectype perform getobposition (X_point,obcursor) if obcursor < object_count ++obcursor end rectype = "J" goto SETCUR end if "AEB" con rectype X_point = list_order(X_point,2) goto DOWNXP end if "HLSX" con rectype X_point = list_order(X_point,2) goto DOWNXP end end end SETCUR: perform setcurloc (obcursor,X_point) /* return new X_point goto PPQ end if k = 0x030120 or k = 0x030121 if k = 0x030120 /* page up a = X_point &dA &d@ get an original index loop while a > table_size and list_order(a,1) <> TOP_FLAG a = list_order(a,1) repeat &dA &d@ get first system index which is smaller that this index b = system_rec(1) if a <= table_size loop for i = system_cnt to 1 step -1 if system_rec(i) < a b = system_rec(i) i = 1 end repeat end if 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 goto PPQ end if k = 0x030121 /* page down a = X_point &dA &d@ get an original index loop while a > table_size and list_order(a,1) <> TOP_FLAG a = list_order(a,1) repeat &dA &d@ get next bigger index for system c = table_size loop while list_order(c,2) <> BOTTOM_FLAG c = list_order(c,2) repeat if a <= table_size loop for i = 1 to system_cnt if system_rec(i) > a c = system_rec(i) i = system_cnt end repeat end if cmode = "h" if supercursor = 0 goto PPQ end b = c loop tget [X,b] tbyte .t3 a if tbyte = "H" if a = super_count a = super_count - 1 end supercursor = a k = 0x030103 /*  goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG else if cmode = "x" if c >= table_size loop c = list_order(c,1) tget [X,c] tbyte repeat while "KJWTH" not_con tbyte c = list_order(c,1) end X_point = c k = 0x030103 /*  goto NEWK else b = c loop tget [X,b] tbyte .t3 a if tbyte = "J" obcursor = a X_point = b k = 0x030103 /*  goto NEWK end b = list_order(b,1) repeat while b <> TOP_FLAG end end goto PPQ end end if k = 0x010032 /* 2 if sflag <> 2 sflag = 2 if wflag2 = 0 dscale2 gstr, tstr2 if trecord_cnt > 0 dscale2 red_gstr, red_tstr2 end wflag2 = 1 end end end if k = 0x010033 /* 3 if sflag <> 3 sflag = 3 if wflag3 = 0 dscale3 gstr, tstr3 if trecord_cnt > 0 dscale3 red_gstr, red_tstr3 end wflag3 = 1 end end end if k = 0x010034 /* 4 if sflag <> 4 sflag = 4 if wflag2 = 0 dscale2 gstr, tstr2 if trecord_cnt > 0 dscale2 red_gstr, red_tstr2 end wflag2 = 1 end if wflag4 = 0 dscale2 tstr2, tstr4 if trecord_cnt > 0 dscale2 red_tstr2, red_tstr4 end wflag4 = 1 end end end if k = 0x010031 /* 1 if sflag <> 1 sflag = 1 end px = x(sflag) py = y(sflag) activate gstr,px,py,5 activate gstr,px,py,0 activate blue_horiz1t,px-10-LMRG1,py-TMRG1,5 activate blue_horiz1b,px-10-LMRG1,py+3300-TMRG1,5 activate blue_vert1v,px-LMRG1,py-80-TMRG1,5 activate blue_vert1r,px+319-LMRG1,py-80-TMRG1,5 activate red_gstr,px,py,5 activate red_gstr,px,py,0 x2cur = 8 * px + xcur y2cur = py + ycur if x2cur < LMARG2 h = LMARG2 - x2cur + 7 / 8 + 9 / 10 * 10 x(sflag) += h end if x2cur > RMARG2 h = x2cur - RMARG2 + 7 / 8 + 9 / 10 * 10 x(sflag) -= h end if y2cur < TMARG2 h = TMARG2 - y2cur + 79 / 80 * 80 y(sflag) += h end if y2cur > BMARG2 h = y2cur - BMARG2 + 79 / 80 * 80 y(sflag) -= h end end goto PPP return &dA &dA &d@ setcurloc &dA &dA &d@ Input: a = index in pointers array for a particular object &dA &dA &d@ Output: b = address in table for this object &dA &dA &d@ Other outputs: xcur = x coordinate of cursor &dA &d@ ycur = y coordinate of cursor &dA &d@ grand_space = distance between grand staff lines &dA &dA procedure setcurloc (a,b) str line.100,jtype.1 int a,b,c,d,g int x,y int dummy getvalue a if a = 0 return end b = pointers(a,1) /* object c = pointers(a,7) /* line d = pointers(a,8) /* system tget [X,d] .t3 g xcur ycur tget [X,c] .t3 y .t3 line line = trm(line) line = rev(line) if line con " " line = line{1,mpt-1} line = rev(line) grand_space = int(line) end ycur += y tget [X,b] .t8 jtype g x y if jtype = "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.100 int font,i,k,fnum,color,scflag,plane getvalue out,fnum,color,scflag plane = 1 font = revmap(fnum) font = font - 1 * 256 if color = 1 if scflag = 1 loop for i = 1 to len(out) k = ors(out{i}) + font setb msgstr,FA,scx,scy,k,plane repeat else loop for i = 1 to len(out) k = ors(out{i}) + font clearb msgstr,FA,scx,scy,k,plane repeat end else if scflag = 1 loop for i = 1 to len(out) k = ors(out{i}) + font setb redmsgstr,FA,scx,scy,k,plane repeat else loop for i = 1 to len(out) k = ors(out{i}) + font clearb redmsgstr,FA,scx,scy,k,plane repeat end end return procedure setupmsg int a,b,c,d,e,font,color,scflag str out.80 font = 137 color = 1 scflag = 1 scx = MSGTAB1 scy = MSGROW1 out = messages(1) perform msgout (out,font,color,scflag) scx = MSGTAB1 scy = MSGROW2 out = messages(2) perform msgout (out,font,color,scflag) scx = MSGTAB1 scy = MSGROW3 out = messages(3) perform msgout (out,font,color,scflag) scx = MSGTAB1 scy = MSGROW4 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 = MSGTAB2 scy = MSGROW1 out = messages(5) perform msgout (out,font,color,scflag) scx = MSGTAB2 scy = MSGROW2 out = messages(6) perform msgout (out,font,color,scflag) return procedure change_cmode int a,b,c,d,e,font,color,scflag str out.80 font = 137 color = 3 scflag = 0 scx = MSGTAB1 if "gjhx" con cmode out = messages(mpt) scy = message_row(mpt) end perform msgout (out,font,color,scflag) scflag = 1 scx = MSGTAB1 if "gjhx" con newcmode out = messages(mpt) scy = message_row(mpt) end perform msgout (out,font,color,scflag) cmode = newcmode return &dA &dA &d@ getobposition &dA &dA &d@ Input: a = address in table of a particular sub-object (or word, or text item) &dA &dA &d@ Output: b = index in pointers array for object associated with this sub-object &dA &dA &d@ Other outputs: xcur = x coordinate of cursor for object &dA &d@ ycur = y coordinate of cursor for object &dA &d@ grand_space = distance between grand staff lines &dA &dA procedure getobposition (a,b) int a,b str byte.1,line.10 getvalue a b = a loop b = list_order(b,1) /* back up 1 on list if b = TOP_FLAG dputc Program error return 10 end tget [X,b] byte repeat while byte <> "J" tget [X,b] .t3 line a = int(line) perform setcurloc (a,b) b = a passback b return &dA &dA &d@ Procedure construct &dA &dA &d@ Purpose: construct or erase sections of music &dA &dA &d@ Inputs: con1 = black/red flag &dA &d@ 0 = construct on gstr &dA &d@ 1 = construct on red_gstr &dA &d@ con2 = full/partial &dA &d@ 0 = make a full construction using X table records &dA &d@ 1 = use only records with list_order(.,3) <> 0 &dA &d@ 2 = same as 1, but omit all references to super-objects &dA &d@ 3 = same as 1, but also redraw staff lines &dA &d@ 4 = full construction; make use of updated records &dA &d@ 5 = save as 3, but use original X table records &dA &d@ con3 = turn on/off &dA &d@ 1 = use setb &dA &d@ 0 = use clearb &dA &d@ con4 = starting point &dA &d@ 0 = start at top; use entire file &dA &d@ >0 = start at record con4; stop before next "S" record &dA &dA &d@ Outputs: conx1 = \ &dA &d@ cony1 = \ ROW and COLUMN boundaries to box where &dA &d@ conx2 = / reconstruction took place. These outputs &dA &d@ cony2 = / are valid only when con2 > 0 and con3 = 1. &dA procedure construct label LTY(12) if con2 > 0 and con3 = 1 conx1 = 100000 cony1 = 100000 conx2 = 0 cony2 = 0 end loop for k = 1 to SUPERMAX supermap(k) = 0 repeat sysnum = 0 if con4 > 0 rec = con4 else rec = 1 end f12 = 0 scf = notesize TOP: if rec > f4 return end if con2 = 0 tget [X,rec] line else if con2 = 4 trec = list_order(rec,4) if trec = 0 tget [X,rec] line else tget [X2,trec] line end else if list_order(rec,3) <> 0 if con2 = 5 trec = 0 else trec = list_order(rec,4) end if trec = 0 tget [X,rec] line else tget [X2,trec] line end if con3 = 1 if "SL" not_con line{1} list_order(rec,3) = 0 /* remove flag end end else rec = list_order(rec,2) goto TOP end end end line = trm(line) if line{1} = "S" and con4 > 0 and rec > con4 return end rec = list_order(rec,2) &dK &d@ if con2 > 0 &dK &d@ putc .w6 ~rec ~line &dK &d@ examine &dK &d@ end &dK &dK &d@ putc .w6 ~rec ~line &dK &d@ examine &dK if "ESLXJKAWTHBk" con line{1} goto LTY(mpt) end &dA &dA &d@ END OF LINE &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(1): /* line{1} = "E" loop for k = 1 to SUPERMAX if supermap(k) <> 0 if con2 = 0 putc Outstanding superobject at end of line return 10 end supermap(k) = 0 examine end repeat loop for c8 = 1 to ntext if line{c8+2} <> " " if line{c8+2} <> "*" if line{c8+2} <> xbyte(c8) putc Current xbyte different from xbyte at end of line return 10 end y = sq(f12) + f(f12,c8) if xbyte(c8) = "-" x = sp + syslen perform sethyph (c8) end if "_,.;:!?" con xbyte(c8) uxstop(c8) = sp + syslen - hpar(56) underflag = 2 perform setunder (c8) end xbyte(c8) = "*" else if "_,.;:!?" con xbyte(c8) y = sq(f12) + f(f12,c8) underflag = 1 if uxstop(c8) > sp + syslen - hpar(57) uxstop(c8) = sp + syslen - hpar(57) end perform setunder (c8) end end end repeat goto TOP &dA &dA &d@ S Y S T E M S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(2): /* line{1} = "S" f12 = 0 sysnum = sysnum + 1 #if REPORT putc System ~sysnum putc Line ... #endif lpt = 5 tline = txt(line,[' '],lpt) sp = int(tline) tline = txt(line,[' '],lpt) sysy = int(tline) tline = txt(line,[' '],lpt) syslen = int(tline) tline = txt(line,[' '],lpt) sysh = int(tline) tline = txt(line,[' '],lpt) f11 = int(tline) tline = txt(line,[' '],lpt) tline = tline // pad(2) syscode = tline{2..} if syscode con quote syscode = syscode{1,mpt-1} end sysflag = 0 goto TOP &dA &dA &d@ L I N E S &dA &d@ ÄÄÄÄÄÄÄÄÄ &dA LTY(3): /* line{1} = "L" line = line // " " f12 = f12 + 1 #if REPORT putc ~f12 ... #endif &dA &d@ Field 2: y off-set in system sq(f12) = int(line{3..}) sq(f12) += sysy &dA &d@ Field 3: text off-set(s) from line (separated by |) ntext = 0 NSR1: ++ntext f(f12,ntext) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR1 end &dA &d@ Field 4: dyoff(s) separated by | c8 = 0 NSR2: ++c8 if c8 > ntext ++ntext f(f12,ntext) = f(f12,ntext-1) + vpar(41) end dyoff(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR2 end &dA &d@ Field 5: uxstart(s) separated by | c8 = 0 NSR3: ++c8 if c8 > ntext ++ntext f(f12,ntext) = f(f12,ntext-1) + vpar(41) end uxstart(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR3 end &dA &d@ Field 6: backloc(s) spearated by | c8 = 0 NSR4: ++c8 if c8 > ntext ++ntext f(f12,ntext) = f(f12,ntext-1) + vpar(41) end backloc(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR4 end tline = line{sub+1..} tline = mrt(tline) &dA &d@ Field 7: xbyte(s) (length of field = number of bytes) if tline con " " c8 = mpt - 1 if ntext < c8 loop for ntext = ntext + 1 to c8 f(f12,ntext) = f(f12,ntext-1) + vpar(41) repeat end loop for c8 = 1 to ntext xbyte(c8) = tline{c8} repeat end &dA &d@ Field 8: y off-set to virtual staff line (0 = none) vst(f12) = 0 if tline con " " tline = tline{mpt..} vst(f12) = int(tline) tline = tline // " " tline = tline{sub..} end &dA &d@ Field 9: notesize (0 = not specified; i.e., no change) if tline con " " tline = tline{mpt..} c8 = int(tline) if chr(c8) in [6,14,21] if c8 <> notesize notesize = c8 perform init_par end end end y = sq(f12) 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 vst(f12) > 0 y = sq(f12) + vst(f12) perform staff end loop for c8 = 1 to ntext buxstop(c8) = 1000000 repeat goto TOP &dA &dA &d@ G L O B A L T E X T &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(4): /* line{1} = "X" lpt = 3 tline = txt(line,[' '],lpt) z = int(tline) tline = txt(line,[' '],lpt) x = int(tline) tline = txt(line,[' '],lpt) y = int(tline) if lpt > len(line) line = "" else line = line{lpt+1..} line = trm(line) end perform setwords scf = notesize goto TOP &dA &dA &d@ O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(5): /* line{1} = "J" trec = list_order(rec,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 * if jtype = "N" savenoby = oby loop for c8 = 1 to ntext uxstop(c8) = sp + obx + hpar(7) buxstop(c8) = 1000000 repeat end * if jtype = "D" /* steve's version: if jtype in ['D','F'] 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 /* skip over directives SKD2: tget [X,rec] line2 if line2{1} = "W" /* steve's version: if line2{1} in ['K','W'] rec = list_order(rec,2) goto SKD2 end goto TOP end &dA &dA &d@ Collect super-object information &dA CZ3: 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 supermap(k) = j goto WA end repeat h = 0 loop for k = 1 to SUPERMAX if supermap(k) = 0 h = k k = SUPERMAX end repeat if h = 0 putc No more superobject capacity return 10 end &dA &dA &d@ if not found, then set up reference to this superobject. &dA k = h supermap(k) = j superpnt(k) = 1 * k (value 1 to SUPERMAX) = pointer into superdata for this superobject WA: h = superpnt(k) * store object information in superdata and increment superpnt superpnt(k) = h + 2 superdata(k,h) = obx superdata(k,h+1) = oby &dO &dO &d@ dputc Storing superdata &dO &d@ putc .t10 superdata(~k ,~h ) = ~obx .t40 superdata(~k ,~(h+1) ) = ~oby &dO repeat end &dA &dA &d@ if no sub-objects, then typeset object &dA if vst(f12) > 0 and oby > 700 oby -= 1000 oby += vst(f12) end if z > 32 x = sp + obx if jtype <> "B" y = sq(f12) + oby perform setmus end end &dA &dA &d@ typeset underline (if unset) &dA saverec = rec if jtype = "R" loop for c8 = 1 to ntext if "_,.;:!?" con xbyte(c8) &dA &dA &d@ check next note for new syllable &dA YR4: tget [X,rec] line rec = list_order(rec,2) line = line // pad(12) if line{1} = "E" if line{c8+2} = "*" goto YR2 end goto YR3 end if line{1} = "J" and line{8} = "N" YR1: tget [X,rec] line rec = list_order(rec,2) if "KA" con line{1} /* Added &dA11-11-93&d@ goto YR1 end if line{1} = "T" c9 = int(line{3..}) c9 = int(line{sub..}) /* text line number if c8 = c9 goto YR2 end goto YR1 end goto YR3 end goto YR4 * YR2: y = sq(f12) + f(f12,c8) underflag = 1 if mpt > 1 uxstop(c8) -= hpar(20) end if buxstop(c8) < uxstop(c8) uxstop(c8) = buxstop(c8) end perform setunder (c8) xbyte(c8) = "*" buxstop(c8) = 1000000 end YR3: rec = saverec repeat end if jtype = "B" oby = 0 loop for c8 = 1 to ntext buxstop(c8) = sp + obx - hpar(57) repeat end goto TOP &dA &dA &d@ S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(6): /* line{1} = "K" trec = list_order(rec,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 = sp + obx + sobx y = sq(f12) + oby + soby perform setmus goto TOP &dA &dA &d@ A T T R I B U T E S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(7): /* line{1} = "A" goto TOP &dA &dA &d@ W O R D S &dA &d@ ÄÄÄÄÄÄÄÄÄ &dA LTY(8): /* line{1} = "W" lpt = 3 tline = txt(line,[' '],lpt) * line structure = sobx soby font# text sobx = int(tline) tline = txt(line,[' '],lpt) soby = int(tline) tline = txt(line,[' '],lpt) z = int(tline) if len(line) > lpt line = line{lpt+1..} x = sp + obx + sobx y = sq(f12) + oby + soby perform setwords end goto TOP &dA &dA &d@ T E X T &dA &d@ ÄÄÄÄÄÄÄ &dA LTY(9): /* line{1} = "T" line = line // " " * line structure = sobx tlevel[|soby] ttext xbyte textlen sobx = int(line{3..}) tlevel = int(line{sub..}) if tlevel < 1 or tlevel > 10 putc Error: Invalid tlevel in Text record ~(rec - 1) putc Enter blank line to stop program getc line line = trm(line) if line = "" return 10 end goto TOP end soby = 0 if line{sub} = "|" ++sub soby = int(line{sub..}) end line = line{sub..} line = mrt(line) /* ttext is next in line &dA &dA &d@ typeset back hyphons or underlines (if they exist) &dA if xbyte(tlevel) = "-" y = sq(f12) + f(f12,tlevel) x = sp + obx + sobx perform sethyph (tlevel) end if "_,.;:!?" con xbyte(tlevel) x = sp + obx + sobx - hpar(20) if mpt > 1 x -= hpar(20) end if uxstop(tlevel) > x uxstop(tlevel) = x end y = sq(f12) + f(f12,tlevel) underflag = 1 perform setunder (tlevel) end * if line con " " ttext = line{1,mpt-1} line = line{mpt..} line = mrt(line) end &dA &dA &d@ typeset underline if terminator (~) is found (Code added &dA02-24-95&d@) &dA if ttext = "~" xbyte(tlevel) = " " x = sp + obx + sobx + hpar(20) + hpar(20) uxstop(tlevel) = x y = sq(f12) + f(f12,tlevel) underflag = 1 perform setunder (tlevel) goto TOP end sub = 1 loop while ttext con "_" ttext{mpt} = " " repeat textlen = 0 xbyte(tlevel) = "*" if line <> "" line = line // " " xbyte(tlevel) = line{1} textlen = int(line{2..}) end x = sp + obx + sobx y = sq(f12) + f(f12,tlevel) + soby backloc(tlevel) = x + textlen uxstart(tlevel) = x + textlen + hpar(19) * print text perform settext goto TOP &dA &dA &d@ S U P E R - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(10): /* line{1} = "H" lpt = 8 tline = txt(line,[' '],lpt) * line structure = supernum htype . . . supernum = int(tline) * get superdata for this superobject loop for k = 1 to SUPERMAX if supermap(k) = supernum goto WB end repeat putc Error: No refererce to superobject ~supernum in previous objects examine return 10 * k = index into superdata WB: htype = txt(line,[' '],lpt) &dA &dA &d@ Construct superdata for case where con2 = 1 or 3 (partial construction) &dA if con2 = 1 or con2 = 3 or con2 = 5 if htype = "B" line2 = line{lpt..} a3 = int(line2) /* stem length a3 = int(line2{sub..}) /* slope a3 = int(line2{sub..}) /* font a3 = int(line2{sub..}) /* number of objects else a3 = 2 end a3 <<= 1 h = 0 trec = rec WB1: 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 WB1 end loop for i = 1 to supcnt if o(i) = supernum ++h superdata(k,h) = oby /* construct superdata up-side-down ++h superdata(k,h) = obx i = supcnt end repeat if h < a3 goto WB1 end &dA &dA &d@ reverse order of superdata(k,.) &dA a1 = a3 loop for i = 1 to a3 >> 1 h = superdata(k,i) superdata(k,i) = superdata(k,a1) superdata(k,a1) = h --a1 repeat end &dA &dA &d@ compensate for out-of-order objects &dA if superdata(k,1) > superdata(k,3) x1 = superdata(k,3) y1 = superdata(k,4) superdata(k,3) = superdata(k,1) superdata(k,4) = superdata(k,2) superdata(k,1) = x1 superdata(k,2) = y1 end if htype = "T" &dA &dA &d@ structure of &dDtie superobject&d@: 4. vertical position of tied note &dA &d@ 5. horiz. displacement from 1st note &dA &d@ 6. horiz. displacement from 2nd note &dA &d@ 7. vacent &dA &d@ 8. vacent &dA &d@ 9. vacent &dA &d@ 10. sitflag &dA &d@ 11. recalc flag &dA tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) line = line{lpt+1..} perform strip3 sitflag = int(line) tspan = superdata(k,3) + x2 - x1 perform settie supermap(k) = 0 goto TOP end if htype = "B" &dA &dA &d@ structure of &dDbeam superobject&d@: slope vertoff font# #obs bc(1) ... &dA tline = txt(line,[' '],lpt) @k = int(tline) tline = txt(line,[' '],lpt) @m = int(tline) tline = txt(line,[' '],lpt) beamfont = int(tline) if notesize = 6 i = 103 end if notesize = 21 i = 112 end if notesize = 14 i = 108 end if beamfont = i stemchar = 59 beamh = vpar(16) beamt = vpar(32) qwid = hpar(3) else stemchar = 187 beamh = vpar(16) * 4 / 5 beamt = vpar(32) * 4 + 3 / 5 qwid = hpar(5) end tline = txt(line,[' '],lpt) bcount = int(tline) j = 1 loop for i = 1 to bcount beamdata(i,1) = superdata(k,j) + sp beamdata(i,2) = superdata(k,j+1) + sq(f12) 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 setbeam tupldata(1) = 0 supermap(k) = 0 goto TOP end if htype = "S" &dA &dA &d@ structure of &dDslur superobject&d@: 4. sitflag &dA &d@ 5. extra horiz. displ. from obj-1 &dA &d@ 6. extra vert. displ. from obj-1 &dA &d@ 7. extra horiz. displ. from obj-2 &dA &d@ 8. extra vert. displ. from obj-2 &dA &d@ 9. extra curvature (new 6-30-93) &dA &d@ 9. post horiz. displ. (old) &dA &d@ 10. post vert. displ. &dA &d@ 11. stock slur number &dA slur_edit_flag = 0 tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) y1 = int(tline) if y1 <> 0 slur_edit_flag = 1 end y1 += superdata(k,2) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) tline = txt(line,[' '],lpt) y2 = int(tline) if y2 <> 0 slur_edit_flag = 1 end y2 += superdata(k,4) if y1 > 700 y1 -= 1000 y1 += vst(f12) end if y2 > 700 y2 -= 1000 y2 += vst(f12) end tline = txt(line,[' '],lpt) addcurve = int(tline) tline = txt(line,[' '],lpt) j = int(tline) postx = 0 posty = 0 if lpt < len(line) tline = txt(line,[' '],lpt) postx = int(tline) end if lpt < len(line) tline = txt(line,[' '],lpt) posty = int(tline) end perform putslur supermap(k) = 0 goto TOP end if htype = "F" &dA &dA &d@ structure of figcon super-object: 4. figure level &dA &d@ 5. horiz. disp. from obj1 &dA &d@ 6. horiz. disp. from obj2 &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) perform putfigcon supermap(k) = 0 goto TOP end if htype = "X" &dA &dA &d@ structure of tuplet super-object: 4. situation flag &dA &d@ 5. tuplet number &dA &d@ 6. horiz. disp. from obj1 &dA &d@ 7. vert. disp. from obj1 &dA &d@ 8. horiz. disp. from obj2 &dA &d@ 9. vert. disp. from obj2 &dA &d@ 10. associated beam super-number &dA tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) a1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) y2 = int(tline) tline = txt(line,[' '],lpt) a2 = int(tline) if bit(3,sitflag) = 1 tupldata(1) = sitflag tupldata(2) = a1 tupldata(3) = x1 tupldata(4) = x2 tupldata(5) = a2 tupldata(6) = y1 tupldata(7) = y2 else x1 += superdata(k,1) y1 += superdata(k,2) x2 += superdata(k,3) y2 += superdata(k,4) if y1 > 700 y1 -= 1000 y1 += vst(f12) end if y2 > 700 y2 -= 1000 y2 += vst(f12) end perform puttuplet end supermap(k) = 0 goto TOP end &dA &dA &d@ For the rest of the superbjects, please see code at procedure save1 &dA perform save1 supermap(k) = 0 goto TOP &dA &dA &d@ B A R L I N E &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(11): /* line{1} = "B" lpt = 3 tline = txt(line,[' '],lpt) a7 = int(tline) if a7 = 99 if sysflag = 0 #if REPORT putc #endif sysflag = 1 end goto TOP end a8 = a7 & 0x0f tline = txt(line,[' '],lpt) x = int(tline) tline = txt(line,[' '],lpt) brkcnt = int(tline) loop for i = 1 to brkcnt tline = txt(line,[' '],lpt) a6 = int(tline) barbreak(i,1) = a6 + sysy tline = txt(line,[' '],lpt) a6 = int(tline) barbreak(i,2) = a6 + sysy 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 + sp if a8 < 2 z = 82 perform barline end if a8 = 2 x = x - hpar(33) /* hpar(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 - hpar(48) /* hpar(48) = light + delta-light (auto hpar(44)) perform barline end if a8 = 6 z = 84 x = x - hpar(33) perform barline z = 82 x = x - hpar(34) /* hpar(34) = light + delta-heavy (auto hpar(45)) perform barline end if a8 = 9 z = 84 perform barline z = 82 x = x + hpar(33) + hpar(34) - 1 perform barline if a7 > 15 x = x + hpar(36) loop for f12 = 1 to f11 y = sq(f12) + vpar(3) z = 44 perform setmus y = y + vpar(2) perform setmus repeat end end if a8 = 10 z = 84 perform barline x = x - hpar(33) - hpar(34) + 1 perform barline end &dA &dA &d@ check to be sure that system line is printed &dA if sysflag = 0 #if REPORT putc #endif perform sysline sysflag = 1 end goto TOP &dA &dA &d@ "Silent" S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA LTY(12): /* line{1} = "k" goto TOP &dA &dA &d@ End of processing music data &dA return &dA &d@ &dA &dA &d@*P&dA XX. init_par &dA &d@ &dA &dA &dA &d@ Purpose: Initialize Vertical and Horizontal Parameters &dA &d@ also zak(.,.) parameters and expar(.) parameters &dA &dA &d@ Inputs: notesize &dA &d@ &dA &d@ Outputs: vpar(.) &dA &d@ hpar(.) &dA &d@ vpar20 &dA &d@ zak(.,.) &dA &d@ expar(.) &dA &d@ fontmap(.) &dA &d@ revmap(.) &dA &d@ sizenum &dA &d@ procedure init_par int a,b,i bstr cycle.200 if notesize = 14 sizenum = 1 end if notesize = 21 sizenum = 2 end if notesize = 6 sizenum = 3 end &dA &dA &d@ Vertical parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if notesize = 14 vpar(13) = 8 vpar(42) = 4 vpar(43) = 240 vpar(44) = 1 end if notesize = 6 vpar(13) = 4 vpar(42) = 2 vpar(43) = 80 vpar(44) = 1 end if notesize = 21 vpar(13) = 12 vpar(42) = 6 vpar(43) = 240 vpar(44) = 3 end loop for i = 1 to 10 vpar(i) = notesize * i / 2 repeat vpar(11) = 200 * notesize / 16 vpar(12) = 4 * notesize / 16 vpar(14) = 160 * notesize / 16 vpar(15) = 64 * notesize / 16 vpar(16) = 3 * notesize vpar(17) = notesize / 2 vpar(18) = 30 * notesize / 16 vpar(19) = 15 vpar(20) = notesize + 3 / 4 vpar(21) = notesize - vpar(20) vpar(22) = 6 * notesize / 16 vpar(23) = 9 * notesize / 16 vpar(24) = 7 * notesize / 16 vpar(25) = 22 * notesize / 16 vpar(26) = 27 * notesize / 16 vpar(27) = 72 * notesize / 16 vpar(28) = 15 * notesize / 16 vpar(29) = 38 * notesize / 16 vpar(30) = 3 * notesize - 8 / 16 vpar(31) = notesize / 2 + 1 vpar(32) = notesize * 8 + 4 / 10 vpar(33) = notesize * 12 + 10 / 14 vpar(34) = notesize - 3 / 9 vpar(35) = notesize / 3 vpar(36) = 7 * notesize vpar(37) = 5 * notesize / 4 vpar(38) = 4 * notesize / 3 vpar(39) = notesize vpar(40) = 3 * notesize / 5 vpar(41) = vpar(5) vpar(45) = 2 * notesize vpar20 = notesize * 10 &dA &dA &d@ Horizontal parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if notesize = 14 hpar(2) = 15 hpar(3) = 19 hpar(4) = 3 hpar(5) = 13 hpar(6) = 80 hpar(8) = 200 hpar(9) = 2250 hpar(12) = 80 hpar(17) = 14 hpar(19) = 4 hpar(20) = 20 hpar(21) = 300 hpar(29) = 2 hpar(30) = 15 hpar(33) = 6 hpar(34) = 7 hpar(43) = 40 hpar(48) = 8 hpar(58) = 30 end if notesize = 6 hpar(2) = 7 hpar(3) = 8 hpar(4) = 1 hpar(5) = 6 hpar(6) = 34 hpar(8) = 85 hpar(9) = 1050 hpar(12) = 35 hpar(17) = 7 hpar(19) = 2 hpar(20) = 9 hpar(21) = 130 hpar(29) = 1 hpar(30) = 7 hpar(33) = 3 hpar(34) = 4 hpar(43) = 17 hpar(48) = 4 hpar(58) = 10 end if notesize = 21 hpar(2) = 19 hpar(3) = 28 hpar(4) = 5 hpar(5) = 19 hpar(6) = 110 hpar(8) = 200 hpar(9) = 2250 hpar(12) = 100 hpar(17) = 21 hpar(19) = 6 hpar(20) = 30 hpar(21) = 300 hpar(29) = 3 hpar(30) = 19 hpar(33) = 9 hpar(34) = 11 hpar(43) = 60 hpar(48) = 13 hpar(58) = 30 end hpar(1) = 30 &dA &d@ hpar(2) = 18 * notesize / 16 &dA &d@ hpar(3) = 19 * notesize + 8 / 16 &dA &d@ hpar(4) = 3 &dA &d@ hpar(5) = 13 * notesize + 2 / 16 &dA &d@ hpar(6) = 80 hpar(7) = 4 * notesize &dA &d@ hpar(8) = 200 &dA &d@ hpar(9) = 2250 hpar(10) = 26 * notesize / 16 hpar(11) = 200 * notesize / 16 &dA &d@ hpar(12) = 80 hpar(14) = 40 * notesize / 16 hpar(16) = 24 * notesize / 16 &dA &d@ hpar(17) = 14 hpar(18) = 2 * notesize &dA &d@ hpar(19) = 4 &dA &d@ hpar(20) = 20 &dA &d@ hpar(21) = 300 hpar(22) = 6 * notesize / 16 hpar(23) = 60 * notesize / 16 hpar(24) = 7 * notesize + 2 / 7 &dA &d@ hpar(25) = notesize + 1 &dA &d@ hpar(26) = 15 * notesize / 16 hpar(27) = 0 hpar(28) = 0 - 32 * notesize / 16 &dA &d@ hpar(29) = 2 * notesize + 8 / 16 hpar(30) += hpar(29) hpar(31) = 24 * notesize / 16 hpar(32) = 44 * notesize / 16 &dA &d@ hpar(33) = 6 * notesize / 16 &dA &d@ hpar(34) = 8 * notesize / 16 hpar(35) = 14 * notesize / 16 hpar(36) = 8 * notesize / 16 hpar(37) = 20 * notesize / 16 hpar(38) = 20 * notesize / 16 hpar(39) = 50 * notesize / 16 hpar(40) = 15 * notesize + 4 / 16 hpar(41) = vpar(5) hpar(42) = notesize * 4 &dA &d@ hpar(43) = 40 hpar(44) = notesize hpar(45) = notesize hpar(46) = 13 * notesize / 16 hpar(47) = 2 * notesize / 5 &dA &d@ hpar(48) = 10 * notesize / 16 hpar(49) = 24 * notesize / 16 hpar(50) = 12 * notesize / 16 hpar(51) = 31 * notesize / 16 hpar(52) = 19 * notesize / 16 hpar(53) = 4 * notesize / 16 hpar(54) = 18 * notesize / 16 hpar(55) = 6 * notesize / 16 hpar(56) = 12 * notesize / 16 hpar(57) = 2 * notesize hpar(59) = 3 * notesize / 5 if notesize = 21 hpar(11) = 250 hpar(30) = 22 hpar(39) = 50 hpar(42) = 76 hpar(49) = 32 hpar(50) = 16 end &dA &dA &d@ Other parameters and variables &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA a = notesize * 2 b = notesize * 3 / 2 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 if notesize = 14 expar(1) = 240 expar(2) = 324 expar(3) = 254 expar(4) = 324 expar(5) = 256 expar(6) = 324 expar(7) = 260 expar(8) = 324 end if notesize = 6 expar(1) = 102 expar(2) = 139 expar(3) = 106 expar(4) = 146 expar(5) = 107 expar(6) = 144 expar(7) = 109 expar(8) = 148 end if notesize = 21 expar(1) = 360 expar(2) = 486 expar(3) = 381 expar(4) = 498 expar(5) = 386 expar(6) = 486 expar(7) = 390 expar(8) = 498 end loop for i = 1 to 400 fontmap(i) = i repeat fontmap(1) = notesize /* 1 = Ed's choice for music font loop for i = 1 to 223 pos(i) = urpos(i) * notesize repeat &dA &dA &d@ Dotted mask &dA gapsize = 3 * notesize / 4 cycle = dup("1",gapsize) // dup("0",gapsize) dotted = "" i = 2500 - (2 * gapsize) loop dotted = dotted // cycle repeat while len(dotted) < i if multiflag = 1 &dA &dA &d@ Set screen font map &dA if notesize = 14 revmap(31) = 1 revmap(32) = 2 revmap(33) = 3 revmap(34) = 4 revmap(37) = 5 revmap(38) = 6 revmap(39) = 7 revmap(44) = 8 revmap(46) = 9 revmap(14) = 10 revmap(106) = 11 revmap(108) = 12 revmap(300) = 13 revmap(400) = 14 revmap(131) = 15 revmap(137) = 16 revmap(200) = 17 revmap(320) = 52 end if notesize = 21 revmap(31) = 18 revmap(32) = 19 revmap(33) = 20 revmap(34) = 21 revmap(37) = 22 revmap(38) = 23 revmap(39) = 24 revmap(44) = 25 revmap(46) = 26 revmap(21) = 27 revmap(109) = 28 revmap(112) = 29 revmap(300) = 30 revmap(400) = 31 revmap(131) = 15 revmap(137) = 16 revmap(200) = 17 revmap(320) = 52 end if notesize = 6 revmap(31) = 35 revmap(32) = 36 revmap(33) = 37 revmap(34) = 38 revmap(37) = 39 revmap(38) = 40 revmap(39) = 41 revmap(44) = 42 revmap(46) = 43 revmap(06) = 44 revmap(102) = 45 revmap(103) = 46 revmap(300) = 47 revmap(400) = 48 revmap(131) = 15 revmap(137) = 16 revmap(200) = 17 revmap(320) = 52 end if scf > 0 a = revmap(scf) a = a - 1 / 17 if notesize = 14 a = rem + 1 end if notesize = 21 a = rem + 18 end if notesize = 6 a = rem + 35 end loop for i = 1 to 400 if revmap(i) = a scf = i i = 400 end repeat end end return run