&dA &d@ &dA &d@ Program to print or display on the screen a score from &dA &d@ page specific intermediate files &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ PC Version 1.0 (rev. 5/14/93) &dA &d@ PC Version 1.1 (rev. 11/11/93) &dA &d@ PC Version 2.0 (rev. 01/01/95) &dA &dA &d@ This program will print or display pages of music from page &dA &d@ files in score format. The program asks for the library and &dA &d@ number of pages, then proceeds to print these one page at a &dA &d@ time. 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@ Revision &dA11-11-93&d@: Attribute records are ignored &dA &dA &d@ Revision &dA03-13-94&d@: Size of superdata array increased to accommodate &dA &d@ many notes under a beam. Former size of second dimension was 24. This &dA &d@ meant that the maximum number of notes was 12. The third dimension is &dA &d@ now set by the defined variable SUPERSIZE (set below). SUPERSIZE must &dA &d@ be twice the number of notes to be accomodated. Also, it appears that &dA &d@ certain array variables related to the production of beams must have &dA &d@ one of their dimensions increased. The new dimension will be defined &dA &d@ as BEAMNOTES. &dA &dA &d@ Revision &dA05-04-94&d@: Printout portion of setbeam adjusted to accommodate &dA &d@ unusually short stems. &dA &dA &d@ Revision &dA06-15-94&d@: Program will recognize repeaters as legitimate beam &dA &d@ components. The code for a repeater is "6" in beamcode. Repeaters are &dA &d@ constructed from "hooks". There is a certain amount of vertical and &dA &d@ horizontal shifting involved. I have not yet found a way to incorporate &dA &d@ these "magic" numbers in hpar(.) and vpar(.). This problem must be &dA &d@ solved at some point. &dA &dA &d@ Revision &dA09-13-94&d@: The second numerical parameter of a text (T) record &dA &d@ specifies the text line number, if it is 10 or less; otherwise, it &dA &d@ specifies the vertical offset of the specific word of text. &dA &dA &d@ Revision &dA11-05-94&d@: Provision made for displaying slurs longer than 800 &dA &d@ dots. &dA &dA &d@ Revision &dA01-01-95&d@: Program can be used to generate versions for &dA &d@ different size notes. &dA &dA &d@ Revision &dA02-24-95&d@: Continuation lines can be terminated by "~" text &dA &d@ character. &dA &dA &d@ Revision &dA02-25-95&d@: Program was initially set up to print a single line &dA &d@ of text under music. To implement multiple lines (strophic), we need &dA &d@ to have such variables as xbyte, dyoff, uxstart, and backloc be arrays &dA &d@ since text lines are essentially independent. &dA &dA &d@ Revision &dA04-22-95&d@: Program modified to print notesize = 21 music &dA &dA &d@ Revision &dA05-17-95&d@: Program modified to print multiple note sizes &dA &dA &d@ Revision &dA05-29-95&d@: Program unifed for all note sizes &dA &dA &d@ Revision &dA03-02-96&d@: Adding capability to display (print) repeat beams &dA &dA &d@ Revision &dA10-10-96&d@: Adding capability read n-digit (page) file names &dA &dA &d@ Revision &dA02-25-97&d@: Program modified to ignore "silent" Sub-Objects &dA &dA &d@ Revision &dA03-01-97&d@: Sharp, natural, or flat can be placed above trill &dA &d@ super-object. &dA &d@ Note: This is not a complete solution &dA &dA &d@ Revision &dA03-06-97&d@: Implementing dotted slurs &dA &dA &d@ Revision &dA03/15/97&d@: Implementing tuplets with numbers below and above &dA &d@ bracket. Implementing curved (slur) tuplet &dA &d@ brackets, with or without breaks for numbers. &dA &dA &d@ Revision &dA08/28/02&d@: Added a second meaning to "X" records. With only &dA &d@ two fields, this record changes the value of &dA &d@ notesize (assuming the new value is legal). &dA &dA &d@ Revision &dA09/21/02&d@: Trying to remove "magic numbers" from settie. &dA &d@ There are four new horizontal parameters. &dA &d@ These are put into hpar(60) to hpar(63). &dA &dA &d@ Revision &dA09/22/02&d@: Adding provisions to increase number of note &dA &d@ sizes. Size-18 being added. Increased size &dA &d@ of parameter files for tie selection. (tpar files) &dA &dA &d@ Revision &dA04/20/03&d@: Implementing post adjustment to tie position &dA &d@ (fields 7, 8 and 9 of tie superobject) &dA &d@ &dA &d@ Revision &dA05/19/03&d@: Adding new rules for the placement of secondary beams &dA &d@ in the case of mixed stem directions on the grandstaff. &dA &d@ &dA &d@ Revision &dA05/26/03&d@: Fixing problem with grandstaff repeat dots. They need &dA &d@ to print on both staves: Case I: when the barline &dA &d@ appears as an Object record, with repeat dot Subobjects, &dA &d@ and Case II: when a forward repeat is thrown to the next &dA &d@ system (i.e., Bar type: B 25). &dA &dA &d@ Revision &dA08/26/03&d@: In an older version of this program hpar(15) was set at &dA &d@ run-time to the position where text hyphons start on &dA &d@ a new line. When multiple strophs were introduced, &dA &d@ hpar(15) was discarded (not set), but remained in &dA &d@ the code to set hyphons. New variable ibackloc(.) &dA &d@ has be added to replace the old hpar(15). It is set &dA &d@ to the values of backloc(.) as read in the Line record. &dA &dA &d@ Revision &dA08/28/03&d@: There is a problem with multiple strophs on a line. Mskpage, &dA &d@ as currently written, only sets one copy of the variables &dA &d@ uxstart and backloc, even when there is more than one &dA &d@ stroph. This is O.K., since uxstart and backloc are most &dA &d@ likely going to be the same for all strophs. Dskpage must &dA &d@ be alert to this fact, however, and must fill the uxstart &dA &d@ backloc and ibackloc arrays appropriately when this situation &dA &d@ occurs. &dA &dA &d@ Revision &dA08/28/03&d@: Needed to fix the way an underline was terminated by ttext = "~" &dA &d@ in the case where punctuation is present. Essentually, the &dA &d@ "~" command functions in two parts: (1) It causes an underline &dA &d@ to terminate before the note to which the "~" is attached, and &dA &d@ (2) it extends the underline some distance beyond that note. &dA &d@ Where punctuation is present, it must not be printed with &dA &d@ operation (1), but rather with operation (2). &dA &dA &d@ Revision &dA08/31/03&d@: In the case where a stroph phrase ends with an extension line &dA &d@ and then is not continued, (e.g., when there is a repeat in &dA &d@ middle of a line) we need a way to signal the end of the &dA &d@ extension line; otherwise, it will continue to the end of the &dA &d@ piece. If the stage2 file indicates an end to the extension &dA &d@ line with the code "|&" (& representing the non-existant text), &dA &d@ then this program will treat the "&" as = "no text" &dA &dA &d@ Revision &dA09/14/03&d@: A 10th field has be added to Line (L) records. It is always &dA &d@ set to zero by mskpage. This field provides an additional &dA &d@ offset to the height of figured harmonies. It must be &dA &d@ changed manually. &dA &dA &d@ Revision &dA10/01/03&d@: Adding the condition on "W" type subobjects that if the font &dA &d@ (variable z) is zero, no word (text) is printed. Print &dA &d@ suggestions can then be used to blank out certain instructions &dA &d@ in scores or parts. &dA &dA &d@ Revision &dA10/23/03&d@: Modifying slightly the way in which dotted slurs are constructed &dA &dA &d@ Revision &dA11/06/03&d@: Two modifications to how the vertical height of figure continuation &dA &d@ lines is calculated. (1) If the height of figures is altered &dA &d@ for an entire line by a non-zero figoff(.), then the height of &dA &d@ figure continuation lines must also be altered by this amount. &dA &d@ (2) It is possible to alter the height of figures manually, and &dA &d@ we need this same ability for figure continuation lines. This &dA &d@ requires the addition of an (optional) 7th Field in the &dA &d@ Figure continuation superobject, which is defined to be the &dA &d@ additional vertical displacement from the default height. &dA &dA &d@ Revision &dA11/11/03&d@: DSKPAGE can now be used to view .MPG files (or any set of pages &dA &d@ with a standard extension. The catch is that all files to be &dA &d@ viewed must have the same extension. This could be fixed in &dA &d@ the future. Also, a graceful exit was added for the case &dA &d@ where no page numbers were found. &dA &dA &d@ Revision &dA11/13/03&d@: Refining the way DSKPAGE reads and deals with control strings. &dA &d@ This refinement is relevent in the case where there are mixed &dA &d@ staff line sizes. &dA &dA &d@ Revision &dA11/18/03&d@: Small trick to remove "holes" in size-21 staff lines (for display &dA &d@ only). Staff lines will now remain visable at scale sizes &dA &d@ 1/3 and 1/4. &dA &dA &d@ Revision &dA01/13/04&d@: The mapping of font#1 (Ed's font) to the music font was not &dA &d@ working properly for dskpage. This revision fixes the &dA &d@ problem. &dA &dA &d@ Revision &dA01/17/04&d@: We needed to add a terminator to the font designation field &dA &d@ when it occurs in-line in text. The terminator is the "|" &dA &d@ character, and needs to be removed at print/display time. &dA &dA &d@ Revision &dA03/05/04&d@: DSKPAGE, on occasion, may be asked to display text. In some &dA &d@ cases, the text may need to be right justified. The best &dA &d@ way to do this is to provide for "in-line" space commands. &dA &d@ Since the charaters 131 to 141 are currently unused (and &dA &d@ un-printable) the idea is to implement the following &dA &d@ (internal) representation: &dA &d@ characters 131 to 139 = add 1 (to 9) dots of space &dA &d@ character 140 = subtract one dot of space &dA &d@ character 141 = subtract two dot of space &dA &d@ It should be stressed that this representation is internal &dA &d@ to DSKPAGE. The screen and printer never see these characters; &dA &d@ nor do they ever appear in a file to be displayed or printed. &dA &d@ The in-line commands that generate these characters are as &dA &d@ follows: (these will appear in files to be displayed/printed) &dA &d@ \! = add one dot of space \& = add seven dots of space &dA &d@ \@ = add two dots of space \* = add eight dots of space &dA &d@ \# = add three dots of space \( = add nine dots of space &dA &d@ \$ = add four dots of space \- = subtract one dot of space &dA &d@ \% = add five dots of space \= = subtract two dots of space &dA &d@ \^ = add six dots of space &dA &dA &d@ Revision &dA03/15/04&d@: Implementing a new system for organizing fonts. For the time &dA &d@ being, we will keep the old system and old fonts around. &dA &d@ Code for the new system will appear at #if NEWFONTS &dA &d@ &dA &d@ Revision &dA04/22/04&d@: The new fonts include several new characters in the upper range &dA &d@ (e.g. notes, accidentals, etc.). This necessitates the rewriting &dA &d@ of certain sections of the text output. Also, the new word-join &dA &d@ character contains its own pre-print backup command, removing &dA &d@ the need to use hpar(4). Also, the way dskpage developed &dA &d@ historically, there were two procedures that set text: &dA &d@ setwords and settext. These have already been combined in &dA &d@ the hardcoded DMUSE version, but need to be combined here &dA &d@ as well. &dA &d@ &dA &d@ Revision &dA05/02/04&d@: Adding the option to shift the contents of right and left side &dA &d@ pages so as to center contents when pages are bound. We call &dA &d@ this ODDEVENSHIFT, and it works only in PRINT mode. &dA &d@ #define PRINT 1 #define ODDEVEN 0 #define ODDEVENSHIFT 1 /* added &dA05/02/04&d@ #define LEFT_PAGE_SHIFT 89 #define RIGHT_PAGE_SHIFT 29 #define NEWFONTS 1 #define BEAM_OFFSET 12 #define TIE_OFFSET 25 #define LARGE_BRACK 42 #define SMALL_BRACK 43 #define HALF_10S 30 #define REPORT 0 #define SHOW_RECORDS 0 #define UP 0 #define DOWN 1 #define SUPERSIZE 64 #define SUPERMAX 50 #define MAX_BNOTES 32 #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 N_SIZES 12 /* changed &dA03/15/04&d@ from 4 to 12 #define TIE_DISTS 200 #define DOT_CHAR 44 str file.80,out.10000,line.480,line2.480,temp.480,tiefile.80(4) str sourcelib.100,tline.480 str textline.232,ttext.480 str jtype.1,htype.1,xbyte.1(10),cjtype.1,save_jtype.1 str beamcode.6(MAX_BNOTES),syscode.40 str name_ext.3 int tarr(32) int dyoff(10) int rec,saverec int beamh,beamt,beamfy,qwid,beamfont,stemchar,bthick int backloc(10),uxstart(10),uxstop(10) int ibackloc(10) /* New &dA08/26/03&d@ &dIOK&d@ int buxstop(10) int savenoby int underflag int pos(256),urpos(256),underspc(12),hyphspc(12) /* &dA03/15/04&d@ spc(.) changed from 3 to 12 int wak(9),hpar(63),vpar(45),vpar20 int a,b,c,d,e,g,h,i,j,k,n,x,y,z int pz int q(12),beamext(435,12),tiearr(N_SIZES,4,TIE_DISTS,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) int postx,posty int multiflag int naming_method int tpost_x,tpost_y,tpost_leng /* add &dA04/20/03&d@ &dIOK&d@ int figoff(32) /* add &dA09/14/03&d@ &dIOK&d@ int nsz(32) /* add &dA11/13/03&d@ &dIOK&d@ int govstaff /* add &dA11/13/03&d@ &dIOK&d@ int savensz /* add &dA11/13/03&d@ &dIOK&d@ int savesub /* add &dA11/13/03&d@ &dA &d@ variables added to make screen display work #if PRINT int pageside,xleftpageshift /* added &dA05/02/04&d@ #else int FA(750000) /* FA size inc. increased from .65m to .75m &dA07/15/04 int activefont str gstr.3000000,tstr2.390000,tstr3.170000,tstr4.170000 /* gstr len incresased from 2.8m to 3.0m &dA07/15/04 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 str gline.360 str msgstr.7000 str curstr.200 int xco, yco int xze, yze str zline.480 int curdist int altflag int revmap(400) int scx,scy,scb #endif int scf * &dA &dA &d@ variables added for printing long slurs and high slurs &dA str longslur.320(250) int slur_edit_flag bstr bt.2500(250) bstr dotted.2500 int gapsize &dA &dA &d@ Variables added for dealing with NEWFONTS &dA03/15/04&d@ &dA str XFontstr.76(12) int nsizes(12),revsizes(24) int XFonts(12,19) int Fspacex(90) int wedgefont(24) int scfont(24) int Mbeamfont(24) &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 &d@ figoff(32) = additional off-set for figured harmony &dA &d@ nsz(32) = notesize for each staff line in a system New &dA11/13/03&d@ &dIOK &dA &d@ govstaff = staff number whose notesize should be used New &dA11/13/03&d@ &dIOK &dA &d@ for printing the left system bar, etc. &dA &d@ savensz = temporary variable for saving notesize New &dA11/13/03&d@ &dIOK &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,64) = 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@ tpost_x = post adjustment to left x position &dA &d@ tpost_y = post adjustment to y position &dA &d@ tpost_leng = post adjustment to right x position &dA &d@ sitflag = situation flag for ties &dA &d@ tcnt = counter for extending ties &dA &d@ tspan = distance spanned by tie &dA &d@ expar(8) = extension parameters for ties &dA &d@ textend = tie extension character &dA &d@ tiefile(4) = names of the four tie extension files &dA &d@ tiearr(#,4,#,12) = parameters for choosing ties (for three notesizes 14, 21, 6) &dA &d@ hpar(60) = length beyond which ties for C5,D5 (tips up) and &dA &d@ A4,G4 (tips down) are no longer constrained by &dA &d@ staff lines &dA &d@ hpar(61) = smallest distance between notes for which a tie may be printed &dA &d@ hpar(62) = distance increment in tiearr data &dA &d@ hpar(63) = last tie glyph number for a complete tie (longer ties are divided) &dA &dA &d@ VIII. Text related &dA &dA &d@ textline.232 = working string for text &dA &d@ ttext.480 = 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@ ibackloc(10) = backloc(.) read from L record New &dA08/26/03&d@ &dIOK &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(12) = space for text hyphon (notesizes: 6, 14, 21 --> 3, 8, 11) &dA03/15/04 &dA &d@ underspc(12) = space for text underline character (notesizes: 6, 14, 21 --> 3, 8, 11) &dA &d@ urpos(256) = vertical offsets for music font characters (basic units) &dA &d@ pos(256) = vertical offsets for music font characters (notesize included) &dA &d@ notesize = size of note &dA &d@ 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(63) = horizontal spacing parameters &dA &d@ vpar(45) = vertical spacing parameters &dA &d@ wak(9) = character extension values (upper range) &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 &dA &d@ Explanation of Variables for NEWFONTS &dA03/15/04&d@ &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ nsizes(12) = The 12 available note sizes &dA &d@ only sizes 3 [06], 8 [14], and 11 [21] are currently available &dA &d@ revsizes(24) = The reverse map to nsizes &dA &d@ XFonts(12,19) = The number of 10s and the 6 x 3 (sizes, styles) for each notesize &dA &d@ XFontstr.76(12) = XFont data in string form &dA &d@ Fspacex(90) = index from (TMS font number - 50) to record in fontspac(.) &dA &d@ wedgefont(24) = font number for wedges for each notesize &dA &d@ scfont(24) = fixed pitch font number for each notesize &dA &dA &dA &dA &dA #if NEWFONTS &dA &dA &d@ &dA03/15/04&d@ Initializing arrays for NEWFONTS &dA nsizes(1) = 4 nsizes(2) = 5 nsizes(3) = 6 nsizes(4) = 7 nsizes(5) = 8 nsizes(6) = 10 nsizes(7) = 12 nsizes(8) = 14 nsizes(9) = 16 nsizes(10) = 18 nsizes(11) = 21 nsizes(12) = 24 wedgefont(1) = 38 wedgefont(2) = 38 wedgefont(3) = 38 wedgefont(4) = 38 wedgefont(5) = 38 wedgefont(6) = 38 wedgefont(7) = 38 wedgefont(8) = 38 wedgefont(9) = 39 wedgefont(10) = 39 wedgefont(11) = 39 wedgefont(12) = 39 wedgefont(13) = 39 wedgefont(14) = 39 wedgefont(15) = 40 wedgefont(16) = 40 wedgefont(17) = 40 wedgefont(18) = 40 wedgefont(19) = 40 wedgefont(20) = 41 wedgefont(21) = 41 wedgefont(22) = 41 wedgefont(23) = 41 wedgefont(24) = 41 scfont(1) = 44 /* sc08 scfont(2) = 44 scfont(3) = 44 scfont(4) = 44 scfont(5) = 45 /* sc12 scfont(6) = 45 scfont(7) = 45 scfont(8) = 45 scfont(9) = 46 /* sc16 scfont(10) = 46 scfont(11) = 46 scfont(12) = 46 scfont(13) = 47 /* sc24 scfont(14) = 47 scfont(15) = 47 scfont(16) = 47 scfont(17) = 47 scfont(18) = 47 scfont(19) = 47 scfont(20) = 47 scfont(21) = 47 scfont(22) = 47 scfont(23) = 47 scfont(24) = 47 revsizes(1) = 1 revsizes(2) = 1 revsizes(3) = 1 revsizes(4) = 1 revsizes(5) = 2 revsizes(6) = 3 revsizes(7) = 4 revsizes(8) = 5 revsizes(9) = 6 revsizes(10) = 6 revsizes(11) = 7 revsizes(12) = 7 revsizes(13) = 8 revsizes(14) = 8 revsizes(15) = 9 revsizes(16) = 9 revsizes(17) = 10 revsizes(18) = 10 revsizes(19) = 10 revsizes(20) = 11 revsizes(21) = 11 revsizes(22) = 11 revsizes(23) = 12 revsizes(24) = 12 &dA &dA &d@ start with notesize, and a number 30 to 48 (19 possibilities) &dA &d@ want a font number, that's all &dA XFontstr(1) = " 51 51 81 111 51 81 111 52 82 112 53 83 113 54 84 114 56 86 116" XFontstr(2) = " 51 52 82 112 53 83 113 54 84 114 55 85 115 56 86 116 58 88 118" XFontstr(3) = " 51 54 84 114 55 85 115 56 86 116 57 87 117 58 88 118 60 90 120" XFontstr(4) = " 52 55 85 115 57 87 117 58 88 118 59 89 119 60 90 120 63 93 123" XFontstr(5) = " 53 57 87 117 58 88 118 59 89 119 61 91 121 62 92 122 64 94 124" XFontstr(6) = " 55 59 89 119 61 91 121 63 93 123 64 94 124 65 95 125 68 98 128" XFontstr(7) = " 57 62 92 122 64 94 124 65 95 125 67 97 127 69 99 129 72 102 132" XFontstr(8) = " 58 64 94 124 66 96 126 68 98 128 70 100 130 72 102 132 74 104 134" XFontstr(9) = " 60 67 97 127 69 99 129 71 101 131 73 103 133 74 104 134 76 106 136" XFontstr(10) = " 61 69 99 129 71 101 131 73 103 133 74 104 134 75 105 135 78 108 138" XFontstr(11) = " 64 72 102 132 74 104 134 75 105 135 77 107 137 78 108 138 79 109 139" XFontstr(12) = " 65 74 104 134 75 105 135 77 107 137 78 108 138 79 109 139 80 110 140" loop for i = 1 to 12 sub = 1 loop for j = 1 to 19 XFonts(i,j) = int(XFontstr(i){sub..}) repeat repeat loop for a1 = 1 to 30 Fspacex(a1) = (a1 - 1) * 10 + 1 Fspacex(a1+30) = Fspacex(a1) + 400 Fspacex(a1+60) = Fspacex(a1) + 800 repeat Mbeamfont(1) = 102 Mbeamfont(2) = 102 Mbeamfont(3) = 102 Mbeamfont(4) = 102 Mbeamfont(5) = 103 Mbeamfont(6) = 103 Mbeamfont(7) = 104 Mbeamfont(8) = 105 Mbeamfont(9) = 105 Mbeamfont(10) = 106 Mbeamfont(11) = 106 Mbeamfont(12) = 107 Mbeamfont(12) = 107 Mbeamfont(14) = 108 Mbeamfont(15) = 108 Mbeamfont(16) = 109 Mbeamfont(17) = 109 Mbeamfont(18) = 110 Mbeamfont(19) = 111 Mbeamfont(20) = 111 Mbeamfont(21) = 112 Mbeamfont(22) = 112 Mbeamfont(23) = 114 Mbeamfont(24) = 114 #if PRINT #else loop for a1 = 1 to 24 revmap(a1) = revsizes(a1) repeat loop for a1 = 1 to 12 revmap(100+a1) = a1 + BEAM_OFFSET repeat revmap(114) = 13 + BEAM_OFFSET #endif &dA &d@ End of &dA03/15/04&d@ addition #endif Q1: &dA &dA &d@ &dA03/15/04&d@ Since multiflag is now set to 1, all code where multiflag = 0 is being removed &dA multiflag = 1 notesize = 14 &dA &dA &d@ &dA03/15/04&d@ Removing "x" as an "option," since this is now the only option &dA putc Enter note size ( = 14) getc line line = trm(line) if line <> "" 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 &dA &dA &d@ &dA03/15/04&d@ Changing sizenum to range from 1 to 12 &dA if notesize = 6 sizenum = 3 end if notesize = 14 sizenum = 8 end if notesize = 21 sizenum = 11 end &dK &d@ if notesize = 14 &dK &d@ sizenum = 1 &dK &d@ end &dK &d@ if notesize = 21 &dK &d@ sizenum = 2 &dK &d@ end &dK &d@ if notesize = 6 &dK &d@ sizenum = 3 &dK &d@ end &dA 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) = (no longer used; replaced by ibackloc(.) ) New &dA08/26/03&d@ &dIOK &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 for printing dashes (font dependent) &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 &d@ hpar(60) = special case tie length for C5,D5 (tips up) and A4,G4 (tips down) &dA &d@ hpar(61) = smallest distance between notes for which a tie may be printed &dA &d@ hpar(62) = distance increment in tiearr data &dA &d@ hpar(63) = last tie glyph number for a complete tie (longer ties are divided) &dA &dA &dA &d@ Line and measure arrays &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &dA &d@ Type # object &dA &d@ ÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 1 256th note &dA &d@ 2 128th " &dA &d@ 3 64th " &dA &d@ 4 32nd " &dA &d@ 5 16th " &dA &d@ 6 eighth " &dA &d@ 7 quarter " &dA &d@ 8 half " &dA &d@ 9 whole " &dA &d@ 10 breve " &dA &d@ 11 longa " &dA &d@ 12 extended rest &dA &d@ 13 whole measure rest &dA &d@ 14 clef signature &dA &d@ 15 key signature &dA &d@ 16 time signature &dA &d@ 17 other objects,directives &dA &d@ 18 bar line &dA &d@ 21-31 syncopated note &dA &d@ 40 conflicting n-tuple &dA &dA &d@ Initialize Vertical and Horizontal Parameters &dA &d@ expar(.) fontmap(.) &dA &dA &dA &d@ get shift parameters for music font &dA #if NEWFONTS file = "c:\musprint\new\mfonts\pos3" #else file = "c:\musprint\param\ex\pos3" #endif open [1,1] file loop for i = 1 to 223 getf [1] .t39 a urpos(i) = a repeat close [1] perform init_par &dA &d@ Outputs: vpar(.) &dA &d@ hpar(.) &dA &d@ vpar20 &dA &d@ expar(.) &dA &d@ fontmap(.) &dA &d@ revmap(.) &dA &d@ sizenum wak(1) = 140 wak(2) = 156 /* works for ‡. but not for ó wak(3) = 131 wak(4) = 156 wak(5) = 128 wak(6) = 140 wak(7) = 128 wak(8) = 129 wak(9) = 130 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 #if PRINT putc #else putc getting fonts . . . ... &dA &dA &d@ Get screen fonts &dA #if NEWFONTS open [1,5] "c:\zprogs\apps\newscrxx.fnt" #else open [1,5] "c:\zprogs\apps\scrftsxx.fnt" #endif 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! #endif &dA &dA &d@ get spacing parameters for hyphon and underline characters (text font) &dA #if NEWFONTS file = "c:\musprint\new\xfonts\tms\fontspac" loop for a1 = 1 to 12 open [1,1] file a2 = mtfont - 29 a3 = XFonts(a1,a2) - 50 a4 = Fspacex(a3) - 1 loop for j = 1 to a4 getf [1] repeat getf [1] line hyphspc(a1) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(a1) = int(line{10,2}) close [1] repeat #else file = "c:\musprint\param\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(8) = int(line{40,2}) /* &dA03/15/04&d@ ndx changed from 1 to 8 getf [1] line getf [1] line getf [1] line underspc(8) = int(line{10,2}) /* &dA03/15/04&d@ ndx changed from 1 to 8 close [1] file = "c:\musprint\param21\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(11) = int(line{40,2}) /* &dA03/15/04&d@ ndx changed from 2 to 11 getf [1] line getf [1] line getf [1] line underspc(11) = int(line{10,2}) /* &dA03/15/04&d@ ndx changed from 2 to 11 close [1] file = "c:\musprint\param06\fontspac" open [1,1] file h = mtfont - 1 * 10 loop for j = 1 to h getf [1] repeat getf [1] line hyphspc(3) = int(line{40,2}) getf [1] line getf [1] line getf [1] line underspc(3) = int(line{10,2}) close [1] #endif &dA &dA &d@ get beam generation parameters &dA #if NEWFONTS file = "c:\musprint\new\beams\beamexs" #else file = "c:\musprint\param\beamexs" #endif open [1,1] file loop for i = 1 to 435 getf [1] q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for j = 1 to 12 beamext(i,j) = q(j) repeat repeat close [1] &dA &dA &d@ get tie placement parameters &dA #if NEWFONTS loop for a1 = 1 to 12 a2 = nsizes(a1) file = "c:\musprint\new\ties\tpar" if a2 < 10 file = file // "0" end file = file // chs(a2) if chr(a2) in [6,14,18,21] else file = file // "x" end file = file // "\" tiefile(1) = file // "td-ns" tiefile(2) = file // "td-nl" tiefile(3) = file // "tu-ns" tiefile(4) = file // "tu-nl" loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to ( TIE_DISTS ) getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(a1,i,j,k) = q(k) repeat repeat close [1] repeat repeat #else file = "c:\musprint\param\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\tu-nl" * loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to ( TIE_DISTS ) getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(8,i,j,k) = q(k) /* &dA03/15/04&d@ ndx1 changed from 1 to 8 repeat repeat close [1] repeat file = "c:\musprint\param21\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\tu-nl" * loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to ( TIE_DISTS ) getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(11,i,j,k) = q(k) /* &dA03/15/04&d@ ndx1 changed from 2 to 11 repeat repeat close [1] repeat file = "c:\musprint\param06\" tiefile(1) = file // "tpar\td-ns" tiefile(2) = file // "tpar\td-nl" tiefile(3) = file // "tpar\tu-ns" tiefile(4) = file // "tpar\tu-nl" * loop for i = 1 to 4 open [1,1] tiefile(i) loop for j = 1 to 4 getf [1] repeat loop for j = 1 to ( TIE_DISTS ) getf [1] a q(1) q(2) q(3) q(4) q(5) q(6) q(7) q(8) q(9) q(10) q(11) q(12) loop for k = 1 to 12 tiearr(3,i,j,k) = q(k) repeat repeat close [1] repeat #endif &dA &dA &d@ &dE &dA &d@ &dE End of Initialization of parameters &dA &d@ &dE &dA putc Print score page(s) from Intermediate files putc LIBQ: putc Source library? getc sourcelib sourcelib = trm(sourcelib) if sourcelib = "" goto LIBQ 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@ Code added &dA05/02/04&d@ for oddeven shift &dA #if PRINT pageside = 10 #if ODDEVENSHIFT putc Shift odd/even pages for better binding? Enter "Y" = yes getc line line = line // pad(1) if line = "Y" or line = "y" pageside = 0 xleftpageshift = 0 putc The even-page shift may cause words on the far left have a negative x position putc When this occurs, the printer places the words on the far right and the program putc issues a WARNING. This problem can be corrected by shifting the even-pages putc to the right by an amount that guarentees a positive x position for all words. putc Enter even-page shift in dots (300ths of a inch); &dEType for none&d@. getc xleftpageshift putc * end #endif #endif &dA &dA &dA &d@ Determine page labeling method &dA open [4,1] sourcelib LOOK_AGAIN: getf [4] temp .t10 name_ext temp = temp // pad(15) if temp{14,2} = "~temp goto LOOK_AGAIN end name_ext = trm(name_ext) /* Code added &dA11/11/03&d@ temp = temp // pad(8) temp = temp{1,8} temp = trm(temp) i = int(temp) if i = 0 goto LOOK_AGAIN end goto LAG &dA &dA &d@ Graceful exit added &dA11/11/03&d@ &dA eof4: putc No page numbers found in the specified source library putc putc &dAProgram Halted&d@ putc stop LAG: naming_method = len(temp) close [4] sourcelib = sourcelib // "\" &dA &dA &d@ Setup for printing and initialize strings for display &dA #if PRINT putp .b27 *t300R ... #else temp = chr(255) gline = dup(temp,360) setup blue_horiz1t,339,1,1 setup blue_horiz2t,178,1,1 setup blue_horiz3t,126,1,1 setup blue_horiz4t,100,1,1 setup blue_horiz1b,339,1,1 setup blue_horiz2b,178,1,1 setup blue_horiz3b,126,1,1 setup blue_horiz4b,100,1,1 setup blue_vert1v,1,3460,1 setup blue_vert2v,1,1810,1 setup blue_vert3v,1,1260,1 setup blue_vert4v,1,985,1 setup blue_vert1r,1,3460,1 setup blue_vert2r,1,1810,1 setup blue_vert3r,1,1260,1 setup blue_vert4r,1,985,1 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,3460} = dup(temp,3460) temp = chr(16) blue_vert1r{21,3460} = dup(temp,3460) 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) #endif f3 = 0 BIG: f3 = f3 + 1 if f3 > f2 putc .b27 Y.b27 F... stop end file = sourcelib if f1 < 10 and naming_method > 1 file = file // "0" end if f1 < 100 and naming_method > 2 file = file // "0" end if f1 < 1000 and naming_method > 3 file = file // "0" end &dA &dA &d@ Code added &dA05/02/04&d@ for oddeven shift &dA #if PRINT if pageside < 10 pageside = f1 & 0x01 end #endif &dA &dA &dA &d@ Code added &dA11/11/03&d@ &dA file = file // chs(f1) if name_ext <> "" file = file // "." // name_ext end &dA &dA &d@ Setup for display &dA #if PRINT #else setup gstr,300,3100,3 setup tstr2,240,1600,1 setup tstr3,160,1040,1 setup tstr4,160,1040,1 bitmode 2, xze, yze xze >>= 3 #endif &dA &dA &d@ Transfer source file to X table &dA #if REPORT putc Transferring page ~f1 to memory ... #endif ++f1 #if ODDEVEN ++f1 #endif open [1,1] file treset [X] loop for k = 1 to 50000 getf [1] line line = line // " " tput [X,k] ~line repeat eof1: close [1] #if REPORT putc Done! #endif f4 = k - 1 sysnum = 0 rec = 1 f12 = 0 #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif scf = notesize TOP: if rec > f4 #if PRINT putp ~ff ... #else i = 0 perform pan (i) if i = 1 if f1 = 2 f1 = 1 f3 -= 1 else f1 -= 2 f3 -= 2 end else if i = 2 --f1 --f3 end end #endif goto BIG end tget [X,rec] line line = trm(line) &dK #if SHOW_RECORDS putc .w6 ~rec ~line #endif &dK &dK &d@ examine &dK ++rec if line{1} = "E" line = line // pad(12) loop for k = 1 to SUPERMAX if supermap(k) <> 0 putc Outstanding superobject at end of line stop 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 stop 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 end if line{1} = "S" &dA &dA &d@ S Y S T E M (recoded &dA05/26/03&d@) &dIOK&d@ &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ &dA f12 = 0 sysnum = sysnum + 1 #if REPORT putc System ~sysnum putc Line ... #endif sub = 5 sp = int(line{sub..}) &dA &dA &d@ Code added &dA05/02/04&d@ for oddeven shift &dA #if PRINT if pageside < 10 if pageside = 0 /* left side sp -= LEFT_PAGE_SHIFT sp += xleftpageshift else sp += RIGHT_PAGE_SHIFT end end #endif &dA sysy = int(line{sub..}) syslen = int(line{sub..}) sysh = int(line{sub..}) f11 = int(line{sub..}) line = line // " " tline = line{sub..} tline = mrt(tline) syscode = tline{2..} if syscode con quote syscode = syscode{1,mpt-1} end &dA &dA &d@ Code to check number of parts in syscode (modified &dA11/13/03&d@) &dIOK&d@ &dA a2 = 0 loop for c8 = 1 to len(syscode) if ".:,;" con syscode{c8} ++a2 end repeat if a2 <> f11 and syscode <> "" putc &dASyscode Warning&d@: Incorrect number of parts in syscode. rec = ~(rec - 1) end &dA sysflag = 0 goto TOP end if line{1} = "L" &dA &dA &d@ L I N E &dA &d@ ÄÄÄÄÄÄÄ &dA &dA &dA &d@ New &dA08/28/03&d@. Must zero out parameters dyoff, uxstart, backloc, and ibackloc &dIOK &dA loop for c8 = 1 to 10 dyoff(c8) = 0 uxstart(c8) = 0 backloc(c8) = 0 ibackloc(c8) = 0 repeat line = line // " " f12 = f12 + 1 #if REPORT putc ~f12 ... #endif &dA &dA &d@ Field 2: y off-set in system &dA sq(f12) = int(line{3..}) sq(f12) += sysy &dA &dA &d@ Field 3: text off-set(s) from line (separated by |) &dA ntext = 0 NSR1: ++ntext f(f12,ntext) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR1 end &dA &dA &d@ Field 4: dyoff(s) separated by | &dA c8 = 0 NSR2: ++c8 dyoff(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR2 end &dA &dA &d@ Field 5: uxstart(s) separated by | &dA c8 = 0 NSR3: ++c8 uxstart(c8) = int(line{sub..}) if line{sub} = "|" ++sub goto NSR3 end &dA &dA &d@ Field 6: backloc(s) separated by | &dA c8 = 0 NSR4: ++c8 backloc(c8) = int(line{sub..}) ibackloc(c8) = backloc(c8) /* New &dA08/26/03&d@ &dIOK&d@ if line{sub} = "|" ++sub goto NSR4 end tline = line{sub+1..} tline = mrt(tline) &dA &dA &d@ Field 7: xbyte(s) (length of field = number of bytes) &dA 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 &dA &d@ New &dA08/28/03&d@ &dIOK&d@ &dA loop for c8 = 1 to ntext if dyoff(c8) = 0 dyoff(c8) = dyoff(1) end if uxstart(c8) = 0 uxstart(c8) = uxstart(1) end if backloc(c8) = 0 backloc(c8) = backloc(1) end if ibackloc(c8) = 0 ibackloc(c8) = ibackloc(1) end repeat &dA &dA &d@ Field 8: y off-set to virtual staff line (0 = none) &dA vst(f12) = 0 if tline con " " tline = tline{mpt..} vst(f12) = int(tline) tline = tline // " " tline = tline{sub..} end &dA &dA &d@ Field 9: notesize (0 = not specified; i.e., no change) &dA if tline con " " tline = tline{mpt..} c8 = int(tline) tline = tline // " " /* New code &dA09/14/03&d@ &dIOK&d@ tline = tline{sub..} /* " " " if chr(c8) in [6,14,21] if c8 <> notesize notesize = c8 perform init_par end end end nsz(f12) = notesize /* New code &dA11/13/03&d@ &dIOK&d@ &dA &dA &d@ Field 10: additional off-set for figured harmony New &dA09/14/03&d@ &dIOK&d@ &dA figoff(f12) = 0 if tline con " " tline = tline{mpt..} figoff(f12) = int(tline) tline = tline // " " /* New code &dA09/14/03&d@ &dIOK&d@ tline = tline{sub..} /* " " " end y = sq(f12) 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 end if line{1} = "X" &dA &dA &d@ X - L I N E &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄ &dA lpt = 3 tline = txt(line,[' '],lpt) z = int(tline) &dA &dA &d@ Code added &dA08/28/02&d@ &dIOK&d@ &dA if lpt > len(line) if z = 6 or z = 14 or z = 21 notesize = z perform init_par scf = notesize end goto TOP end tline = txt(line,[' '],lpt) x = int(tline) &dA &dA &d@ Code added &dA05/02/04&d@ for oddeven shift &dA #if PRINT if pageside < 10 if pageside = 0 /* left side x -= LEFT_PAGE_SHIFT x += xleftpageshift else x += RIGHT_PAGE_SHIFT end end #endif &dA tline = txt(line,[' '],lpt) y = int(tline) if lpt > len(line) line = "" else line = line{lpt+1..} line = trm(line) end &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA a1 = 0 perform setwords (a1) #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif scf = notesize goto TOP end if line{1} = "J" &dA &dA &d@ O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA tget [X,rec-1] line .t3 jtype ntype obx oby z i i supcnt * &dA &dA &d@ New code &dA09/14/03&d@ &dIOK&d@ &dA if jtype = "F" oby += figoff(f12) end save_jtype = jtype 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 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 stop 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 stop 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 line = line // pad(12) if line{1} = "E" if line{c8+2} = "*" goto YR2 end goto YR3 end if line{1,3} = "J N" YR1: tget [X,rec] line ++rec if "kKA" 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 end if line{1} = "k" &dA &dA &d@ "Silent" S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA goto TOP end if line{1} = "K" &dA &dA &d@ S U B - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA tget [X,rec-1] .t3 sobx soby z x = sp + obx + sobx y = sq(f12) + oby + soby perform setmus &dA &dA &d@ Adding code &dA05/26/03&d@ for printing repeat dots on the grandstaff &dIOK&d@ &dA if save_jtype = "B" and z = DOT_CHAR y += vst(f12) perform setmus end goto TOP end if line{1} = "A" /* Added &dA11-11-93&d@ &dA &dA &d@ A T T R I B U T E S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA goto TOP end if line{1} = "W" &dA &dA &d@ W O R D S &dA &d@ ÄÄÄÄÄÄÄÄÄ &dA lpt = 3 tline = txt(line,[' '],lpt) * line structure = sobx soby font# text sobx = int(tline) tline = txt(line,[' '],lpt) soby = int(tline) tline = txt(line,[' '],lpt) z = int(tline) if len(line) > lpt and z <> 0 /* &dA10/01/03&d@ adding condition z <> 0 &dIOK line = line{lpt+1..} x = sp + obx + sobx y = sq(f12) + oby + soby a1 = 0 &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA perform setwords (a1) end goto TOP end if line{1} = "T" &dA &dA &d@ T E X T &dA &d@ ÄÄÄÄÄÄÄ &dA 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 = "" stop end goto TOP end soby = 0 if line{sub} = "|" ++sub soby = int(line{sub..}) end line = line{sub..} line = mrt(line) /* ttext is next in line &dA &dA &d@ New &dA08/28/03&d@ Stripping of ttext moved up 26 lines to here. We &dIOK &dA &d@ need to know if ttext = "~" in order to set underflag &dA &d@ correctly. &dA if line con " " ttext = line{1,mpt-1} line = line{mpt..} line = mrt(line) end &dA &dA &d@ typeset back hyphons or underlines (if they exist) &dA if 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) if ttext = "~" underflag = 2 /* New &dA08/28/03&d@ don't set punctuation 'till after next note. &dIOK else underflag = 1 end &dK &d@ underflag = 1 perform setunder (tlevel) end &dA &dA &d@ typeset underline if terminator (~) is found (Code added &dA02-24-95&d@) &dA if ttext = "~" x = sp + obx + sobx + hpar(20) + hpar(20) uxstop(tlevel) = x y = sq(f12) + f(f12,tlevel) underflag = 1 perform setunder (tlevel) xbyte(tlevel) = " " /* New &dA08/28/03&d@ xbyte zeroed &dEafter&d@ calling setunder &dIOK 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 &dA &dA &d@ &dA04/22/04&d@ replacing settext with setwords &dA &dA &d@ Call to setwords now includes paramter: 1 = setwords called from TEXT sub-obj &dA z = mtfont line = ttext a1 = 1 perform setwords (a1) &dK &d@ perform settext &dA goto TOP end if line{1} = "H" &dA &dA &d@ S U P E R - O B J E C T S &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA lpt = 3 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 stop * k = index into superdata WB: htype = txt(line,[' '],lpt) &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. post adjustment of calculated left x position &dA04/20/03&d@ &dIOK &dA &d@ 8. post adjustment of calculated y position " &dA &d@ 9. post adjustment of calculated right x position " &dA &d@ 10. sitflag &dA &d@ 11. recalc flag &dA tline = txt(line,[' '],lpt) y1 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) tline = txt(line,[' '],lpt) tpost_x = int(tline) /* added &dA04/20/03&d@ etc. &dIOK tline = txt(line,[' '],lpt) tpost_y = int(tline) tline = txt(line,[' '],lpt) tpost_leng = int(tline) tline = txt(line,[' '],lpt) sitflag = int(tline) 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 NEWFONTS i = Mbeamfont(notesize) /* covers all 12 notesizes #else if notesize = 6 /* Old code i = 103 end if notesize = 21 i = 112 end if notesize = 14 i = 108 end #endif 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@ 10. beam flag &dA &d@ 11. post adjustment to x co-ordinate &dA &d@ 12. post adjustment to y co-ordinate &dA slur_edit_flag = 0 tline = txt(line,[' '],lpt) sitflag = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + 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 &d@ 7. (optional) additional vert. disp. &dANew 11/06/03 &dA &d@ from default height &dA tline = txt(line,[' '],lpt) a3 = int(tline) tline = txt(line,[' '],lpt) x1 = int(tline) + superdata(k,1) tline = txt(line,[' '],lpt) x2 = int(tline) + superdata(k,3) &dA &dA &d@ Adding code &dA11/06/03&d@ to look for optional additional vert. disp. &dA y1 = 0 if lpt < len(line) tline = txt(line,[' '],lpt) y1 = int(tline) end perform putfigcon 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 end if line{1} = "B" &dA &dA &d@ B A R L I N E (section recoded &dA05/26/03&d@) &dIOK&d@ &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA sub = 3 a7 = int(line{sub..}) if a7 = 99 if sysflag = 0 #if REPORT putc #endif sysflag = 1 end goto TOP end &dA &dA &d@ First make sure that the system line is printed. &dA &d@ (this code moved here and revised &dA11/13/03&d@) &dIOK&d@ &dA savesub = sub savensz = notesize if sysflag = 0 #if REPORT putc #endif &dA &d@ Code added here &dA11/13/03&d@ to set govstaff for printing sysline, etc. &dIOK&d@ govstaff = 0 a2 = 0 loop for c8 = 1 to len(syscode) if ".:,;" con syscode{c8} ++a2 if mpt > 2 if govstaff = 0 govstaff = a2 else if nsz(a2) > nsz(govstaff) govstaff = a2 end end end end repeat if govstaff = 0 govstaff = f11 /* default for govstaff end a2 = nsz(govstaff) if a2 <> notesize notesize = a2 perform init_par end perform sysline sysflag = 1 end sub = savesub &dA a8 = a7 & 0x0f x = int(line{sub..}) brkcnt = int(line{sub..}) loop for i = 1 to brkcnt a6 = int(line{sub..}) barbreak(i,1) = a6 + sysy a6 = int(line{sub..}) 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 &dA &dA &d@ Adding code &dA05/26/03&d@ for print second set of dots in case of grandstaff &dIOK &dA &d@ if vst(f12) > 0 y = y - vpar(2) + vst(f12) z = 44 perform setmus y = y + vpar(2) perform setmus end repeat end end if a8 = 10 z = 84 perform barline x = x - hpar(33) - hpar(34) + 1 perform barline end &dA &dA &d@ Code added &dA11/13/03&d@ to reset notesize to local value &dIOK&d@ &dA if notesize <> savensz notesize = savensz perform init_par end &dA goto TOP end goto TOP &dA &dA &d@ End of processing music data &dA &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@ Inputs: bcount = number of notes under beam &dA &d@ beamdata(.,1) = x-position of note &dA &d@ beamdata(.,2) = y-position of note &dA &d@ beamcode(.) = beam code &dA &dA &d@ beam code = 6 digit number (string) &dA &dA &d@ 0 = no beam &dA &d@ 1 = continue beam &dA &d@ 2 = begin beam &dA &d@ 3 = end beam &dA &d@ 4 = forward hook &dA &d@ 5 = backward hook &dA &d@ 6 = single stem repeater &dA &d@ 7 = begin repeated beam &dA &d@ 8 = end repeated beam &dA &dA &d@ 100000's digit = eighth level beams &dA &d@ 10000's digit = 16th level beams &dA &d@ 1000's digit = 32nd level beams &dA &d@ 100's digit = 64th level beams &dA &d@ 10's digit = 128th level beams &dA &d@ 1's digit = 256th level beams &dA &dA &dA &d@ @k = distance from first object (oby of &dA &d@ note group) to top of top beam (for &dA &d@ stems up) or bottom of bottom beam &dA &d@ (for stems down). @k > 0 means &dA &d@ stem up. &dA &d@ @m = number of dots the beam falls &dA &d@ (rises = negative) in a distance &dA &d@ of 30 horizontal dots. (i.e. &dA &d@ slope * 30) &dA &d@ beamfont = font for printing beam &dA &d@ stemchar = character number for stem &dA &d@ beamh = height parameter for beams &dA &d@ beamt = vertical space between beams (normally 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: &dA &d@ beamfy = y coordinate of first note under beam &dA &d@ @b = y-intercept of beam &dA &d@ @f = temporary variable &dA &d@ @g = temporary variable (related to @@g) &dA &d@ @h = temporary variable &dA &d@ @i = temporary variable &dA &d@ @j = temporary counter &dA &d@ @k = |@m| &dA &d@ @n = temporary variable &dA &d@ @q = temporary counter &dA &d@ @s = temporary variable &dA &d@ @t = temporary variable &dA &d@ @@b = vertical range of note set &dA &d@ @@g = top of staff line &dA &d@ @@n = temporary variable &dA &d@ @@q = temporary variable &dA &d@ bthick = thickness of beam - 1 &dA &d@ (x1,y1) = temporary coordinates &dA &d@ (x2,y2) = temporary coordinates &dA &d@ z1,z2,z3 = temporary character numbers &dA &d@ stemdir(80) = stem directions for mixed direction case &dA &d@ stemends(80) = stem endpoints for mixed direction case &dA &d@ beampos(8) = position of beam (mixed stem dir) &dA &d@ beamlevel = index into beampos(one for each note belonging to beam) &dA &d@ procedure 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,t2 /* NEW int bshflg &dK &dK &d@ calling information &dK &dK &d@ dputc Calling information &dK &d@ loop for @b = 1 to bcount &dK &d@ putc .t10 x = ~beamdata(@b,1) .t20 y = ~beamdata(@b,2) .t30 beamcode = ~beamcode(@b) &dK &d@ repeat &dK &d@ dputc &dK &dA &dA &d@ check for errors in beam repeaters &dA loop for @j = 1 to bcount if beamcode(@j) con "7" or beamcode(@j) con "8" if bcount <> 2 putc Improper use of beam repeaters goto BERR end loop for @j = 1 to 6 if "270" con beamcode(1){@j} if beamcode(1){@j} = "2" if beamcode(2){@j} <> "3" putc Mismatching beamcodes goto BERR end end if beamcode(1){@j} = "7" if beamcode(2){@j} <> "8" putc Mismatching beamcodes goto BERR end end if beamcode(1){@j} = "0" if beamcode(2){@j} <> "0" putc Mismatching beamcodes goto BERR end end else putc Improper use of beam repeaters goto BERR end repeat @j = 10000 end repeat &dA &dA &d@ Determine direction of first stem &dA if @k = 0 or @k = 1 putc Old format for beams. This code has been disabled. putc Please run mskpage on data to get current format. putc putc &dAProgram Halted&d@ putc stop end if @k > 0 stem = UP else stem = DOWN end &dA &dA &d@ Check for situation where notes span two staves (grand staff) &dA staff_height = 0 if 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 else @j = vpar(39) + vpar(38) + @s - sq(f12) y1 = beamdata(1,2) + @j y2 = beamdata(bcount,2) + @j end &dA &dA &d@ Adding code &dA05/09/03&d@ to make space for numbers inside brackets &dIOK&d@ &dA sitflag = tupldata(1) @s = vpar(1) if bit(0,sitflag) = 1 /* number present if bit(1,sitflag) = 1 /* bracket present if bit(4,sitflag) = 0 /* number near note head if bit(5,sitflag) = 1 /* continuous bracket if bit(6,sitflag) = 1 /* number inside if bit(2,sitflag) = 0 /* tips down y1 -= vpar(2) /* raise bracket y2 -= vpar(2) @s = vpar(3) else /* tips up y1 += vpar(2) /* lower bracket y2 += vpar(2) @s = vpar(2) end end end end end end if stem = DOWN if staff_height <> 10000 @h = 0 - notesize * 2 / 3 + staff_height - @s if y1 > @h y1 = @h end if y2 > @h y2 = @h end end else if staff_height <> 10000 @h = 11 * notesize / 2 + staff_height + @s if y1 < @h y1 = @h end if y2 < @h y2 = @h end end end a1 = tupldata(2) x1 = tupldata(3) + beamdata(1,1) - 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 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@ &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@ &dIOK&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} = "7" dv3 = (vpar(2) + beamt) * hpar(1) / 2 + dv3 else if beamcode(1){@q} = "6" dv3 = vpar(2) * hpar(1) + dv3 else dv3 = beamt * hpar(1) + dv3 end end bshflg = 0 loop for @j = 1 to bcount if "123456780" con beamcode(@j){@q} if mpt = 2 @i = @j BB1: ++@j if @j > bcount putc @j (~@j ) exceeds bcount (~bcount ) goto BERR end if "1234560" con beamcode(@j){@q} if mpt = 1 goto BB1 else if mpt = 3 * // print beam if @i > 1 and bshflg = 0 dv3 += (3 * hpar(1) / 8) bshflg = 1 end x1 = beamdata(@i,1) x2 = beamdata(@j,1) perform printbeam goto BBR * \\ else putc expecting a "1" or a "3" here (got a ~beamcode(@j){@q} ) putc beamcode(~@j ) = ~beamcode(@j) goto BERR end end end end if mpt = 7 * // print beam x1 = beamdata(1,1) + hpar(59) x2 = beamdata(2,1) - hpar(59) perform printbeam goto BBR * \\ end if mpt = 1 putc "1" not allowed in this position goto BERR end if mpt = 3 putc "3" not allowed in this position goto BERR end t1 = 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@ NEW &dA05/19/03&d@ I am going to attempt a rewrite of this section. The problem &dIOK &dA &d@ with the old code was that it sometimes didn't give asthetically pleasing &dA &d@ solutions. In particular, the problem arises when a secondary beam is &dA &d@ to be drawn between endpoints whose stems are in different directions. &dA &d@ The old code made the arbitrary decision to draw the secondary beam according &dA &d@ to the direction of the stem of the initial note. This had the additional &dA &d@ advantage that stems could be drawn as notes were processed, i.e., we would &dA &d@ not have to go back and "lengthen" a stem because a secondary beam was &dA &d@ drawn on the other side of the primary. &dA &dA &d@ With this rewrite, I must change this, i.e., stems cannot be drawn until &dA &d@ all beams are set. Secondly, I need to come up with a set of rules as to &dA &d@ how to deal with the situation where the endpoints of a secondary connect &dA &d@ to stems of different directions. I propose to generate these rules from &dA &d@ experience, and by trial and error. As we encounter situations where the &dA &d@ result seems to violate common sense, then we can consider adding a new &dA &d@ rule. It should be pointed out that at the moment &dEthere is no provision &dA &d@ &dEmade for editing the decision made by this program&d@ as regards the placing &dA &d@ of secondary beams. To add this feature, we would need to expand the &dA &d@ contents of the beam super-object record. &dA &dA &d@ As of this date &dA05/19/03&d@, I have only one rule to propose for cases where &dIOK &dA &d@ the endpoints have stems that go in different directions. &dA &d@ &dA &d@ 1. If there is a stem that follows the terminating stem, then use &dA &d@ use this stem direction to "arbitrate" between the directions of &dA &d@ the endpoint stems. If no stem follows, then the stem direction &dA &d@ of the initial note wins. &dA &dA &dA &d@ 3. Loop through notes, one at a time &dA loop for @j = 1 to bcount x1 = beamdata(@j,1) if stemdir(@j) = DOWN if stem = UP x1 -= qwid - hpar(29) else x1 += qwid - hpar(29) end end savex1 = x1 &dA &dA &d@ a. put in stem (this function moved to after beams are drawn) &dA &dK &d@ if stemdir(@j) = UP &dK &d@ y1 = stemends(@j) &dK &d@ y2 = beamdata(@j,2) &dK &d@ else &dK &d@ y2 = stemends(@j) &dK &d@ y1 = beamdata(@j,2) + 2 /* I think this is needed &dK &d@ end &dK &d@ y1 += vpar(4) &dK &d@ z3 = stemchar &dK &d@ if y1 >= y2 &dK &d@ z3 += 2 &dK &d@ y1 -= vpar(2) &dK &d@ loop while y1 < y2 &dK &d@ perform revset &dK &d@ y1 += vpar(2) &dK &d@ repeat &dK &d@ else &dK &d@ loop while y1 < y2 &dK &d@ perform revset &dK &d@ y1 += vpar(4) &dK &d@ repeat &dK &d@ end &dK &d@ y1 = y2 &dK &d@ perform revset &dA &dA &d@ b. add &dAall&d@ extra beams starting at this note (and increase beamlevel accordingly) &dA loop for @h = beamlevel(@j) + 1 to 6 if beamcode(@j){@h} = "2" /* begin beam ++beamlevel(@j) /* increment beamlevel for starting point loop for @g = @j + 1 to bcount if beamcode(@g){@h} = "3" /* end beam x1 = savex1 /* x1 needs to be reset for each beam x2 = beamdata(@g,1) /* if stemdir(bcount) = DOWN if stemdir(@g) = DOWN /* Correction &dA9-21-96&d@ if stem = UP x2 -= qwid - hpar(29) else x2 += qwid - hpar(29) end end dv3 = beampos(1) &dA &dA &d@ Here is where the rules take effect. &dA &dA &d@ Case I: Use stem direction of first note to determine secondary beam position &dA &dA &d@ cases: 1) Normal: stemdir(@g) = stemdir(@j) &dA &dA &d@ 2) stemdir(@g) <> stemdir(@j) but &dA &d@ either @g = bcount &dA &d@ or stemdir(@g+1) = stemdir(@j) &dA t2 = 0 if stemdir(@g) <> stemdir(@j) if @g < bcount if stemdir(@g+1) <> stemdir(@j) t2 = 1 end end end if t2 = 0 loop for @f = 1 to beamlevel(@g) if stemdir(@j) = UP if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat ++beamlevel(@g) /* increment beamlevel for endpoint if stemdir(@j) = UP dv3 += (beamt * hpar(1)) else dv3 -= (beamt * hpar(1)) end beampos(beamlevel(@g)) = dv3 perform printbeam &dA &dA &d@ c. adjust stem ends for notes under (over) this beam &dA loop for @f = @j + 1 to @g if stemdir(@j) = UP if stemdir(@f) = DOWN stemends(@f) += beamt end else if stemdir(@f) = UP stemends(@f) -= beamt end end repeat else &dA &dA &d@ Case II: Use stem direction of last note to determine secondary beam position &dA &dA &d@ cases: 1) stemdir(@g) <> stemdir(@j), and &dA &d@ @g < bcount, and &dA &d@ stemdir(@g+1) = stemdir(@g) &dA loop for @f = 1 to beamlevel(@g) if stemdir(@g) = UP /* changing @j to @g if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat ++beamlevel(@g) /* increment beamlevel for endpoint if stemdir(@g) = UP /* changing @j to @g dv3 += (beamt * hpar(1)) else dv3 -= (beamt * hpar(1)) end beampos(beamlevel(@g)) = dv3 perform printbeam &dA &dA &d@ c. adjust stem ends for notes under (over) this beam &dA loop for @f = @j to @g if stemdir(@g) = UP /* changing @j to @g if stemdir(@f) = DOWN stemends(@f) += beamt end else if stemdir(@f) = UP stemends(@f) -= beamt end end repeat end @g = 10000 else &dA &dA &d@ Increment beamlevel for all notes between endpoints of this beam &dA ++beamlevel(@g) end repeat if @g <> 10000 putc No termination found for beam goto BERR end else @h = 6 end repeat &dA &dA &d@ d. put in any hooks that might go with this note &dA loop for @h = beamlevel(@j) + 1 to 6 if "456" con beamcode(@j){@h} /* begin beam @g = mpt loop for @f = 1 to beamlevel(@j) if stemdir(@j) = UP if beampos(@f) > dv3 dv3 = beampos(@f) end else if beampos(@f) < dv3 dv3 = beampos(@f) end end repeat if @g = 3 t1 = 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 repeat &dA &dA &d@ 4. Loop again through notes, one at a time, and now draw the stems (&dA05/19/03&d@) &dIOK &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 repeat &dA &dA &d@ End of &dA05/19/03&d@ rewrite &dIOK&d@ &dA end return BERR: putc Beam format error, printbeam aborted return &dA &d@ &dA &dA &d@*P&dA 2. hook &dA &d@ &dA &dA &d@ Purpose: Typeset hook beam &dA &dA &d@ Inputs: @m = slope * 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 int pz /* added &dA03/15/04&d@ 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 #if PRINT #if NEWFONTS pz = beamfont - 100 + BEAM_OFFSET putp .b27 (~pz X.b27 *p~x x~y Y.b(z) ... pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~beamfont X.b27 *p~x x~y Y.b(z) .b27 (~notesize X... #endif #else scf = beamfont scx = x scy = y scb = z perform charout #endif 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 pz /* added &dA03/15/04&d@ int x3 x = x1 if stem = UP x += qwid - hpar(29) end #if PRINT #if NEWFONTS pz = beamfont - 100 + BEAM_OFFSET putp .b27 (~pz X.b27 *p~x X... #else putp .b27 (~beamfont X.b27 *p~x X... #endif #else scx = x #endif scf = beamfont 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: #if PRINT putp .b27 *p~y Y.b65 ... #else scy = y scb = 65 perform charout #endif x += hpar(2) if x < x2 goto PBEAM01 end #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 *p~x2 X.b65 .b27 (~pz X... #else putp .b27 *p~x2 X.b65 .b27 (~notesize X... #endif #else scx = x2 scb = 65 perform charout #endif 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 #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif 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 #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif 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 #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 *p~x x~y Y.b33 .b27 (~pz X... #else putp .b27 *p~x x~y Y.b33 .b27 (~notesize X... #endif #else scx = x scy = y scb = 33 perform charout #endif scf = notesize return end #if PRINT out = esc // "*p" // chs(y) // "Y" #else scy = y #endif 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 #if PRINT out = out // chr(z) #else scb = z perform charout #endif if y2 < x2 ++y1 x1 = beamext(x3,y1) if stem = 1 x1 = 0 - x1 end if @m > 0 x1 = 0 - x1 end y -= x1 #if PRINT out = out // esc // "*p" // chs(y) // "Y" #else scy = y #endif ++y1 end repeat #if PRINT #if NEWFONTS pz = revsizes(notesize) putp ~out .b27 (~pz X... #else putp ~out .b27 (~notesize X... #endif #endif 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 if z = 0 return end sy = y - pos(z-32) #if PRINT putp .b27 *p~x x~sy Y.b(z) ... #else scx = x scy = sy scb = z perform charout #endif return &dA &dA &dA &d@ &dA04/22/04&d@ Setwords now occurs in two version: oldfonts and NEWFONTS &dA #if NEWFONTS &dA &d@ &dA &dA &d@*P&dA 6. setwords (with NEWFONTS) &dA &d@ &dA &dA &d@ Purpose: Typeset words &dA &dA &d@ Inputs: x = horizontal position of words &dA &d@ y = vertical position of words &dA &d@ z = font number for words &dA &d@ line = words to set &dA &dA procedure setwords (a1) str textline.300 int pz /* added &dA03/15/04&d@ int t1 &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA &d@ 1 = setwords called from TEXT sub-obj &dA int a1 getvalue a1 &dA &dA &d@ &dA04/22/04&d@ This code taken from settext (&dA08/31/03&d@ &dIOK&d@) &dA if a1 = 1 and line = "&" return end &dA if x < 0 putc &dAWARNING&d@: Attempting to typeset a word with a (net) negative x position putc page = ~(f1 - 1) x = ~x end #if PRINT if z = 1 pz = revsizes(notesize) else if z <= 24 pz = revsizes(z) else t1 = revsizes(notesize) pz = XFonts(t1,z-29) end end putp .b27 *p~x x~y Y.b27 (~pz X... #else scx = x scy = y #endif if z = 1 /* added &dA03/15/04&d@ scf = notesize else scf = z end textline = line // " " A11: if textline con "\" if mpt > 1 t1 = mpt line2 = textline{1,mpt-1} perform lineout textline = textline{t1..} goto A11 end if textline{2} = "\" line2 = "\" perform lineout textline = textline{3..} goto A11 end &dA &dA &d@ This coded added &dA03/05/04&d@ to implement "in-line" space commands &dA if "!@#$%^&*(-=" con textline{2} textline = chr(130+mpt) // textline{3..} goto A11 end &dA if textline{2} = "0" t1 = ors(textline{3}) + 128 if chr(t1) in [160,206,212,224] else line2 = chr(t1) perform lineout end textline = textline{4..} goto A11 end if textline{2} in ['a'..'z','A'..'Z'] d1 = ors(textline{2}) if textline{3} = "1" if "ANOano" con textline{2} t1 = d1 + 140 /* 140 = wak(1) else if textline{2} in ['A'..'Z'] t1 = 205 else t1 = 237 end end line2 = chr(t1) // textline{2} else if textline{3} = "5" if textline{2} in ['A'..'Z'] t1 = 211 /* 211 = wak(5)(=128) + 83(S) else t1 = 243 end line2 = chr(t1) // textline{2} else if textline{3} = "2" if "CcOos" con textline{2} if mpt < 3 line2 = chr(d1+156) // textline{2} /* 156 = wak(2) else if mpt < 5 line2 = chr(d1+143) // textline{2} /* 79(O) + 143 = 222 etc. else line2 = chr(244) /* German ss end end else line2 = textline{2} end else if textline{3} = "4" if "Aa" con textline{2} line2 = chr(d1+156) // textline{2} /* 156 = wak(4) else line2 = textline{2} end else if "7893" con textline{3} t1 = mpt + 127 /* wak(3,7,8,9) if ("73" con textline{3} and "Yy" con textline{2}) or "AEIOUaeiou" con textline{2} if textline{2} = "i" line2 = chr(d1+t1) // chr(238) /* 238 = dotless i else line2 = chr(d1+t1) // textline{2} end else line2 = textline{2} end else line2 = "\" perform lineout textline = textline{2..} goto A11 end end end end end perform lineout textline = textline{4..} goto A11 else line2 = "\" perform lineout textline = textline{2..} goto A11 end else t1 = len(textline) - 2 if t1 > 0 line2 = textline{1,t1} perform lineout end end #if PRINT pz = revsizes(notesize) putp .b27 (~pz X... #endif scf = notesize return &dA &d@ &dA &d@ End of setwords with NEWFONTS &dA &dA #else &dA &d@ &dA &dA &d@*P&dA 6. setwords (under oldfonts) &dA &d@ &dA &dA &d@ Purpose: Typeset words &dA &dA &d@ Inputs: x = horizontal position of words &dA &d@ y = vertical position of words &dA &d@ z = font number for words &dA &d@ line = words to set &dA &dA procedure setwords (a1) str textline.300 int pz /* added &dA03/15/04&d@ int t1 &dA &dA &d@ &dA04/22/04&d@ Call to setwords now includes paramter: 0 = regular setwords call &dA &d@ 1 = setwords called form TEXT sub-obj &dA int a1 getvalue a1 &dA &dA &d@ &dA04/22/04&d@ This code taken from settext (&dA08/31/03&d@ &dIOK&d@) &dA if a1 = 1 and line = "&" return end &dA #if PRINT pz = fontmap(z) putp .b27 *p~x x~y Y.b27 (~pz X... #else scx = x scy = y #endif if z = 1 /* added &dA03/15/04&d@ scf = notesize else scf = z end textline = line // " " A11: if textline con "\" if mpt > 1 t1 = mpt line2 = textline{1,mpt-1} perform lineout textline = textline{t1..} end &dA &dA &d@ This coded added &dA03/05/04&d@ to implement "in-line" space commands &dA if "!@#$%^&*(-=" con textline{2} textline = chr(130+mpt) // textline{3..} goto A11 end &dA if textline{2,2} in ['0'..'9'] if "123456789" con textline{3} t1 = mpt else if "123456789" con textline{2} t1 = mpt else t1 = 0 end end t1 += 176 line2 = chr(t1) else if textline{2} in ['0'..'9'] d1 = ors(textline{3}) if textline{2} = "0" d1 += 128 line2 = "" if d1 = 171 #if PRINT line2 = line2 // esc // "*p-" // chs(hpar(4)) // "X" #else scx -= hpar(4) #endif 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 #if PRINT line2 = line2 // esc // "*p-" // chs(hpar(4)) // "X" #else scx -= hpar(4) #endif 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 #if PRINT putp .b27 (~notesize X... #endif scf = notesize return #endif &dA &dA &d@ &dA04/22/04&d@ End of division of setwords &dA &dA &dA &d@ &dA &dA &d@*P&dA 6a. lineout &dA &d@ &dA &dA &d@ Purpose: Send a line of text to output device &dA &dA &d@ Inputs: line2 &dA &d@ z = font number for words &dA &dA &d@ Side effects: value of z may be changed &dA &d@ value of scf may be changed &dA procedure lineout int pz /* added &dA03/15/04&d@ int t1, t2, t3 str textline.300 AAA111: if line2 con "!" t1 = mpt if t1 > 1 if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ textline = line2{1,t1-1} else textline = "" loop for t2 = 1 to t1 - 1 t3 = ors(line2{t2}) t3 = music_con(t3) textline = textline // chr(t3) repeat end #if PRINT &dA &dA &d@ Code substitution &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dA &d@ we have implemented a PRINT version of stringout. &dA perform stringout (textline) &dK &d@ putp ~textline ... &dA #else perform stringout (textline) #endif line2 = line2{t1..} end if len(line2) > 1 if "0123456789" con line2{2} z = int(line2{2..}) &dN &d@ z = fontmap(z) ERROR found &dA08/28/02&d@ &dIOK&d@ #if PRINT #if NEWFONTS if z = 1 pz = revsizes(notesize) else if z <= 24 pz = revsizes(z) else t1 = revsizes(notesize) pz = XFonts(t1,z-29) end end #else pz = fontmap(z) #endif putp .b27 (~pz X... #endif if z = 1 /* added &dA03/15/04&d@ scf = notesize else scf = z end if sub <= len(line2) line2 = line2{sub..} &dA &dA &d@ Code added &dA01/17/04&d@ to remove terminator to font designation field &dA if line2{1} = "|" if len(line2) = 1 return end line2 = line2{2..} end &dA goto AAA111 else return end else if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ textline = "!" else t3 = ors("!") t3 = music_con(t3) textline = chr(t3) end #if PRINT &dA &dA &d@ Code substitution &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dA &d@ we have implemented a PRINT version of stringout. &dA perform stringout (textline) &dK &d@ putp ~textline ... &dA #else perform stringout (textline) #endif line2 = line2{2..} goto AAA111 end end end if z <> notesize and z <> 1 /* z <> 1 added &dA01/13/04&d@ textline = line2 else textline = "" loop for t2 = 1 to len(line2) t3 = ors(line2{t2}) t3 = music_con(t3) textline = textline // chr(t3) repeat end #if PRINT &dA &dA &d@ Code substitution &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dA &d@ we have implemented a PRINT version of stringout. &dA perform stringout (textline) &dK &d@ putp ~textline ... &dA #else perform stringout (textline) #endif 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 &dK &d@ procedure settext &dK &d@ int pz /* added &dA03/15/04&d@ &dK &d@ int t1 &dA &dA &d@ New &dA08/31/03&d@ &dIOK&d@ &dA &dK &d@ if ttext = "&" &dK &d@ return &dK &d@ end &dK &dK#&d@if PRINT &dK &dK#&d@if NEWFONTS &dK &d@ t1 = revsizes(notesize) &dK &d@ pz = XFonts(t1,mtfont-29) &dK#&d@else &dK &d@ pz = fontmap(mtfont) &dK#&d@endif &dK &dK &d@ putp .b27 (~pz X.b27 *p~x x~y Y... &dK#&d@else &dK &d@ scx = x &dK &d@ scy = y &dK#&d@endif &dK &d@ scf = mtfont &dK &dK &d@ textline = ttext // " " &dKA&d@1: if textline con "\" &dK &d@ if mpt > 1 &dK &d@ t1 = mpt &dK &d@ line2 = textline{1,mpt-1} &dK &dK#&d@if PRINT &dK &dK &d@ Code substitution &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dK &d@ we have implemented a PRINT version of stringout. &dK &dK &d@ perform stringout (line2) &dK &d@ putp ~line2 ... &dA &dK#&d@else &dK &d@ perform stringout (line2) &dK#&d@endif &dK &dK &d@ textline = textline{t1..} &dK &d@ end &dK &d@ if textline{2,2} in ['0'..'9'] &dK &d@ if "123456789" con textline{3} &dK &d@ t1 = mpt &dK &d@ else &dK &d@ if "123456789" con textline{2} &dK &d@ t1 = mpt &dK &d@ else &dK &d@ t1 = 0 &dK &d@ end &dK &d@ end &dK &d@ t1 += 176 &dK &d@ line2 = chr(t1) &dK &d@ else &dK &d@ if textline{2} in ['0'..'9'] &dK &d@ d1 = ors(textline{3}) &dK &d@ if textline{2} = "0" &dK &d@ d1 += 128 &dK &d@ line2 = "" &dK &d@ if d1 = 171 &dK &dK#&d@if PRINT &dK &d@ line2 = line2 // esc // "*p-" // chs(hpar(4)) // "X" &dK#&d@else &dK &d@ scx -= hpar(4) &dK#&d@endif &dK &dK &d@ end &dK &d@ line2 = line2 // chr(d1) &dK &d@ else &dK &d@ if textline{2,2} = "2s" &dK &d@ line2 = chr(175) &dK &d@ else &dK &d@ d2 = int(textline{2}) &dK &d@ d1 += wak(d2) &dK &d@ line2 = chr(d1) // textline{3} &dK &d@ end &dK &d@ end &dK &d@ else &dK &d@ d1 = ors(textline{2}) &dK &d@ if textline{3} = "0" &dK &d@ d1 += 128 &dK &d@ line2 = "" &dK &d@ if d1 = 171 &dK &dK#&d@if PRINT &dK &d@ line2 = line2 // esc // "*p-" // chs(hpar(4)) // "X" &dK#&d@else &dK &d@ scx -= hpar(4) &dK#&d@endif &dK &dK &d@ end &dK &d@ line2 = line2 // chr(d1) &dK &d@ else &dK &d@ if textline{2,2} = "s2" &dK &d@ line2 = chr(175) &dK &d@ else &dK &d@ d2 = int(textline{3}) &dK &d@ d1 += wak(d2) &dK &d@ line2 = chr(d1) // textline{2} &dK &d@ end &dK &d@ end &dK &d@ end &dK &d@ end &dK#&d@if PRINT &dK &dK &d@ Code substitution &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dK &d@ we have implemented a PRINT version of stringout. &dK &dK &d@ perform stringout (line2) &dK &d@ putp ~line2 ... &dA &dK#&d@else &dK &d@ perform stringout (line2) &dK#&d@endif &dK &dK &d@ textline = textline{4..} &dK &d@ goto A1 &dK &d@ else &dK &dK#&d@if PRINT &dK &dK &d@ Code substitution &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dK &d@ we have implemented a PRINT version of stringout. &dK &dK &d@ perform stringout (textline) &dK &d@ putp ~textline ... &dA &dK#&d@else &dK &d@ perform stringout (textline) &dK#&d@endif &dK &dK &d@ end &dK &dK#&d@if PRINT &dK &dK#&d@if NEWFONTS &dK &d@ pz = revsizes(notesize) &dK &d@ putp .b27 (~pz X... &dK#&d@else &dK &d@ putp .b27 (~notesize X... &dK#&d@endif &dK &dK#&d@endif &dK &d@ scf = notesize &dK &dK &d@ return &dA &d@ &dA &dA &d@*P&dA 8. staff &dA &d@ &dA &dA &d@ Purpose: Typeset staff &dA &dA &d@ Inputs: y = absolute vertical location &dA &d@ sp = starting point of staff lines &dA &d@ syslen = length of staff lines &dA procedure staff int slen if notesize >= 10 slen = 64 else slen = 32 end &dK &d@ if notesize = 14 &dK &d@ slen = 64 &dK &d@ end &dK &d@ if notesize = 6 &dK &d@ slen = 32 &dK &d@ end &dK &d@ if notesize = 21 &dK &d@ slen = 64 &dK &d@ end #if PRINT d2 = sp + syslen - slen z = 81 loop for x = sp to d2 step slen perform setmus repeat x = d2 perform setmus #else if notesize = 21 /* Added &dA11/18/03&d@ to fill holes in lines d2 = sp + syslen - slen z = 81 loop for x = sp to d2 step slen - 1 perform setmus ++x perform setmus repeat x = d2 perform setmus --x perform setmus else d2 = sp + syslen - slen z = 81 loop for x = sp to d2 step slen perform setmus repeat x = d2 perform setmus end #endif 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 &d@ tpost_x = post adjustment to left x position added &dA04/20/03&d@ &dIOK &dA &d@ tpost_y = post adjustment to y position " &dA &d@ tpost_leng = post adjustment to right x position " &dA &dA &d@ Internal varibles: d1 = temporary variable &dA &d@ d2 = temporary variable &dA &d@ tiechar = first tie character &dA &d@ textend = tie extention character &dA &d@ hd = horizontal displacement &dA &d@ vd = vertical displacement &dA &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 &dK &d@ if notesize = 14 &dK &d@ d5 = 254 /* Magic number hpar(60) &dK &d@ end &dK &d@ if notesize = 6 &dK &d@ d5 = 110 /* Magic number hpar(60) &dK &d@ end &dK &d@ if notesize = 21 &dK &d@ d5 = 381 /* Magic number hpar(60) &dK &d@ end d5 = hpar(60) 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 /* e.g., C5 ++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 up, 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 tspan -= tpost_x /* added &dA04/20/03&d@ &dIOK tspan += tpost_leng /* added &dA04/20/03&d@ &dIOK if tspan < hpar(61) /* minimum length depends on notesize putc Error: Tie too short to print putc SETTIE, x1 = ~x1 y1 = ~y1 tspan = ~tspan sitf = ~sitflag getc return end d1 = sitflag + 3 / 4 d3 = rem * 3 + 1 d2 = ( TIE_DISTS ) if tspan < ( (TIE_DISTS - 1) * hpar(62) + hpar(61) ) d2 = tspan - hpar(61) if hpar(62) = 3 ++d2 end d2 = d2 / hpar(62) + 1 /* row number for tie parameters end tiechar = tiearr(sizenum,d1,d2,d3) hd = tiearr(sizenum,d1,d2,d3+1) vd = tiearr(sizenum,d1,d2,d3+2) if sitflag > 8 vd = 0 - vd end &dA &dA &d@ 4) typeset tie &dA &d@ x = x1 + hd + sp + tpost_x /* modified &dA04/20/03&d@ etc. &dIOK y = y1 - vd + sq(f12) + virtoff if tpost_y < 1000 y += tpost_y else tpost_y -= 10000 y = y1 + tpost_y + sq(f12) + virtoff end scf = 300 #if PRINT #if NEWFONTS pz = revsizes(notesize) + TIE_OFFSET /* tie font number #else pz = fontmap(300) #endif putp .b27 *p~x x~y Y.b27 (~pz X.b(tiechar) ... #else scx = x scy = y scb = tiechar perform charout #endif d1 = tiechar & 0x7f &dA &d@ Revision &dA09/21/02&d@: Trying to remove "magic numbers" from settie. &dIOK&d@ if d1 = tiearr(sizenum,1,TIE_DISTS,4) /* staff free general long glyph textend = tiechar + 5 ++tiechar goto EXT end if d1 = tiearr(sizenum,1,TIE_DISTS,1) /* staff constrained general long glphy textend = tiechar + 1 tiechar += 2 goto EXT end &dK &d@ if notesize = 21 &dK &d@ if d1 = 119 /* Magic number (can be removed) &dK &d@ textend = tiechar + 5 &dK &d@ ++tiechar &dK &d@ goto EXT &dK &d@ end &dK &d@ if d1 = 121 &dK &d@ textend = tiechar + 1 &dK &d@ tiechar += 2 &dK &d@ goto EXT &dK &d@ end &dK &d@ else &dK &d@ if d1 = 109 /* Magic number (can be removed) &dK &d@ textend = tiechar + 5 &dK &d@ ++tiechar &dK &d@ goto EXT &dK &d@ end &dK &d@ if d1 = 111 &dK &d@ textend = tiechar + 1 &dK &d@ tiechar += 2 &dK &d@ goto EXT &dK &d@ end &dK &d@ end if d1 > hpar(63) /* above glyph hpar(63), tie is compound ++tiechar #if PRINT putp .b(tiechar) ... #else scb = tiechar perform charout #endif end goto EXTa * EXT: vd = sitflag - 1 / 8 sitflag = rem + 1 hd = tspan vd = hd - expar(sitflag) + 32 / 8 /* was + 8 / 8 #if PRINT out = "" #else scb = textend #endif loop for tcnt = 1 to vd #if PRINT out = out // chr(textend) #else perform charout #endif repeat vd = hd - expar(sitflag) + 32 / 8 /* was + 16 / 8 vd = 40 - rem /* was 16 - rem #if PRINT putp ~out .b27 *p-~vd X.b(tiechar) ... #else scx -= vd scb = tiechar perform charout #endif * EXTa: #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif 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,pz /* pz added &dA03/15/04&d@ int a,b,c,d /* a,b,c,d added &dA03/15/04&d@ getvalue level #if PRINT &dA &dA &d@ &dA03/15/04&d@ Code should have been written thus: &dA #if NEWFONTS a = revsizes(notesize) pz = XFonts(a,mtfont-29) #else pz = fontmap(mtfont) #endif out = esc // "(" // chs(pz) // "X" // esc // "*p" &dK &d@ out = esc // "(" // chs(mtfont) // "X" // esc // "*p" &dA out = out // chs(y) // "Y" #else scy = y #endif scf = mtfont 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) = ibackloc(level) /* changed from hpar(15) &dA08/26/03&d@ &dIOK #if PRINT out = out // esc // "*p" // chs(backloc(level)) // "X-" #else scx = backloc(level) scb = ors("-") #endif #if PRINT putp ~out ... #else perform charout #endif if a < hpar(6) goto CM end end b /= 2 if a > b b = a - hpar(17) + 3 * 2 / 5 a = b + backloc(level) #if PRINT out = out // esc // "*p" // chs(a) // "X-" #else scx = a scb = ors("-") perform charout #endif a += b else a = a - hpar(17) + 3 / 2 + backloc(level) end #if PRINT out = out // esc // "*p" // chs(a) // "X-" putp ~out ... #else scx = a scb = ors("-") perform charout #endif else if x = hpar(9) #if PRINT out = out // esc // "*p" // chs(backloc(level)) // "X-" putp ~out ... #else scx = backloc(level) scb = ors("-") perform charout #endif goto CM end end else if backloc(level) = ibackloc(level) /* changed from hpar(15) &dA08/26/03&d@ &dIOK 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 #if PRINT out = out // esc // "*p" // chs(backloc(level)) // "X-" putp ~out ... #else scx = backloc(level) scb = ors("-") perform charout #endif loop for d = 1 to b backloc(level) += c #if PRINT out = esc // "*p" // chs(backloc(level)) // "X-" putp ~out ... #else scx = backloc(level) scb = ors("-") perform charout #endif repeat end CM: #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif 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 pz /* added &dA03/15/04&d@ int a,b,c,d /* &dA03/15/04&d@ adding a,b,c,d int level getvalue level if underflag = 0 return end x = uxstart(level) - hpar(19) #if PRINT #if NEWFONTS a = revsizes(notesize) pz = XFonts(a,mtfont-29) #else pz = fontmap(mtfont) #endif putp .b27 (~pz X.b27 *p~x x~y Y... #else scx = x scy = y #endif scf = mtfont a = uxstop(level) - uxstart(level) * a = distance over which to set hyphons if a >= hpar(18) y -= vpar(13) #if PRINT out = esc // "*p" // chs(uxstart(level)) // "x" // chs(y) // "Y" #else scx = uxstart(level) scy = y scb = ors("_") #endif b = uxstop(level) - underspc(sizenum) d = underspc(sizenum) loop for c = uxstart(level) to b step d #if PRINT out = out // "_" #else perform charout #endif repeat #if PRINT putp ~out .b27 *p~b X_.b27 *p+5x+~vpar(13) Y... #else scx = b perform charout scx += 5 scy += vpar(13) #endif end if underflag = 1 and xbyte(level) <> "_" #if PRINT putp ~xbyte(level) ... #else scb = ors(xbyte(level)) perform charout #endif end #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif 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&d@ &dIOK &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA &d@ &dA &d@ &dA &d@ Internal variables: a1,a2,a3,a4,a5,a6,a7,a8,a9,a10,a11,a12 &dA &d@ c1,c2,c3,c4,c5,c6,c7 &dA procedure putslur str line2.480 &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. custom &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 stop end end if notesize = 21 if a7 >= 199 putc Program Error examine stop 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 if notesize = 6 &dA &dA &dA &d@ For 6-dot slurs, the distribution of length for stock slurs is a follows &dA &dA &d@ Lengths Length Rise Number &dA &d@ in dots increments increments of types (possible) &dA &d@ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄÄÄ ÄÄÄÄÄÄÄÄ &dA &d@ 4 to 9 1 1 6 &dA &d@ 10 to 98 2 1 12 &dA &d@ 100 to 396 4 1 24 &dA if a7 < 4 a7 = 4 end if a7 > 9 if a7 < 100 c1 = a7 / 2 a7 -= rem else if a7 < 396 c1 = a7 / 4 x += (rem >> 1) a7 -= rem else a7 = 396 end end end &dA &dA &d@ For 6-dot slurs, &dA &dA &d@ Slur number = (rise * 2400) + (length * 6) + type number &dA &d@ number ranges from 8 to 143999 &dA c1 = a3 / 2 a3 -= rem y += rem a3 = a3 * 2400 + (a7 * 6) + 1 end end x += postx y += posty a3 += addcurve /* new 6-30-93 if notesize = 14 if a3 > 120000 goto NOSTOCK end end if notesize = 21 if a3 > 70000 goto NOSTOCK end end /* large gaps should now be supported &dA &dA &d@ a1 = case number &dA &d@ a3 = stock slur number &dA &d@ x = horizontal position &dA &d@ y = vertical position &dA &dA &dA &d@ Enter new code for acquiring and printing slur &dA #if PRINT perform printslur (a1, a3, x, y, sitflag) #else a5 = 1 perform printslur_screen (a1, a3, x, y, a5, sitflag) #endif 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 #if PRINT out = esc // "*p" // chs(x) // "x" out = out // chs(y) // "Y" out = out // esc // "*r1A" loop for i = 1 to a3 c1 = len(longslur(i)) out = out // esc // "*b" // chs(c1) // "W" out = out // longslur(i) * putp ~out ... out = "" repeat out = out // esc // "*rB" * putp ~out ... #else 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) setb gstr,bt,scx,scy,a3,c2,1,3 #endif 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&d@ &dIOK &dA &d@ bit 6 number outside number inside &dA &d@ bit 7 square bracket curved bracket &dA &d@ &dA &d@ &dA &d@ Calling variables to internal procedures: a1,a4,a5 &dA procedure puttuplet int f,xav,yav,h,k int t1,t2,t3,t4,t5,savex2 savex2 = x2 x2 += notesize if bit(1,sitflag) = 1 x2 = vpar(2) / 3 + x2 end a4 = x2 - x1 a4 = y2 - y1 * 60 / a4 xav = x1 + x2 / 2 yav = xav - x1 * a4 / 60 + y1 &dK &d@ if and(3,sitflag) = 3 and yav < vpar(4) &dK &d@ yav -= vpar(1) &dK &d@ 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(1,sitflag) = 1 /* bracket present if bit(7,sitflag) = 1 /* curved bracket if bit(2,sitflag) = 0 /* tips down y -= (vpar(1) + 1 / 2) else /* tips up y += (vpar(1) + 1 / 2) end if bit(5,sitflag) = 0 /* broken bracket y -= (vpar(3) >> 2) end end &dA &dA &d@ &dA03/15/97&d@ numbers below or above &dIOK&d@ &dA if bit(5,sitflag) = 1 /* continuous bracket if bit(7,sitflag) = 1 /* curved bracket if bit(6,sitflag) = 0 /* number outside if bit(2,sitflag) = 1 /* tips up y += vpar(2) else /* tips down y -= (vpar(5) + 1 / 2) end else /* number inside if bit(2,sitflag) = 1 /* tips up y -= vpar(3) else /* tips down y += (vpar(5) + 1 / 2) end end else /* square bracket if bit(6,sitflag) = 0 /* number outside if bit(2,sitflag) = 1 /* tips up y += vpar(3) else /* tips down y -= vpar(2) end else /* number inside if bit(2,sitflag) = 1 /* tips up y -= vpar(2) else /* tips down y += vpar(3) end end end h = xav + 2 /* eliminate space in bracket line k = xav - 2 end end #if PRINT putp .b27 *p~x x~y Y... #else scx = x scy = y #endif &dA &dA &d@ Put out numerator of tuple &dA t3 = t2 / 10 t2 = rem if t3 > 0 a1 = t3 + 221 #if PRINT putp .b(a1) ... #else scb = a1 perform charout #endif end a1 = t2 + 221 #if PRINT putp .b(a1) ... #else scb = a1 perform charout #endif &dA &dA &d@ Put out denominator of tuple (if present) &dA if t1 > 0 a1 = 249 /* colon #if PRINT putp .b(a1) ... #else scb = a1 perform charout #endif t3 = t1 / 10 t1 = rem if t3 > 0 a1 = t3 + 221 #if PRINT putp .b(a1) ... #else scb = a1 perform charout #endif end a1 = t1 + 221 #if PRINT putp .b(a1) ... #else scb = a1 perform charout #endif end end * * Part II: bracket present * if bit(1,sitflag) = 1 /* bracket present &dA &dA &d@ Square brackets &dA if bit(7,sitflag) = 0 /* square bracket * 1) compute slope a5 = abs(a4) a5 = a5 + 3 / 5 if a5 > 6 a5 = 6 end if a5 = 5 a5 = 4 end if a5 = 6 a5 = 5 end if a4 > 0 a4 = a5 else a4 = 0 - a5 end yav -= vpar(40) * 2) case 1: broken bracket if bit(5,sitflag) = 0 a1 = h - x1 + 2 / 3 * 3 x1 = h - a1 f = 6 if a4 < 0 f = -6 end y1 = x1 - xav * a4 + 6 / 12 + yav x = x1 + 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: continuous bracket 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@ &dIOK&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&d@ &dIOK &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA &d@ t1 = sitflag x2 = savex2 /* restore x2 to original if bit(2,t1) = 1 /* tips up sitflag = 12 posty = 0 - vpar(5) /* reason: y1 and y2 were supplied as endpoints else /* for square brackets, not the notes themselves sitflag = 0 /* this code is a cludge to correct for this posty = vpar(5) / 2 /* approximately. Rigorous solution would be end /* to set through the original oby's slur_edit_flag = 1 postx = 0 addcurve = 0 if bit(5,t1) = 0 /* broken slur t2 = k - h << 8 + 0x20 sitflag += t2 end perform putslur end end return * procedure brackethook if bit(2,sitflag) = 1 y = y - notesize + 2 end #if PRINT putp .b27 *p~x x~y Y.b89 ... #else scx = x scy = y scb = 89 perform charout #endif 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 pz /* added &dA03/15/04&d@ int h,i,k if a1 = 0 return end x = x1 + sp y = y1 + sq(f12) #if PRINT #if NEWFONTS pz = wedgefont(notesize) #else pz = fontmap(400) #endif putp .b27 (~pz X.b27 *p~x x~y Y... #else scx = x scy = y #endif scf = 400 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 #if PRINT putp .b(z) ... #else scb = z perform charout #endif repeat else loop for i = 1 to h #if PRINT out = chr(z) // esc // "*p" #else scb = z perform charout #endif if a4 > 0 #if PRINT out = out // "+" // chs(a4) // "Y" #else scy += a4 #endif else h = 0 - a4 #if PRINT out = out // "-" // chs(h) // "Y" #else scy -= h #endif end x += 12 y += a4 #if PRINT putp ~out ... #endif 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 #if PRINT putp .b(z) ... #else scb = z perform charout #endif x += k y += h end #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif 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 pz /* added &dA03/15/04&d@ int leng,slope,z1,clen,fullcnt int nex,h y1 -= vpar(1) y2 -= vpar(1) leng = x2 - x1 x = x1 + sp #if PRINT #if NEWFONTS pz = wedgefont(notesize) #else pz = fontmap(400) #endif putp .b27 (~pz X.b27 *p~x X... #else scx = x #endif scf = 400 * 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 #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif --y repeat loop for h = 1 to nex z = tarr(h) #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif repeat * -- bottom #if PRINT out = esc // "*p" // chs(x) // "X" putp ~out ... #else scx = x #endif z = z1 + 51 y = y2 + sq(f12) loop for h = 1 to fullcnt #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif ++y repeat loop for h = 1 to nex z = tarr(h) #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif 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) #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif repeat z = z1 + 51 loop for h = 1 to fullcnt #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif ++y repeat #if PRINT out = esc // "*p" // chs(x) // "X" putp ~out ... #else scx = x #endif * -- bottom y = y2 + sq(f12) loop for h = 1 to nex z = tarr(h) #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif repeat z = z1 + 31 loop for h = 1 to fullcnt #if PRINT putp .b27 *p~y Y.b(z) ... #else scy = y scb = z perform charout #endif --y repeat end #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif scf = notesize return &dA &d@ &dA &dA &d@*P&dA 18. putfigcon &dA &d@ &dA &dA &d@ Purpose: Typeset figure continuation line &dA &dA &d@ Inputs: x1 = horizontal starting point of line &dA &d@ x2 = horizontal stopping point of line &dA &d@ a3 = vertical level of line &dA &d@ y1 = additional vertical displacement from default height &dANew 11/06/03 &dA procedure putfigcon int g x = x1 + sp --a3 &dA &dA &d@ New code &dA11/06/03&d@ adding figoff(.) and y1 &dA y = vpar(37) * a3 + vpar(36) + sq(f12) + figoff(f12) + y1 #if PRINT putp .b27 *p~x x~y Y... #else scx = x scy = y #endif g = x2 - hpar(44) #if PRINT #else scb = 220 #endif loop while x1 <= g #if PRINT putp .b220 ... #else perform charout #endif x1 += hpar(44) repeat x = g + sp #if PRINT putp .b27 *p~x X.b220 ... #else scx = x perform charout #endif 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) #if PRINT putp .b27 *p~x x~y Y.b233 ... #else scx = x scy = y scb = 233 perform charout #endif x += hpar(42) #if PRINT putp .b27 *p~x X... #else scx = x #endif x1 += hpar(42) j = x2 - (hpar(43) >> 1) k = 0 #if PRINT #else scb = 91 #endif loop while x1 <= j k = 1 #if PRINT putp .b91 ... #else perform charout #endif x1 += hpar(43) repeat h = hpar(43) >> 1 x1 -= h if k = 1 if x1 <= j #if PRINT putp .b27 *p-~h X.b91 ... #else scx -= h perform charout #endif end if a1 > 0 j = hpar(43) >> 2 #if PRINT putp .b27 *p-~j X... #else scx -= j #endif if a1 < notesize a1 = notesize end if a3 = 1 k = a1 - 2 #if PRINT putp .b27 *p-~k Y... #else scy -= k #endif end loop while a1 > notesize #if PRINT putp .b89 .b27 *p+~notesize Y... #else scb = 89 perform charout scy += notesize #endif a1 -= notesize repeat k = notesize - a1 #if PRINT putp .b27 *p-~k Y.b89 ... #else scy -= k scb = 89 perform charout #endif 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 pz /* added &dA03/15/04&d@ int h, k if f12 > 1 return end x = x1 + sp y = y1 + sq(1) #if PRINT putp .b27 *p~x x~y Y... #else scx = x scy = y #endif if a1 > 0 if a1 < notesize a1 = notesize end loop while a1 > notesize #if PRINT putp .b89 .b27 *p+~notesize Y... #else scb = 89 perform charout scy += notesize #endif a1 -= notesize repeat k = notesize - a1 #if PRINT putp .b27 *p-~k Y.b89 ... #else scy -= k scb = 89 perform charout #endif end if a3 > 0 #if PRINT #if NEWFONTS h = revsizes(notesize) pz = XFonts(h,mtfont-29) putp .b27 *p+~vpar(1) x+~vpar(4) Y.b27 (~pz X~a3 .b46 ... putp .b27 (~h X... #else pz = fontmap(mtfont) putp .b27 *p+~vpar(1) x+~vpar(4) Y.b27 (~pz X~a3 .b46 ... putp .b27 (~notesize X... #endif #else scx = x + vpar(1) scy = y + vpar(4) scf = mtfont out = chs(a3) perform stringout (out) scb = 46 perform charout #endif scf = notesize end #if PRINT putp .b27 *p~x x~y Y... #else scx = x scy = y #endif h = x2 - hpar(1) #if PRINT #else scb = 90 #endif loop while x1 <= h #if PRINT putp .b90 ... #else perform charout #endif x1 += hpar(1) repeat x = h + sp #if PRINT putp .b27 *p~x X.b90 ... #else scx = x perform charout #endif if a2 > 0 if a2 < notesize a2 = notesize end loop while a2 > notesize #if PRINT putp .b89 .b27 *p+~notesize Y... #else scb = 89 perform charout scy += notesize #endif a2 -= notesize repeat k = notesize - a2 #if PRINT putp .b27 *p-~k Y.b89 ... #else scy -= k scb = 89 perform charout #endif 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 pz /* added &dA03/15/04&d@ 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 #if PRINT #if NEWFONTS a = revsizes(notesize) pz = XFonts(a,a2-29) #else pz = fontmap(a2) #endif putp .b27 (~pz X.b27 *p~x x~y Y.b45 ... #else scx = x scy = y scb = 45 perform charout #endif 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 #if PRINT putp .b27 *p~x X.b45 ... #else scx = x perform charout #endif if d = 1 b -= a1 --c if c > 0 a1 = b / c end end repeat #if PRINT #if NEWFONTS pz = revsizes(notesize) putp .b27 (~pz X... #else putp .b27 (~notesize X... #endif #endif scf = notesize return &dA &d@ &dA &dA &d@*P&dA 22. puttrill &dA &d@ &dA &dA &d@ Purpose: Typeset long trill &dA &dA &d@ Inputs: x1 = horizontal starting point of trill &dA &d@ x2 = horizontal stopping point of trill &dA &d@ y1 = vertical level of trill &dA &d@ a1 = situation 1 = no trill &dA &d@ 2 = trill with no accidental &dA &d@ 3 = trill with sharp &dA &d@ 4 = trill with natural &dA &d@ 5 = trill with flat &dA &d@ procedure puttrill int h,t1,t2 x = x1 + sp y = y1 + sq(f12) h = x1 #if PRINT out = esc // "*p" // chs(x) // "x" // chs(y) // "Y" #else scx = x scy = y #endif if a1 > 1 if a1 > 2 and a1 < 6 t1 = y - vpar(45) t2 = int("..389"{a1}) + 210 /* music font #if PRINT out = out // esc // "*p" // chs(t1) // "Y" // chr(t2) out = out // esc // "*p" // chs(y) // "Y" #else scb = t2 scy = t1 perform charout scy = y #endif end x += hpar(41) #if PRINT out = out // chr(236) // esc // "*p" // chs(x) // "X" #else scb = 236 perform charout scx = x #endif h = x1 + hpar(41) end #if PRINT putp ~out ... out = "" #else scb = 237 #endif loop while h < x2 #if PRINT out = out // chr(237) #else perform charout #endif h += hpar(40) repeat #if PRINT putp ~out ... #endif 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 pz /* added &dA03/15/04&d@ 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) &dK &d@ y2 = sq(f11) &dA &dA &d@ Adding code &dA11/13/03&d@ to deal with mixed staff sizes &dIOK&d@ &dA a4 = notesize a3 = nsz(f11) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction if notesize <> a3 notesize = a3 /* set font size for computing vpar(44) perform init_par end y2 = sq(f11) + vpar(44) /* line thickness added &dA04-25-95&d@ y2 -= a5 if notesize <> a4 notesize = a4 /* return to original font size perform init_par end &dA 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) &dA &dA &d@ Adding code &dA11/13/03&d@ to deal with mixed staff sizes &dIOK&d@ &dA a4 = notesize a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction y2 -= a5 &dA z = 84 brkcnt = 0 perform putbar (a2) y = y1 z = 87 perform setmus y = y2 + vpar(8) + vst(a2) z = 88 perform setmus end if ".:,;" con syscode{a1} /* changed &dA11/13/03&d@ &dIOK&d@ ++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) &dA &dA &d@ Adding code &dA11/13/03&d@ to deal with mixed staff sizes &dIOK&d@ &dA a4 = notesize a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction y2 -= a5 &dA a3 = y2 - y1 &dA &dA &d@ There are three cases: a3 <= 201 (one glyph) granularity = 6 &dA &d@ 202 <= a3 <= 402 (two glyphs) granularity = 12 &dA &d@ 403 <= a3 <= 570 (three glyphs) granularity = 12 &dA if a3 <= 201 a4 = a3 + 2 / 6 * 6 /* actual length a5 = a4 - a3 / 2 /* delta / 2 y = y1 - a5 /* corrected value of y a5 = a4 / 6 + 20 /* font number #if PRINT out = esc // "*p" // chs(x) // "x" // chs(y) // "Y" #if NEWFONTS if notesize < 10 pz = SMALL_BRACK else pz = LARGE_BRACK end out = out // esc // "(" // chs(pz) // "X" // chr(a5) pz = revsizes(notesize) out = out // esc // "(" // chs(pz) // "X" #else pz = fontmap(320) out = out // esc // "(" // chs(pz) // "X" // chr(a5) out = out // esc // "(" // chs(notesize) // "X" #endif putp ~out ... #else scx = x scy = y scb = a5 if scb < 33 putc &dAWARNING&d@: You are trying to typeset a bracket which is too short. putc This is sometimes the result of a faulty system code. putc If other problems occur as well, check system code first. scb = 33 end scf = 320 perform charout scf = notesize #endif 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 #if PRINT out = esc // "*p" // chs(x) // "x" // chs(y) // "Y" #if NEWFONTS if notesize < 10 pz = SMALL_BRACK else pz = LARGE_BRACK end out = out // esc // "(" // chs(pz) // "X" // chr(a5) out = out // esc // "*p+" // chs(a6) // "Y" // chr(a5+1) pz = revsizes(notesize) out = out // esc // "(" // chs(pz) // "X" #else pz = fontmap(320) out = out // esc // "(" // chs(pz) // "X" // chr(a5) out = out // esc // "*p+" // chs(a6) // "Y" // chr(a5+1) out = out // esc // "(" // chs(notesize) // "X" #endif putp ~out ... #else scx = x scy = y scb = a5 scf = 320 perform charout scy += a6 ++scb perform charout scf = notesize #endif 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 #if PRINT out = esc // "*p" // chs(x) // "x" // chs(y) // "Y" #if NEWFONTS if notesize < 10 pz = SMALL_BRACK else pz = LARGE_BRACK end out = out // esc // "(" // chs(pz) // "X" // chr(a5) out = out // esc // "*p+192Y" // chr(a5+1) out = out // esc // "*p+" // chs(a6) // "Y" // chr(a5+2) pz = revsizes(notesize) out = out // esc // "(" // chs(pz) // "X" #else pz = fontmap(320) out = out // esc // "(" // chs(pz) // "X" // chr(a5) out = out // esc // "*p+192Y" // chr(a5+1) out = out // esc // "*p+" // chs(a6) // "Y" // chr(a5+2) out = out // esc // "(" // chs(notesize) // "X" #endif putp ~out ... #else scx = x scy = y scb = a5 scf = 320 perform charout scy += 192 ++scb perform charout scy += a6 ++scb perform charout scf = notesize #endif end end end if ".:,;" con syscode{a1} /* changed &dA11/13/03&d@ &dIOK&d@ ++a2 end repeat return &dA &d@ &dA &dA &d@*P&dA 24. putbar (t1) &dA &d@ &dA &dA &d@ Purpose: Typeset bar line &dA &dA &d@ Inputs: t1 = staff number of last line &dA &d@ y1 = coordinate of top of line &dA &d@ y2 = coordinate of last bar character &dA &d@ brkcnt = number of breaks in bar &dA &d@ barbreak(.,1) = y coordinate of top of break . &dA &d@ barbreak(.,2) = y coordinage of bottom of break . &dA &d@ x = x-coordinat of line &dA &d@ z = font character &dA procedure putbar (t1) int t1,t2 int a3 getvalue t1 if brkcnt = 0 t2 = y2 + 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 #if PRINT &dA &d@ &dA &dA &d@*P&dA 26. printslur &dA &d@ &dA &dA &d@ Purpose: read slur data from bigslur, compile and &dA &d@ send slur to printer &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@ 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 &d@ &dA &d@ Output: snum = 1000000 if this routine fails for any reason &dA procedure printslur (ori,snum,x,y,sitflag) str file.100,pointer.6,data.500,out.1000 bstr tbt.2500 int snum,ori int offset,datalen,nrows int slen,srise int bulge int i,j,n,x,y,t,maxn int dpnt,sdpnt int code,cnt,ndata(2),kdata(2) int sitflag int broksize /* &dA03/15/97&d@ &dIOK&d@ real rx * getvalue ori,snum,x,y,sitflag if bit(5,sitflag) = 1 /* &dA03/15/97&d@ &dIOK&d@ broksize = sitflag >> 8 else broksize = 0 end sitflag &= 0x01 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 &d@ file = "c:\wbh\res\mus\prnt\bitmap\slurs\bigslur" &dA &dA &d@ putc printslur called &dA &d@ putc file = ~file &dA &d@ putc ori = ~ori snum = ~snum x = ~x y = ~y &dA open [3,5] file i = snum * 6 + 1 len(pointer) = 6 read [3,i] pointer offset = ors(pointer{1,4}) datalen = ors(pointer{5,2}) if datalen < 4 or datalen > 500 close [3] snum = 1000000 passback snum return end len(data) = datalen if offset = 0 close [3] snum = 1000000 passback snum return end read [3,offset] data n = ors(data{1,3}) if n <> snum close [3] 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 out = esc // "*p" // chs(x) // "x" 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 out = out // chs(y) // "Y" out = out // esc // "*r1A" putp ~out ... out = "" * 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) tbt = zpd(ndata(1)) // npd(j) if cnt = 2 j = ndata(2) + kdata(2) tbt = tbt // zpd(ndata(2)) // npd(j) end if ori = 2 or ori = 3 tbt = tbt // zpd(slen) tbt = rev(tbt) tbt = trm(tbt) end bt(i) = tbt tbt = trm(tbt) n = bln(tbt) 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 tbt = dup("1",i) // dotted{1,j} // dup("1",i+10) /* mask end if broksize > 0 /* &dA03/15/97&d@ &dIOK j = maxn - broksize >> 1 if j < 0 j = 0 end i = maxn - j - j tbt = dup("1",j) // dup("0",i) // dup("1",j) end loop for i = 1 to nrows if sitflag = 1 or broksize > 0 /* &dA03/15/97&d@ &dIOK bt(i) = bnd(bt(i),tbt) end n = bln(bt(i)) + 7 / 8 out = esc // "*b" // chs(n) // "W" out = out // cby(bt(i)) putp ~out ... repeat out = out // esc // "*rB" * close [3] putp ~out ... return * #else &dA &d@ &dA &dA &d@*P&dA 26a. printslur_screen &dA &d@ &dA &dA &d@ Purpose: read slur data from bigslur, compile and &dA &d@ send slur to screen &dA &dA &d@ Input: ori case: 1,2,3 or 4 &dA &d@ snum slur number &dA &d@ x x location &dA &d@ y y location &dA &d@ mode 1 = display, 0 = clear (cancel) &dA &d@ sitflag situation flag &dA &dA &d@ bit 5: continuous slur broken slur &dA &d@ &dA &d@ bits 8-15: size of break (0 to 255 dots, centered) &dA procedure printslur_screen (ori,snum,x,y,mode,sitflag) str file.100,pointer.6,data.500 &dA &d@ bstr bt.800(150) &dAThis is now global&d@ int snum,ori int offset,datalen,nrows int slen,srise int bulge int h,i,j,k,n,x,y,t,maxn int dpnt,sdpnt int code,cnt,ndata(2),kdata(2) int mode,sitflag int broksize /* &dA03/15/97&d@ &dIOK&d@ real rx * getvalue ori,snum,x,y,mode,sitflag if bit(5,sitflag) = 1 /* &dA03/15/97&d@ &dIOK&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@ &dIOK&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 setb gstr,bt,scx,scy,nrows,maxn,1,3 else clearb gstr,bt,scx,scy,nrows,maxn,1,3 end return * #endif &dA End of if PRINT (for procedures printslur and printslur_screen) &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@ govstaff = governing staff for size (length) of barline &dA &d@ nsz(.) = notesizes for each staff in the systme &dA &d@ &dA &d@ &dA &d@ Procedure rewritten &dA11/13/03&d@ to deal with mixed staff sizes &dIOK&d@ &dA procedure barline int a1,a2,a3,a4,a5 if z = 86 /* Case: dotted bar line cannot connect staff lines loop for a1 = 1 to f11 y = sq(a1) a4 = nsz(a1) if notesize <> a4 notesize = a4 /* set font size for segment perform init_par end perform setmus repeat else a2 = 0 loop for a1 = 1 to len(syscode) if "[(" con syscode{a1} a4 = 0 /* this will become the font size for this segment y1 = sq(a2+1) end if "])" con syscode{a1} &dA &dA &d@ If a4 is not determined at this point, set it to the default &dA if a4 = 0 a4 = nsz(a2) /* font size of bottom staff in this segment end a3 = nsz(a2) /* notesize of staff for this termination a5 = a4 - a3 * 4 /* length correction if notesize <> a3 notesize = a3 /* set font size for computing vpar(44) perform init_par end y2 = sq(a2) + vpar(44) /* line thickness added &dA04-25-95&d@ y2 -= a5 if notesize <> a4 notesize = a4 /* set font size for segment perform init_par end perform putbar (a2) end if ".:,;" con syscode{a1} ++a2 if mpt > 2 if a4 = 0 a4 = nsz(a2) else if nsz(a2) > a4 a4 = nsz(a2) end end end end repeat end &dA return &dA &dA &d@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@ #define MAPZ 2500 procedure make_longslur (length,rise,smode) str out.MAPZ str map.MAPZ(250),zeros.MAPZ bstr temp.MAPZ int g,h,i,j,k,p,q,s,t int hh,ii,jj,kk int x1,x2,y1,y2 int rise,length int pc,pd,pe,pf,pg,ph int scnt int smode real delta,alpha,beta,delta2,beta2 real X,x,Y,y,z,Cx,Cy,R,L,H,D,W,Q,P,A,B,Ca,Cb real a,b,c real xx,yy,u,v real inpx,outpx,inpy,outpy,ind,outd real sx(8000),sy(8000) real PP,QQ real SCALE real rtype zeros = zpd(MAPZ) &dA* I. Determine scaling factor if notesize = 14 SCALE = 1.0 else SCALE = flt(notesize) / 14.0 end &dA* II. Get rise and length limits getvalue length,rise,smode i = length - 1 X = flt(i) Y = flt(rise) X = X / SCALE /* &dA05-12-95&d@ all computations done Y = Y / SCALE /* at original size. length = length * 14 / notesize /* clear slur array loop for i = 1 to 250 map(i) = pad(MAPZ) repeat &dA &dA &d@ &dEBeginning of slur generation&d@ &dA &dAÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dA³ P A R A M E T R I C M A G I C ³&d@ &dAÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ rtype = 2.0 if X < 600.0 H = X * .03 + 9.0 + (1.9 * rtype) else H = 27.0 + (1.9 * rtype) end if X > 1200.0 H = H + (X - 1200.0 / 200.0) end rtype -= 1.0 L = X * X + (Y * Y) L = sqt(L) a = rtype / 75. W = L * (.66 - a) /* experimental value &dA &dA &d@ compute R, P, A, B, Cx, Cy, Ca, Cb and check limitations &dA &dA &d@ 1. Q: &dA if X > 300.0 Q = 15.0 else Q = 13.0 end LS_PAA: &dA &dA &d@ 2. R = L*L/Q/8 + Q/2 &dA &d@ x = L * L / Q / 8.0 y = Q / 2.0 R = x + y &dA &dA &d@ 3. P = R - (R*R - (W*W/4))^1/2 component of height from &dA &d@ middle section x = (R * R) - (W * W / 4.0) P = R - sqt(x) y = (L - W) / 2.0 + P if H > y H = y end if H < Q H = dec(Q) + .5 end &dA &dA &d@ 4. A = (L - W) / 2 B = H - P = transition point &dA A = (L - W) / 2.0 B = H - P &dA &dA &d@ 5. Cx = X/2 Cy = R - H = center of main arc &dA Cx = L / 2.0 Cy = H - R /* a negative number &dA &dA &d@ 6. Compute = center of starting arc &dA &dA &d@ [ B*(Cx-A)/(Cy-B) + (A*A + B*B)/2/A - A ] &dA &d@ Cb = ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA &d@ [ B/A + (Cx-A)/(Cy-B) ] &dA &dA &d@ Ca = (A*A + B*B)/2/A - B*(Cb)/ A &dA a = (Cx - A) / (Cy - B) b = (A * A) + (B * B) b = b / 2.0 / A Cb = (B * a + b - A) / (B / A + a) Ca = b - (B * Cb / A) &dA &dA &d@ normalize D-function &dA xx = L / 2.0 D = sqt(xx) / 4.8 if D > 1.50 D -= .16 /* radical if H / L > .200 D -= .10 end end if D > 1.70 D = D - 1.70 * .2 + 1.70 end if D > 1.95 D = D - 1.95 * .3 + 1.95 end if D > 2.25 D = D - 2.25 * .4 + 2.25 end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 1 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ º sqt(A*A + B*B) º &dA &d@ 1. compute beta = 2 * sin-1ºÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄĺ sweep angle &dA &d@ º 2*sqt(Ca*Ca + Cb*Cb)º &dA a = A * A + (B * B) b = Ca * Ca + (Cb * Cb) c = sqt(b) beta = rtype / 7.5 if L >= 400. delta = L * .001 else delta = L * .006 - 2.00 end if R / c > 3.00 - beta + delta Q += .1 if Q < H - .5 goto LS_PAA end end c = sqt(a/b) beta = 2.0 * ars(c/2.0) &dA &dA &d@ 2. compute delta so that sweep hits every dot &dA a = sqt(a) /* length of arc (approx) delta = beta / a / 2.0 scnt = 0 alpha = 0.0 &dA &dA &d@ 3. begin sweep &dA LS_SW1A: a = 1.0 - cos(alpha) b = sin(alpha) x = Ca * a - (Cb * b) y = Ca * b + (Cb * a) if x < A ++scnt sx(scnt) = x sy(scnt) = y alpha += delta goto LS_SW1A end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 2 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. compute beta2 = sin-1{ [(L/2)-A] / R } &dA a = L / 2.0 - A / R beta2 = ars(a) &dA &dA &d@ 2. compute delta so that sweep hits every dot &dA delta2 = beta2 * 2.0 / W / 2.0 alpha = 0.0 - beta2 &dA &dA &d@ 3. begin sweep &dA LS_SW2A: x = R * sin(alpha) + Cx y = R * cos(alpha) + Cy if x < L - A ++scnt sx(scnt) = x sy(scnt) = y alpha += delta2 goto LS_SW2A end &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ S W E E P L O O P 3 ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. beta and delta already computed &dA alpha = beta &dA &dA &d@ 2. begin sweep &dA LS_SW3A: a = 1.0 - cos(alpha) b = sin(alpha) x = L - (Ca * a) + (Cb * b) y = Ca * b + (Cb * a) if x < L ++scnt sx(scnt) = x sy(scnt) = y alpha -= delta goto LS_SW3A end ++scnt sx(scnt) = L sy(scnt) = 0.0 &dEÚÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ¿&d@ &dE³ E N D O F S W E E P S. C O N S T R U C T S L U R ³&d@ &dEÀÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÙ&d@ &dA &dA &d@ 1. rotate data to produce rise &dA a = X / L b = Y / L loop for i = 1 to scnt x = sx(i) * a - (sy(i) * b) y = sx(i) * b + (sy(i) * a) sx(i) = x sy(i) = y repeat &dA &dA &d@ 2. setup thickness parameters &dA pc = length * 60 / (length + 400) /* carefully worked out formula &dA05/13/95 pd = pc * 3 / 10 pe = scnt - pc pf = scnt - pd pg = 50 * scnt / 100 if length < 400 ph = 0 else ph = (length - 400) * scnt * 4 / 40000 end &dA &dA &d@ 3. compute ind, outd &dA loop for i = 1 to scnt if i < pc /* left hand side of slur ind = 0.6 if i < pd /* extreme left end outd = flt(i) / flt(pc) + .1 else outd = 0.4 end if notesize = 14 outd += .4 end goto LS_PCD end if i > pe /* right hand side of slur ind = 0.6 if i >= pf /* extreme right end j = scnt - i outd = flt(j) / flt(pc) + .1 else outd = 0.4 end if notesize = 14 outd += .4 end goto LS_PCD end /* middle of slur if i > pg + ph /* right side j = pe - i s = pe - pg - ph else /* left side if i < pg - ph j = i - pc s = pg - pc - ph else s = 10000 j = 9999 end end b = flt(j) * ars(1.0) / flt(s) /* max(b) = sin-1(1) a = sin(b) if notesize = 14 outd = D - .8 * a + .8 ind = D - .6 * a + .6 end if notesize = 21 outd = D - 0.4 * a + 0.4 ind = D - 0.6 * a + 0.6 outd += .29000 ind += .89000 end &dA &dA &d@ 4. compute outside point, inside point &dA LS_PCD: x = sx(i) y = sy(i) &dA &dA &d@ give finite width to slur &dA if i < scnt u = sx(i+1) v = sy(i+1) else u = x v = y end if i > 1 xx = sx(i-1) yy = sy(i-1) else xx = x yy = y end u -= xx /* delta x v -= yy /* delta y c = u * u + (v * v) c = sqt(c) /* delta hypotinus a = outd / c b = ind / c outpx = x - (a * v) outpy = y + (a * u) inpx = x + (b * v) inpy = y - (b * u) &dA &dA &d@ 5. compute box coordinates &dA if outpx < inpx a = outpx outpx = inpx inpx = a end if outpy < inpy a = outpy outpy = inpy inpy = a end outpx = outpx + 30.0 /* - .5 inpx = inpx + 30.0 /* - .5 outpy = outpy + 20.0 - 1.0 inpy = inpy + 20.0 + .5 x1 = fix(inpx) x2 = fix(outpx) y1 = fix(inpy) y2 = fix(outpy) if x2 - x1 < 2 ++y2 /* radical end &dA &dA &d@ 6. set points inside box to 1 (with inverted vertical axis) &dA &dA &dA &d@ Here is where you scale the slur back to its original size &dA x1 = x1 * notesize / 14 x2 = x2 * notesize / 14 y1 = y1 * notesize / 14 y2 = y2 * notesize / 14 loop for j = y1 to y2 q = 250 - j loop for k = x1 to x2 map(q){k} = "x" repeat repeat repeat &dA &dA &d@ &dEEnd of slur generation&d@ &dA /* determine size of map display loop for i = 1 to 250 map(i) = trm(map(i)) if map(i) <> "" goto LS_CE end repeat LS_CE: y1 = i loop for j = i to 249 map(j+1) = trm(map(j+1)) if map(j) = "" and map(j+1) = "" goto LS_CF end repeat LS_CF: y2 = j - 1 loop for j = 1 to MAPZ loop for i = y1 to y2 if map(i){j} = "x" goto LS_CH end repeat repeat LS_CH: x1 = j x2 = 0 loop for i = y1 to y2 if x2 < len(map(i)) x2 = len(map(i)) end repeat /* write slur to newout x2 = x2 - x1 /* x range j = 0 if smode < 3 loop for i = y1 to y2 map(i) = map(i) // pad(MAPZ) out = map(i){x1,x2} if smode = 2 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat else loop for i = y2 to y1 step -1 map(i) = map(i) // pad(MAPZ) out = map(i){x1,x2} if smode = 3 out = rev(out) end out = trm(out) if out = "" and (i = y1 or i = y2) else ++j temp = pak(out) longslur(j) = cby(temp) end repeat end if smode = 1 length = j - 1 else if smode = 2 length = j - 1 - rise else if smode = 3 length = rise else length = 0 end end end rise = j passback length,rise /* length = initial offset; rise = number of rows return #if PRINT &dA &dA &d@ Code added &dA03/05/04&d@: In order to implement "in-line" spacing for printing &dA &d@ we need a PRINT version of stringout. &dA procedure stringout (out) str out.500,char.1 int font,i,k getvalue out loop for i = 1 to len(out) k = ors(out{i}) if k > 130 and k < 142 if k < 140 k -= 130 putp .b27 *p+~k X... &dK &d@ x += (k - 130) else k -= 139 putp .b27 *p-~k X... &dK &d@ x -= (k - 139) end else char = chr(k) putp ~char ... end repeat return &dA #else &dA &d@ &dNÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»&d@ &dA &d@ &dNº º&d@ &dA &d@ &dNº PROCEDURES ADDED FOR SCREEN DISPLAY º&d@ &dA &d@ &dNº º&d@ &dA &d@ &dNÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍͼ&d@ * procedure stringout (out) str out.500 int font,i,k getvalue out font = revmap(scf) font = font - 1 * 256 loop for i = 1 to len(out) &dA &dA &d@ Code substitution &dA03/05/04&d@: To implement "in-line" spacing for display &dA k = ors(out{i}) if k > 130 and k < 142 if k < 140 scx += (k - 130) else scx -= (k - 139) end else k += font setb gstr,FA,scx,scy,k,1 end &dA &dK &d@ k = ors(out{i}) + font &dK &d@ setb gstr,FA,scx,scy,k,1 repeat return procedure charout int font,k font = revmap(scf) &dA &dA &d@ putc scb= ~scb font = ~font scf = ~scf /* &dADEBUG&d@ &dA font = font - 1 * 256 k = scb + font &dA &dA &d@ putc k = ~k font = ~font /* &dADEBUG&d@ &dA setb gstr,FA,scx,scy,k,1 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 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 PPP: if oldsflag > 0 px = x(oldsflag) py = y(oldsflag) end if oldsflag <> sflag if oldsflag = 1 activate gstr,px,py,5 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 else if oldsflag = 2 activate tstr2,px,py,5 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 else if oldsflag = 3 activate tstr3,px,py,5 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 else activate tstr4,px,py,5 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 end end end end oldsflag = sflag 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 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 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 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 end end end getk k &dA &dA &d@ &dA Display Commands &dA if k = 0x03040a /* activate gstr,0,0,0 activate blue_horiz1t,0,0,0 activate blue_horiz1b,0,0,0 activate blue_vert1v,0,0,0 activate blue_vert1r,0,0,0 flag = 1 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x030810 /* activate gstr,0,0,0 activate blue_horiz1t,0,0,0 activate blue_horiz1b,0,0,0 activate blue_vert1v,0,0,0 activate blue_vert1r,0,0,0 flag = 2 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x03080c /* activate gstr,0,0,0 activate blue_horiz1t,0,0,0 activate blue_horiz1b,0,0,0 activate blue_vert1v,0,0,0 activate blue_vert1r,0,0,0 sflag = 1 oldsflag = 0 wflag2 = 0 wflag3 = 0 wflag4 = 0 passback flag return end if k = 0x01001b /* putc .b27 Y.b27 F... stop end if k = 0x030101 /*  if x(sflag) < 40 x(sflag) += hpar(58) / 3 / sflag end end if k = 0x030103 /*  if x(sflag) > xze - 340 x(sflag) -= hpar(58) / 3 / sflag end end if k = 0x030104 /*  if y(sflag) > yze - 3500 y(sflag) -= vpar(43) / 3 / sflag end end if k = 0x030102 /*  if y(sflag) < 320 y(sflag) += vpar(43) / 3 / sflag end end if k = 0x030105 /* shft  if x(sflag) < 40 x(sflag) += hpar(58) / sflag end end if k = 0x030107 /* shft  if x(sflag) > xze - 340 x(sflag) -= hpar(58) / sflag end end if k = 0x030108 /* shft  if y(sflag) > yze - 3500 y(sflag) -= vpar(43) / sflag end end if k = 0x030106 /* shft  if y(sflag) < 320 y(sflag) += vpar(43) / sflag end end if k = 0x010032 /* 2 if sflag <> 2 sflag = 2 if wflag2 = 0 dscale2 gstr, tstr2 wflag2 = 1 end end end if k = 0x010033 /* 3 if sflag <> 3 sflag = 3 if wflag3 = 0 dscale3 gstr, tstr3 wflag3 = 1 end end end if k = 0x010034 /* 4 if sflag <> 4 sflag = 4 if wflag2 = 0 dscale2 gstr, tstr2 wflag2 = 1 end if wflag4 = 0 dscale2 tstr2, tstr4 wflag4 = 1 end end end if k = 0x010031 /* 1 if sflag <> 1 sflag = 1 end end goto PPP return #endif &dA end of the "else" part of if PRINT (i.e., if not-PRINT) &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 expar(.) parameters &dA &dA &d@ Inputs: notesize &dA &d@ &dA &d@ Outputs: vpar(.) &dA &d@ hpar(.) &dA &d@ vpar20 &dA &d@ expar(.) &dA &d@ fontmap(.) &dA &d@ revmap(.) &dA &d@ sizenum &dA &d@ &dA &d@ Other operations: In all cases, if scf = old notesize, then &dA &d@ scf reset to new notesize &dA &d@ In the case of PRINT, changes the active font &dA &d@ to match the new size. &dA &d@ procedure init_par int pz /* added &dA03/15/04&d@ int a,b,i bstr cycle.200 &dA &dA &d@ &dA03/15/04&d@ Changing sizenum to range from 1 to 12 &dA if notesize = 6 sizenum = 3 end if notesize = 14 sizenum = 8 end if notesize = 21 sizenum = 11 end &dK &d@ if notesize = 14 &dK &d@ sizenum = 1 &dK &d@ end &dK &d@ if notesize = 21 &dK &d@ sizenum = 2 &dK &d@ end &dK &d@ if notesize = 6 &dK &d@ sizenum = 3 &dK &d@ end &dA &dA &dA &d@ Vertical parameters &dA &d@ ÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄÄ &dA if notesize = 14 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 hpar(60) = 254 hpar(61) = 20 hpar(62) = 2 hpar(63) = 90 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) = 30 hpar(48) = 4 hpar(58) = 10 hpar(60) = 110 hpar(61) = 10 hpar(62) = 1 hpar(63) = 90 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) = 30 hpar(48) = 13 hpar(58) = 30 hpar(60) = 381 hpar(61) = 30 hpar(62) = 3 hpar(63) = 80 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 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 (modified &dA10/23/03&d@) &dIOK&d@ &dA &dK &d@ gapsize = 3 * notesize / 4 &dK &d@ cycle = dup("1",gapsize) // dup("0",gapsize) if notesize = 14 gapsize = 8 cycle = dup("1",10) // dup("0",6) end if notesize = 6 gapsize = 3 cycle = dup("1",4) // dup("0",2) end if notesize = 21 gapsize = 12 cycle = dup("1",15) // dup("0",9) end dotted = "" i = 2500 - (2 * gapsize) loop dotted = dotted // cycle repeat while len(dotted) < i #if PRINT #if NEWFONTS &dA &d@ scf can be &dA &d@ (1) old notesize (4 to 24) (requires change in scf) &dA &d@ (2) beamfont (101 to 114) (independent of notesize) &dA &d@ (3) text font (31 to 48) (actual font depends on notesize) &dA &d@ (4) 300 (ties) " &dA &d@ (5) 320 (brackets) " &dA &d@ (6) 400 (wedges) " &dA &d@ (7) 30 (variable pitch screen fonts, display only) &dA &d@ (8) 200 (fixed pitch screen font, display only) if scf > 0 and (scf < 101 or scf > 114) if scf > 3 and scf < 25 scf = notesize pz = revsizes(notesize) else if scf > 30 and scf < 49 pz = revsizes(notesize) pz = XFonts(pz,scf-29) else if scf = 300 pz = revsizes(notesize) + TIE_OFFSET else if scf = 320 if notesize < 10 pz = SMALL_BRACK else pz = LARGE_BRACK end else if scf = 400 pz = wedgefont(notesize) end end end end end putp .b27 (~pz X... end #else &dA &dA &d@ Set print font map &dA if notesize = 14 fontmap(31) = 1031 fontmap(32) = 1032 fontmap(33) = 1033 fontmap(34) = 1034 fontmap(37) = 1037 fontmap(38) = 1038 fontmap(39) = 1039 fontmap(44) = 1044 fontmap(46) = 1046 end if notesize = 21 fontmap(31) = 2031 fontmap(32) = 2032 fontmap(33) = 2033 fontmap(34) = 2034 fontmap(37) = 2037 fontmap(38) = 2038 fontmap(39) = 2039 fontmap(44) = 2044 fontmap(46) = 2046 fontmap(300) = 301 fontmap(400) = 401 end if notesize = 6 fontmap(31) = 3031 fontmap(32) = 3032 fontmap(33) = 3033 fontmap(34) = 3034 fontmap(37) = 3037 fontmap(38) = 3038 fontmap(39) = 3039 fontmap(44) = 3044 fontmap(46) = 3046 fontmap(300) = 302 fontmap(320) = 321 fontmap(400) = 402 end if scf > 0 if scf > 5 and scf < 30 scf = notesize end pz = fontmap(scf) putp .b27 (~pz X... end #endif #else #if NEWFONTS &dA &dA &d@ scf can be &dA &d@ (1) old notesize (4 to 24) (requires change in scf) &dA &d@ (2) beamfont (101 to 114) (independent of notesize) &dA &d@ (3) text font (31 to 48) (actual font depends on notesize) &dA &d@ (4) 300 (ties) " &dA &d@ (5) 320 (brackets) " &dA &d@ (6) 400 (wedges) " &dA &d@ (7) 30 (variable pitch screen fonts, display only) &dA &d@ (8) 200 (fixed pitch screen font, display only) &dA if scf > 0 and scf < 25 scf = notesize end &dK &d@ loop for a = 1 to 24 &dK &d@ revmap(a) = revsizes(a) &dK &d@ repeat &dK &dK &d@ loop for a = 1 to 12 &dK DONE AT THE TOP &dK &d@ revmap(100+a) = a + BEAM_OFFSET &dK &dK &d@ repeat &dK &d@ revmap(114) = 13 + BEAM_OFFSET pz = revsizes(notesize) loop for a = 30 to 48 revmap(a) = XFonts(pz,a-29) repeat revmap(200) = scfont(notesize) revmap(300) = pz + TIE_OFFSET if notesize < 10 revmap(320) = SMALL_BRACK else revmap(320) = LARGE_BRACK end revmap(400) = wedgefont(notesize) #else &dA &dA &d@ Set screen font map &dA if notesize = 14 revmap(30) = 16 revmap(31) = 1 revmap(32) = 2 revmap(33) = 3 revmap(34) = 4 revmap(37) = 5 revmap(38) = 6 revmap(39) = 7 revmap(44) = 8 revmap(46) = 9 revmap(14) = 10 revmap(01) = 10 /* added &dA01/13/04&d@ revmap(106) = 11 revmap(108) = 12 revmap(300) = 13 revmap(400) = 14 revmap(200) = 17 revmap(320) = 52 end if notesize = 21 revmap(30) = 33 revmap(31) = 18 revmap(32) = 19 revmap(33) = 20 revmap(34) = 21 revmap(37) = 22 revmap(38) = 23 revmap(39) = 24 revmap(44) = 25 revmap(46) = 26 revmap(21) = 27 revmap(01) = 27 /* added &dA01/13/04&d@ revmap(109) = 28 revmap(112) = 29 revmap(300) = 30 revmap(400) = 31 revmap(200) = 17 revmap(320) = 52 end if notesize = 6 revmap(30) = 50 revmap(31) = 35 revmap(32) = 36 revmap(33) = 37 revmap(34) = 38 revmap(37) = 39 revmap(38) = 40 revmap(39) = 41 revmap(44) = 42 revmap(46) = 43 revmap(06) = 44 revmap(01) = 44 /* added &dA01/13/04&d@ revmap(102) = 45 revmap(103) = 46 revmap(300) = 47 revmap(400) = 48 revmap(200) = 17 revmap(320) = 52 end if scf > 0 a = revmap(scf) a = a - 1 / 17 if notesize = 14 a = rem + 1 end if notesize = 21 a = rem + 18 end if notesize = 6 a = rem + 35 end loop for i = 1 to 400 if revmap(i) = a scf = i i = 400 end repeat end #endif #endif return run &dA &dA &dA