summaryrefslogtreecommitdiff
path: root/obsolete/macros/texmuse/Program/texmuse.mf
diff options
context:
space:
mode:
Diffstat (limited to 'obsolete/macros/texmuse/Program/texmuse.mf')
-rw-r--r--obsolete/macros/texmuse/Program/texmuse.mf990
1 files changed, 990 insertions, 0 deletions
diff --git a/obsolete/macros/texmuse/Program/texmuse.mf b/obsolete/macros/texmuse/Program/texmuse.mf
new file mode 100644
index 0000000000..21fe02800c
--- /dev/null
+++ b/obsolete/macros/texmuse/Program/texmuse.mf
@@ -0,0 +1,990 @@
+% Look for "to make flexible" and "to change into" items, and "necessary?"
+numeric temp_a[], temp_b;
+numeric horizontal_span, vertical_span;
+numeric no_of_instr, char_no, index, instr_, last_note[];
+numeric vert_shift, instr_shift[];
+numeric quanta[], width[], stretched_width[], to_stretch, last_stretch;
+numeric note_axis[], ltx[], rtx[], rtx_[]; % rtx_ is the extreme of the current char.
+numeric correction[]; % x in the equations
+numeric note, a[], b[], c[], d[], e[], f[], g[];
+%numeric aggr_note[][]; % Highest (if #1 is 1) or lowest (#1=-1) note at instr_
+numeric aggr_note[][][];
+numeric instr_clef[], lowest_note[], highest_note[];
+numeric stem_dir[][], stem_coef[], stem_extreme;
+numeric i, j, s; % To change into i_, j_
+numeric stem_axis[][];
+numeric multi_beam_offset;
+pair stem_point[][];
+path temp_path;
+picture note_[][]; % Old char_; [index][instr_]
+picture pict_, _pict;
+numeric next_level, curr_level;
+string arg_text, temp_text;
+string to_do, doing_, horizontal_elements[];
+string curr_instr;
+string staff_[];
+numeric bar_type[]; % Three-digit number. :|: is 111. | is (0)10.
+numeric clef_sep, key_sep;
+numeric total_natural_length; % In pt
+numeric total_factors; % Total spacing factors (results of sf_, function of the quanta)
+numeric spacing_unit; % What the stretching function multiplies. Default: a sharp's width
+numeric least_spaced; % Quanta of the least-spaced rhythmic value. Usually 32 or 16
+numeric no_of_blocks; % Number of blocks so far included in the line.
+numeric index_offset; % To convert the first index of a line into 1
+numeric no_of_beams; % Number of beams in the current line.
+string beam_list[]; % The different beams to be traced at the end of the line.
+string tie_list[];
+numeric no_of_ties, tie_[], open_tie[], closed_tie[];
+string clef_changes;
+
+%Initialization
+to_do:="";
+for octave=1 upto 8:
+ g[octave]=3.5*(octave-4);
+ a[octave]=g[octave]-3;
+ b[octave]=g[octave]-2.5;
+ c[octave]=g[octave]-2;
+ d[octave]=g[octave]-1.5;
+ e[octave]=g[octave]-1;
+ f[octave]=g[octave]-.5;
+endfor;
+index:=0;
+instr_:=0;
+stem_length=3.5;
+clef_sep=2interline;
+key_sep=horizontal_axis;
+horizontal_span:=10regular_width;
+vertical_span:=10interline;
+multi_beam_offset:=1/4;
+note_axis0:=0;
+width0 := 0;
+stretched_width0:=0;
+curr_level:=0;
+next_level:=0;
+total_natural_length:=0;
+least_spaced:=32;
+spacing_unit:=horizontal_axis+framingspace;
+first_included:=1;
+no_of_blocks := 0;
+total_factors := 0;
+next_char:=1;
+no_of_beams := 0;
+no_of_ties:=0;
+index_offset := 0;
+
+% Level-1 elements.
+
+def add_halfheads(text nhs) =
+ for s=nhs:
+ note:=s+instr_clef[instr_];
+ lowest_note[instr_] := min(lowest_note[instr_],note);
+ highest_note[instr_] := max(highest_note[instr_],note);
+ half_note_head shifted(0,interline*note); % To change into notehead.
+% Ledger lines follow. To make flexible.
+ if (note>3.5) or (note<-1.5) :
+ pickup penrazor xscaled line_thick rotated 90;
+ for i:=(1+note/abs(note)*3) step (note/abs(note)) until note :
+ draw (-.5regular_width,i*interline)--(.5regular_width,i*interline);
+ endfor;
+ fi;
+ endfor;
+ stem_axis[index][instr_] := xpart(stem_point[index][instr_]);
+ find_extremes(nhs); % Vertical extremes
+ enddef;
+
+def add_noteheads(text nhs) =
+ for s=nhs:
+ note:=s+instr_clef[instr_];
+ lowest_note[instr_] := min(lowest_note[instr_],note);
+ highest_note[instr_] := max(highest_note[instr_],note);
+ regular_note_head shifted(0,interline*note); % To change into notehead.
+ note_axis[index] := 1/2regular_width;
+ width[index] := 1/2regular_width;
+% Ledger lines follow. To make flexible.
+ if (note>3.5) or (note<-1.5) :
+ pickup penrazor xscaled line_thick rotated 90;
+ for i:=(1+note/abs(note)*3) step (note/abs(note)) until note :
+ draw (-.5regular_width,i*interline)--(.5regular_width,i*interline);
+ endfor;
+ fi;
+ endfor;
+ stem_axis[index][instr_] := xpart(stem_point[index][instr_]);
+ find_extremes(nhs); % Vertical extremes
+ enddef;
+
+def add_rest(expr p, q) =
+ addto currentpicture also rest_[p] shifted (0, q*interline);
+ width[index] := rest_width[p];
+ enddef;
+
+def add_wholeheads(text nhs) =
+ for s=nhs:
+ note:=s+instr_clef[instr_];
+ lowest_note[instr_] := min(lowest_note[instr_],note);
+ highest_note[instr_] := max(highest_note[instr_],note);
+ whole_note shifted(0,interline*note); % To change into notehead.
+% Ledger lines follow. To make flexible.
+ if (note>3.5) or (note<-1.5) :
+ pickup penrazor xscaled line_thick rotated 90;
+ for i:=(1+note/abs(note)*3) step (note/abs(note)) until note :
+ draw (-.5regular_width,i*interline)--(.5regular_width,i*interline);
+ endfor;
+ fi;
+ endfor;
+ stem_axis[index][instr_] := xpart(stem_point[index][instr_]);
+ find_extremes(nhs); % Vertical extremes
+ enddef;
+
+
+def barline_(expr number) =
+ %The first digit indicates pre-barline stuff.
+ temp:=floor(number/100);
+ %The middle digit indicates the barline itself.
+ temp:=floor(number/10 - 10temp);
+ if temp = 1 :
+ pickup penrazor xscaled line_thick;
+ draw (0, min(scantokens staff_[instr_])*interline)--(0, max(scantokens staff_[instr_])*interline);
+% rtx_[instr_]:=-1/2regular_width;
+ stem_dir[index][instr_] := 0;
+ elseif temp=2 :
+ pickup penrazor xscaled line_thick;
+ draw (0, min(scantokens staff_[instr_])*interline)--
+ (0, max(scantokens staff_[instr_])*interline);
+ pickup penrazor xscaled 1/2interline;
+ draw (1/2interline+1/2line_thick, min(scantokens staff_[instr_])*interline)--
+ (1/2interline+1/2line_thick, max(scantokens staff_[instr_])*interline);
+% rtx_[instr_]:=-1/2regular_width;
+% ltx[instr_]:=interline-1/2regular_width;
+ width[index] := 3/4interline + 1/2line_thick;
+ stem_dir[index][instr_] := 0;
+ fi;
+ %The last digit indicates post-barline stuff.
+ enddef;
+
+% Level-2 elements.
+
+def add_dot (suffix nhs) =
+ temp_text:= str nhs;
+ if curr_level < 2 : % Deferring...
+ to_do := if next_level>0 : to_do & fi curr_instr & "add_dot(" & temp_text & ");";
+ curr_instr := "";
+ next_level:=2;
+ else: % Doing...
+ for i:=nhs :
+ note:=floor(i+instr_clef[instr_])+.5;
+ pickup pencircle scaled 1/3interline;
+ drawdot (1/2regular_width+framingspace, note*interline);
+ endfor;
+ fi;
+ enddef;
+
+def add_flag (suffix number) =
+ temp_text := str number;
+ if curr_level < 2 : % Deferring...
+ to_do := if next_level>0 : to_do & fi curr_instr & "add_flag(" & temp_text & ");";
+ curr_instr := "";
+ next_level:=2;
+ else: % Doing...
+ temp_a := scantokens temp_text;
+ if number = 1 :
+ eighth_flag((0, interline*aggr_note[index][instr_][-stem_coef[instr_]]))
+ if stem_coef[instr_]=1 :
+ reflectedabout ((stem_axis[index][instr_],0),(stem_axis[index][instr_],1));
+ rtx_[instr_]:=max(rtx_[instr_],horizontal_axis);
+ else:
+ rotatedaround ((0, interline*aggr_note[index][instr_][-stem_coef[instr_]]),180)
+ fi;
+ fi;
+ fi;
+ enddef;
+
+def regular_stem =
+ if curr_level<2: % Deferring...
+ to_do := if next_level>0 : to_do & fi curr_instr & "regular_stem;";
+ curr_instr := "";
+ next_level:=2;
+ else: % Doing...
+ if unknown stem_dir[index][instr_] :
+ stem_dir[index][instr_] = stem_coef[instr_];
+ fi;
+ pickup penrazor xscaled line_thick;
+ draw (stem_axis[index][instr_],interline*aggr_note[index][instr_][stem_dir[index][instr_]])
+ --(stem_axis[index][instr_],
+ interline*(aggr_note[index][instr_][stem_dir[index][instr_]]+stem_dir[index][instr_]*stem_length));
+ fi;
+ enddef;
+
+% Level-3 elements.
+
+def add_flat(suffix notext) =
+ temp_text:=str notext;
+ if curr_level<3 :
+ to_do := if next_level>0 : to_do & fi curr_instr & "add_flat(" & temp_text & ");";
+ curr_instr := "";
+ next_level :=3;
+ else:
+ temp_a:= scantokens temp_text;
+ addto currentpicture also flat shifted (-1/2regular_width-ltx[instr_],interline*(_note(temp_a,instr_,index)));
+ ltx[instr_] := ltx[instr_]+horizontal_axis;
+ fi;
+ enddef;
+
+def add_natural(suffix notext) =
+ temp_text:=str notext;
+ if curr_level<3: % Deferring...
+ to_do := if next_level>0 : to_do & fi curr_instr & "add_natural(" & temp_text & ");";
+ curr_instr := "";
+ next_level:=3;
+ else: % Doing...
+ temp_a:= scantokens temp_text;
+ addto currentpicture also natural shifted (-1/2regular_width-ltx[instr_],interline*(_note(temp_a,instr_,index)));
+ ltx[instr_] := ltx[instr_]+horizontal_axis;
+ fi;
+ enddef;
+
+def add_sharp(suffix notext) =
+ temp_text:=str notext;
+ if curr_level<3: % Deferring...
+ to_do := if next_level>0 : to_do & fi curr_instr & "add_sharp(" & temp_text & ");";
+ curr_instr := "";
+ next_level:=3;
+ else: % Doing...
+ temp_a:= scantokens temp_text;
+ addto currentpicture also sharp shifted (-1/2regular_width-ltx[instr_],interline*(_note(temp_a,instr_,index)));
+ ltx[instr_] := ltx[instr_]+horizontal_axis-framingspace;
+ fi;
+ enddef;
+
+% Level-4 elements.
+
+% Level-5 elements.
+
+def beam(text t_) =
+ no_of_beams := no_of_beams + 1;
+ beam_list[no_of_beams] := decimal(instr_);
+ for i:= t_ :
+ beam_list[no_of_beams] := beam_list[no_of_beams] & "," & decimal(i);
+ endfor;
+ enddef;
+
+def beams_ =
+ for k := 1 upto no_of_beams :
+ temp_text:="extract_beam_data(" & beam_list[k] & ");";
+ scantokens temp_text;
+ beam_list[k] := "";
+ prepare_beam;
+ currentpicture:=note_[closest_index][instr_];
+ draw_beam;
+ draw_stems;
+ note_[closest_index][instr_]:=currentpicture;
+ currentpicture:=note_[index][instr_];
+ endfor;
+ enddef;
+
+def add_tie (text nhs) =
+ forsuffixes s:=nhs :
+ tie_list[instr_] := if known tie_list[instr_] : tie_list[instr_] & "," & fi decimal index & "," & str s;
+ endfor;
+ enddef;
+
+def close_tie (text nhs) =
+ if index > 1 :
+ forsuffixes s:=nhs :
+ tie_list[instr_] := tie_list[instr_] & ",-" & decimal index & "," & str s;
+ endfor;
+ fi;
+ enddef;
+
+def ties_ =
+ for i := 1 upto no_of_instr :
+ if known tie_list[i] :
+ k:=100;
+ for j:= scantokens tie_list[i] :
+ if k=100 : % j is an index
+ if j>0 : % this is an opening index
+ no_of_ties:=no_of_ties+1;
+ open_tie[no_of_ties]:=j;
+ k:=200;
+ else: % this is a closing index
+ k:=-j;
+ fi;
+ elseif k=200 : % j is an opening note
+ tie_[no_of_ties] := j;
+ k:=100;
+ else: % j is a closing note
+ for l:=1 upto no_of_ties :
+ if tie_[l] = j : % this is it
+ closed_tie[l] := k;
+ fi;
+ endfor;
+ k:=100;
+ fi;
+ endfor;
+ for j:=1 upto no_of_ties :
+ if known closed_tie[j] :
+ draw_tie(i, open_tie[j],closed_tie[j],_note(tie_[j],i,open_tie[j]));
+ else:
+ draw_open_tie(i, open_tie[j],_note(tie_[j],i,open_tie[j]));
+ fi;
+ endfor;
+ numeric tie_[], open_tie[], closed_tie[];
+ no_of_ties:=0;
+ fi;
+ endfor;
+ enddef;
+
+def draw_tie(expr ins_, oi_, ci_, tn_) =
+ tie_coef := -stem_dir[oi_][ins_];
+ begingroup; save x, y;
+ path p;
+ clearit;
+ z0 = (0, interline*(tn_));
+ x2=total_width(oi_)
+ for m:=oi_+1 upto ci_-1 : + note_axis[m] + total_width(m) endfor
+ + note_axis[ci_];
+ y2=y0;
+ y1=y0+tie_coef*interline;
+ x1 = .5[x0,x2];
+ p = z0..{right}z1..z2;
+ z3 = p intersectionpoint
+ ((1/2horizontal_axis, interline*(tn_-1))--(1/2horizontal_axis, interline*(tn_+1)));
+ z4 = p intersectionpoint
+ ((x2-1/2horizontal_axis,interline*(tn_-1))--(x2-1/2horizontal_axis,interline*(tn_+1)));
+ penpos3(line_thick, 90+notehead_angle);
+ penpos1(2line_thick, 90);
+ penpos4(line_thick, 90-notehead_angle);
+ penstroke z3e..{right}z1e..z4e;
+ addto note_[oi_][ins_] also currentpicture
+ shifted (tie_coef*.5framingspace, tie_coef*2line_thick);%*(tn_-floor(tn_)));
+ clearit;
+ endgroup;
+ enddef;
+
+def draw_open_tie(expr ins_, oi_, tn_) =
+ tie_coef := -stem_dir[oi_][ins_];
+ begingroup; save x, y;
+ path p;
+ clearit;
+ z0 = (0, interline*(tn_));
+ x2=total_width(oi_)
+ for m:=oi_+1 upto index : + note_axis[m] + total_width(m) endfor
+ if (tn_ < max(scantokens staff_[instr_]) + 1) and
+ (tn_ > min(scantokens staff_[instr_]) - 1) :
+ + regular_width
+ fi;
+ y2=y0;
+ y1=y0+tie_coef*interline;
+ x1 = .5[x0,x2];
+ p = z0..{right}z1..z2;
+ z3 = p intersectionpoint
+ ((1/2horizontal_axis, interline*(tn_-1))--(1/2horizontal_axis, interline*(tn_+1)));
+ z4 = p intersectionpoint
+ ((x2-1/2horizontal_axis,interline*(tn_-1))--(x2-1/2horizontal_axis,interline*(tn_+1)));
+ penpos3(line_thick, 90+notehead_angle);
+ penpos1(2line_thick, 90);
+ penpos4(line_thick, 90-notehead_angle);
+ penstroke z3e..{right}z1e..z4e;
+ addto note_[oi_][ins_] also currentpicture
+ shifted (framingspace, tie_coef*2line_thick);%*(tn_-floor(tn_)));
+ clearit;
+ endgroup;
+ enddef;
+
+% Functions
+
+def clef_ (expr number) =
+ clef_changes := decimal(index) & "," & decimal(instr_) & "," & decimal(instr_clef[instr_])
+ if known clef_changes : & "," & clef_changes fi;
+ instr_clef[instr_]:=number;
+ small_clef(number);
+ enddef;
+
+def small_clef (expr number) =
+ if curr_level < 4 : % Deferring...
+ to_do := if next_level>0 : to_do & fi curr_instr & "small_clef(" & decimal(number) & ");";
+ curr_instr := "";
+ next_level:=4;
+ else: % Doing...
+ addto currentpicture also
+ if instr_clef[instr_] = 0 :
+ small_treble_clef shifted (-2.8interline-1/2regular_width-ltx[instr_],0);
+ ltx[instr_] := ltx[instr_] + 2.4interline+1/2regular_width + framingspace;
+ elseif instr_clef[instr_] = 6 :
+ small_bass_clef shifted (-2.75interline-1/2regular_width-ltx[instr_],0);
+ ltx[instr_] := ltx[instr_] + 2.4interline + 1/2regular_width + framingspace;
+% pickup pencircle scaled line_thick;
+% draw (-ltx[instr_],-interline)--(-ltx[instr_],3interline);
+ fi;
+ fi;
+ enddef;
+
+def draw_beam =
+ hor_start := stem_axis[index][instr_]+.5line_thick
+ for i:=closest_index upto (index-1): + note_axis[i+1] + total_width(i) endfor;
+ pickup penrazor xscaled .5interline rotated 90;
+ for i:=beam_elements downto 2 :
+ hor_end := hor_start
+ for j:=beam_index[i-1] upto (beam_index[i]-1) : - total_width(j) - note_axis[j+1] endfor
+ -stem_axis[index][instr_] + stem_axis[beam_index[i]][instr_] -line_thick;
+ for j := 1 upto beam_no[i] :
+ draw ((hor_start,interline*(beam_lift - beam_coef*(3j-2)/4))--
+ (hor_end,interline*(beam_lift - beam_coef*(3j-2)/4))) transformed yslanted;
+ endfor;
+% An extra parameter for each note of the stem will indicate whether it's + or - horizontal_axis
+ if beam_no[i] > beam_no[i+1] :
+ for j :=2 upto beam_no[i] :
+ draw ((hor_start,interline*(beam_lift - beam_coef*(3j-2)/4))--
+ (hor_start-horizontal_axis,interline*(beam_lift - beam_coef*(3j-2)/4))) transformed yslanted;
+ endfor
+ fi;
+ for j:= (beam_no[i-1]+1) upto beam_no[i] :
+ undraw ((hor_start-line_thick,interline*(beam_lift - beam_coef*(3j-2)/4))--
+ (hor_end+line_thick,interline*(beam_lift - beam_coef*(3j-2)/4))) transformed yslanted;
+ endfor;
+ highest_note[instr_]:=max(highest_note[instr_], ypart((
+ if beam_dir < 0 : hor_end else: hor_start fi
+ , beam_lift*interline) transformed yslanted)/interline);
+ lowest_note[instr_]:=min(lowest_note[instr_], ypart((
+ if beam_dir < 0 : hor_end else: hor_start fi
+ , beam_lift*interline) transformed yslanted)/interline);
+ hor_start := hor_end + line_thick;
+ endfor;
+ enddef;
+
+def draw_stems =
+ pickup penrazor xscaled line_thick;
+ hor_start := stem_axis[index][instr_]
+ for i:=closest_index upto (index-1): + note_axis[i+1] + total_width(i) endfor;
+ for i:=beam_elements downto 1 :
+ draw (xpart(stem_point[beam_index[i]][instr_])
+ for j:=closest_index upto (beam_index[i]-1): + note_axis[j+1] + total_width(j) endfor
+ for j:=beam_index[i] upto (closest_index-1): - note_axis[j+1] - total_width(j) endfor,
+ ypart(stem_point[beam_index[i]][instr_])
+ + interline * if beam_coef =1 : min else: max fi (beam_aggr[i]1,
+ for j:=1 upto beam_aggr[i]0 : , beam_aggr[i][j] endfor))
+ --((xpart(stem_point[beam_index[i]][instr_])
+ for j:=closest_index upto (beam_index[i]-1): + note_axis[j+1] + total_width(j) endfor
+ for j:=beam_index[i] upto (closest_index-1): - note_axis[j+1] - total_width(j) endfor,
+ interline*beam_lift) transformed yslanted);
+ endfor;
+ enddef;
+
+def end_of_block =
+ temp:=quanta[index];
+ quanta[index]:=0;
+ if unknown desired_width : % A \musicbox
+ desired_width:=ideal_width;
+ else :
+ no_of_blocks := no_of_blocks + 1;
+ if abs(desired_width-ideal_width) > abs(desired_width - ideal_width*(no_of_blocks+1)/no_of_blocks) : % Don't make the line.
+ else :
+ make_line(next_char);
+ fi
+ fi;
+ quanta[index]:=temp;
+ enddef;
+
+def ideal_width =
+ (total_natural_length + (
+ for i := 1 upto index-1 :
+ max(sf_(quanta[i])*spacing_unit/pt-correction[i+1]/pt,0) +
+ endfor
+ sf_(quanta[index])*spacing_unit/pt))
+ enddef;
+
+def sf_(expr number) =
+% if number 1.618 ** (mlog(if number = 0 : 1 else : number/least_spaced fi)/mlog(2))
+ if number = 0 : 0
+ else :
+ 1.618 ** (mlog(abs(number)/least_spaced)/mlog(2))
+ fi
+ enddef;
+
+def stretch_chars =
+ for i := 1 upto index :
+ total_factors := total_factors + sf_(quanta[i]);
+ endfor;
+ forever:
+ temp := 0;
+ note_axis[index+1]:=0;
+ correction[index+1]:=0;
+ for i := 1 upto index :
+ stretched_width[i] :=
+ max(sf_(quanta[i])*(desired_width-total_natural_length)/total_factors
+ - correction[i+1]/pt,0);
+ stretched_width[i] := stretched_width[i]*pt;
+ temp := temp + (note_axis[i] + total_width(i))/pt;
+ endfor;
+ exitif (desired_width - temp >= 0) and (desired_width - temp <=0.005);
+ total_natural_length := total_natural_length - (desired_width - temp);
+ endfor;
+ enddef;
+
+def end_of_char =
+ note_[index][instr_]:=currentpicture;
+ clearit;
+ ensure_info;
+ curr_level := next_level;
+ next_level := 0;
+ doing_ := to_do & "end_of_char;";
+ to_do := "";
+ instr_:=0;
+ if curr_level = 0 : % Which means last next_level=0
+ finalize_char;
+ else:
+ scantokens doing_;
+ fi;
+ enddef;
+
+def ensure_info =
+ if ((next_level=0) and (curr_level<6)) or (next_level=6) :
+ if index = 1 :
+ for i:= 1 upto no_of_instr :
+ note_axis1 := max(note_axis1, ltx[i]);
+ endfor;
+ else:
+ for i:=1 upto no_of_instr :
+ if totalweight note_[index][i]>0 :
+ avlbl_space := 0 for j:=last_note[i]+1 upto index-1 :
+ + note_axis[j] + width[j] endfor + note_axis[index];
+ if avlbl_space < (rtx[i] + ltx[i]) :
+ find_new_axis(i);
+ fi;
+ fi;
+ endfor;
+ fi;
+ fi;
+ enddef;
+
+def extract_beam_data(text t) =
+ j:=0;
+ numeric beam_elements, beam_index[], beam_no[], beam_aggr[][];
+ beam_index0:=0;
+ beam_elements:=0;
+ instr_ := 0;
+ for i:=t :
+ if instr_ = 0 : instr_:=i;
+ else :
+ j:=j+1;
+ if j=1 : % New element, index
+ beam_elements:=beam_elements+1;
+ beam_index[beam_elements]:=i-index_offset;
+ elseif j=2 : % No. of beams
+ beam_no[beam_elements]:=i;
+ elseif j<1 : % One of the notes in the aggr. Position 0 in the array is no. of notes.
+ beam_aggr[beam_elements][1-j] := _note(i, instr_, beam_index[beam_elements]);
+ else : % Number of notes
+ beam_aggr[beam_elements][0]:=i;
+ j:=-i;
+ fi;
+ fi;
+ endfor;
+ beam_no[beam_elements+1]:=0;
+ enddef;
+
+def finalize_char =
+ for i:=1 upto no_of_instr :
+ if totalweight(note_[index][i])>0 : last_note[i]:=index; rtx[i]:=rtx_[i]; fi;
+% prev_staff(i);
+ endfor;
+ find_pos;
+ total_natural_length:=total_natural_length+(note_axis[index]+width[index])/pt;
+ curr_level:=0;
+ enddef;
+
+def find_extr(expr p_, coeff_) =
+ clearit;
+ tx:= coeff_ * horizontal_span;
+ fx:=0;
+ pickup pencircle scaled epsilon
+ forever: xtx:=.5[tx,fx]; exitif abs(tx-fx)<=.1;
+ currentpicture:=p_;
+ undraw(xtx,-vertical_span)--(xtx,vertical_span);
+ if totalweight(currentpicture)>=totalweight(p_) : tx else: fx fi
+ :=xtx;
+ endfor;
+ xtx[instr_]:= coeff_*xtx;
+ clearit;
+ enddef;
+
+def find_extremes(text notes_) = % Will be a text expresion, this macro decides everything
+ aggr_note[index][instr_][1]:=-100; % Top note
+ aggr_note[index][instr_][-1]:=100; % Bottom note
+ for i:=notes_ :
+ aggr_note[index][instr_][1]:=max(aggr_note[index][instr_][1],i+instr_clef[instr_]);
+ aggr_note[index][instr_][-1]:=min(aggr_note[index][instr_][-1],i+instr_clef[instr_]);
+ endfor;
+ stem_coef[instr_]:= if (aggr_note[index][instr_][1]+aggr_note[index][instr_][-1])>=2: - fi 1;
+ enddef;
+
+def find_inclination (text options) =
+ yslanted := identity;
+ beam_height := 0;
+ pair beam_pt[]; % The definition of beam_pt's has to happen even if there's no decision to be made,
+ % because find_position uses beam_pt1.
+ beam_pt[closest_no] := (0,0);
+ for i:=closest_no-1 downto 1:
+ xpart beam_pt[i] = xpart(beam_pt[i+1])-stem_axis[beam_index[i]][instr_]-note_axis[beam_index[i]]
+ for j:=beam_index[i] upto (beam_index[i+1]-1) :
+ - note_axis[j] - total_width(j) endfor
+ + note_axis[beam_index[i]] + stem_axis[beam_index[i]][instr_];
+ ypart beam_pt[i] = interline * (beam_aggr[i]1-closest_note);
+ endfor;
+ for i:=closest_no+1 upto beam_elements:
+ xpart beam_pt[i] = xpart(beam_pt[i-1]) - stem_axis[beam_index[i]][instr_] - note_axis[beam_index[i]]
+ for j:=beam_index[i-1] upto (beam_index[i]-1) :
+ + note_axis[j] + total_width(j) endfor
+ + note_axis[beam_index[i]] + stem_axis[beam_index[i]][instr_];
+ ypart beam_pt[i] = interline * (beam_aggr[i]1-closest_note);
+ endfor;
+ if beam_dir <> 0 :
+ transform yslanted[];
+ total_beam_width:=xpart(beam_pt[beam_elements])-xpart(beam_pt1);
+ temp_a := 0;
+ for i:= 1 upto beam_elements :
+ temp_a := temp_a - beam_coef*ypart(beam_pt[i]);
+ endfor;
+%if beam_index[1]=1 :
+% show beam_dir;
+% for l:=1 upto beam_elements:
+% show beam_pt[l];
+% endfor;
+%fi;
+ for i:= scantokens options :
+ temp_b := -i*xpart(beam_pt1)/4total_beam_width;
+ (0,1) transformed yslanted[i] = (0,1);
+ (xpart(beam_pt1),0) transformed yslanted[i] = (xpart(beam_pt1),interline*temp_b);
+ (xpart(beam_pt[beam_elements]),0) transformed yslanted[i] =
+ (xpart(beam_pt[beam_elements]),interline*(temp_b-i/4));
+ temp_a[i]:=0;
+ for j := 1 upto beam_elements :
+ if ypart (-beam_coef*(beam_pt[j] transformed yslanted[i])) >= -0.001 :
+ temp_a[i] := temp_a[i] - beam_coef*ypart(beam_pt[j] transformed yslanted[i]);
+ else:
+ temp_a[i] := 1000;
+ fi;
+ exitif temp_a[i] = 1000;
+ endfor;
+ if temp_a[i] - temp_a < .05 :
+ transform yslanted;
+ (0,1) transformed yslanted = (0,1);
+ (-1,0) transformed yslanted = (-1,0) transformed yslanted[i] reflectedabout((0,0),(1,0));
+ (1,0) transformed yslanted = (1,0) transformed yslanted[i] reflectedabout((0,0),(1,0));
+ temp_a := temp_a[i];
+ beam_height := -i/4;
+ fi;
+ endfor;
+ fi;
+ enddef;
+
+def find_ltx(expr p_) = find_extr(p_,-1); enddef;
+
+def find_new_axis (expr inst) =
+show index;
+ pict_:=note_[last_note[inst]][inst] shifted %
+ (width[last_note[inst]] for i:=(last_note[inst]+1) upto (index-1):
+ -note_axis[i]-width[i] endfor,0);
+ _pict:=note_[index][inst];
+ cull _pict keeping (1,infinity);
+ cull pict_ keeping (1,infinity);
+ tx:=rtx[inst]+ltx[inst]+note_axis[index];
+ fx:=ltx[inst];
+%fx will be customized so that the user can indicate what fraction of ltx[inst] has to be taken into account.
+%In any case, fx (the minimum new axis), being exactly ltx, makes room for the whole width of the previous note.
+%Which is what is needed, because the stems are not yet drawn.
+ nax:=tx;
+ forever:
+ clearit;
+ exitif abs(tx-fx)<=.01;
+ currentpicture := pict_;
+ addto currentpicture also _pict shifted (nax,0);
+ cullit;
+ if totalweight(currentpicture)<totalweight(pict_)+totalweight(_pict):
+ fx else: tx fi :=nax;
+ nax:=.5[tx,fx];
+ endfor;
+ correction[index] := max(note_axis[index],nax) - note_axis[index];
+ note_axis[index] := note_axis[index] + correction[index];
+ enddef;
+
+def find_pos =
+% last_stretch:=sfcode
+% *to_stretch*regular_width/total_space_factors;
+ stretched_width[index]:=0;
+ enddef;
+
+def find_position =
+ temp_a := closest_note + beam_coef*(stem_length-1/2);
+ (ypart(beam_pt[beam_elements] transformed yslanted)-ypart(beam_pt[beam_elements]))/interline + beam_lift =
+ round(temp_a+.01beam_coef) + beam_coef/4;
+ enddef;
+
+def instr_no(expr number) =
+ no_of_instr:=number;
+ for i:=1 step 1 until number:
+ highest_note[i]:=3;
+ lowest_note[i]:=-1;
+ last_note[i]:=0;
+ rtx[i]:=0;
+ note_0[i]:=nullpicture;
+ instr_clef[i]:=0;
+ endfor;
+ enddef;
+
+def key_sign = relax
+ if curr_level < 4 :
+ to_do := if next_level>0 : to_do & fi "key_sign;";
+ curr_instr := ""; % Maybe unnecessary
+ next_level := 4;
+ else:
+ % Key signatures
+ note_[index][instr_] := currentpicture;
+ temp_text := "7";
+ if key_/abs(key_+.1) = 1 : % Sharps
+ relax;
+ else : % Flats
+ j := 1;
+ for i := 1 upto -key_ :
+ temp_text := decimal j & "," & temp_text;
+ j := if odd(i): 1.5 else: -2 fi + j;
+ endfor;
+ for i := 1 upto no_of_instr :
+ ltx[i] := ltx[i] +key_sep;
+ for s:= scantokens(temp_text) :
+ exitif s = 7;
+ addto note_[index][i] also flat
+ shifted (-ltx[i]-horizontal_axis,
+ interline * (s if instr_clef[i]=6:-1fi));
+ ltx[i] := ltx[i] + horizontal_axis;
+ endfor;
+ endfor;
+ fi;
+ fi;
+ enddef;
+
+def normal_clefs =
+ if curr_level < 4 : % Deferring...
+ to_do := if next_level>0 : to_do & fi "normal_clefs;";
+ curr_instr := ""; % Maybe unnecessary
+ next_level:=4;
+ else: % Doing...
+ %Clefs. To do: the font has to draw the clefs from 'trebleaxis' and 'bassaxis'
+ note_[index][instr_] := currentpicture;
+ for i := 1 upto no_of_instr :
+ addto note_[index][i] also
+ if instr_clef[i] = 0 :
+ treble_clef shifted (-3interline - clef_sep - ltx[i],0);
+% note_axis[index] := max(note_axis[index], 3interline + clef_sep);
+ ltx[i] := ltx[i] + 3interline + clef_sep;
+ elseif instr_clef[i] = 6 :
+ bass_clef shifted (-2.7interline - clef_sep - ltx[i],0);
+% note_axis[index] := max(note_axis[index], 2.7interline + clef_sep);
+ ltx[i] := ltx[i] + 2.7interline + clef_sep;
+ fi;
+ endfor;
+ fi;
+ enddef;
+
+def make_line(expr number) =
+ if index > 0:
+ quanta[index]:=0;
+ stretch_chars;
+ instr_shift1:=0;
+ begingroup; save index;
+ beams_;
+ ties_;
+ endgroup;
+ for i:=2 upto no_of_instr:
+ instr_shift[i]:=4+instr_shift[i-1]+highest_note[i-1]-lowest_note[i];
+ endfor;
+ line_height:=(instr_shift[no_of_instr]+highest_note[no_of_instr]+2)*interline#;
+ line_depth:=-(lowest_note1-1)*interline#;
+ for i:= 1 upto index:
+ for j:=1 upto no_of_instr :
+ clearit;
+ staff_lines(i,scantokens staff_[j]);
+ addto note_[i][j] also currentpicture;
+ endfor;
+ beginchar(number+i-1,(note_axis[i]+width[i]+stretched_width[i])*pt#/pt,line_height,line_depth);
+ clearit;
+ if no_of_instr > 1 :
+ if i=1 : % Bracket
+ pickup penrazor xscaled line_thick;
+ draw (-1/2line_thick,-interline)--(-1/2line_thick,interline*(instr_shift2+3));
+ pickup pencircle xscaled 1/2interline yscaled line_thick rotated (-90-notehead_angle);
+ top rt z0 = (-2framingspace, interline*(instr_shift2+3));
+ bot lft z1 = (-horizontal_axis, interline*(instr_shift2/2+1)-1/2line_thick);
+ z2 = .5[z0,z1];
+ draw z0{dir(-90-notehead_angle)}..z2..{dir(-135)}z1;
+ pickup pencircle xscaled 1/2interline yscaled line_thick rotated (90+notehead_angle);
+ draw (z0{dir(-90-notehead_angle)}..z2..{dir(-135)}z1)
+ reflectedabout ((0,interline*(instr_shift2/2+1)),(1,interline*(instr_shift2/2+1)));
+ fi;
+ if quanta[i]<=0 : % Inter-staff barline
+ pickup penrazor xscaled line_thick;
+ draw (note_axis[i],3interline)--(note_axis[i],interline*(instr_shift2-1));
+ fi;
+ fi;
+ for j:=1 upto no_of_instr:
+ addto currentpicture also
+ note_[i][j] shifted (note_axis[i],interline*instr_shift[j]-(-1**i)*0/2line_thick);
+ note_[i][j]:=nullpicture;
+ endfor;
+ endchar;
+ endfor;
+ fi;
+ next_char:= index + number;
+ index_offset := index_offset+index;
+ index:=0;
+ total_natural_length:=0;
+ total_factors := 0;
+ no_of_blocks := 0;
+ no_of_beams := 0;
+ string beam_list[], tie_list[];
+ numeric stem_dir[][];
+ string clef_changes;
+ clearit;
+showstats;
+ enddef;
+
+def time_sign = relax enddef;
+
+def new_char(expr number) =
+ curr_level:=1;
+ next_level:=0;
+ if index = 0 :
+ to_do := to_do & "time_sign;" & "key_sign;" & "normal_clefs;";
+ next_level := 4;
+ fi;
+ index:=index+1;
+ quanta[index]:= if number = 0 : least_spaced else : number fi;
+% total_factors := total_factors + abs(sf_(number));
+ if (number < 17) and (number > 0) : least_spaced:=16 fi;
+ width[index]:=0;
+ note_axis[index]:= 0;
+ correction[index] := 0;
+ for i:=1 upto no_of_instr:
+ rtx_[i] := 0;
+ ltx[i]:=0;
+ note_[index][i]:=nullpicture;
+ endfor;
+ enddef;
+
+def _note(expr n_, i_, _ix) = % Note, instrument, index
+ hide (
+ _note_:=n_+instr_clef[i_];
+ if known clef_changes :
+ k:=0;
+ for temp:=scantokens clef_changes :
+ if k=0 : % An index
+ k:= if temp<=_ix : - fi 1;
+ elseif k=1 : % An instrument
+ if temp<i_ :
+ k:=2;
+ elseif temp=i_ :
+ k:=3;
+ else:
+ k:=4;
+ fi;
+ elseif k=2 : % Good index, but wrong instr
+ k:=0;
+ elseif k=3 : % This is it
+ _note_:=n_+temp;
+ k:=0;
+ else : % Good index, missed instr
+ k:=0;
+ fi;
+ exitif k=-1;
+ endfor;
+ fi;
+ )
+ _note_
+ enddef;
+
+
+def prepare_beam =
+% Direction of stems
+ extr_beam_note1 := -100;
+ extr_beam_note[-1] := 100;
+ for i:=1 upto beam_elements :
+ for j:=1 upto beam_aggr[i][0] :
+ extr_beam_note1:=max(extr_beam_note1,beam_aggr[i][j]); % Top note
+ extr_beam_note[-1]:=min(extr_beam_note[-1],beam_aggr[i][j]); % Bottom note
+ endfor;
+ endfor;
+ beam_coef := if (extr_beam_note1-1) >= (1-extr_beam_note[-1]) : - fi 1; % Direction of stems
+ for i:=1 upto beam_elements :
+ if unknown stem_dir[beam_index[i]][instr_] :
+ stem_dir[beam_index[i]][instr_] = beam_coef;
+ fi;
+ index := beam_index[beam_elements];
+ endfor;
+% General direction (depending on the farthest-away note-heads in the first and last notes)
+ temp_a := beam_aggr[1][1];
+ temp_b := beam_aggr[beam_elements]1;
+ for i:=2 upto beam_aggr[1][0] :
+ temp_a := if beam_coef=1 : min else: max fi (temp_a,beam_aggr1[i]);
+ endfor;
+ for i:=2 upto beam_aggr[beam_elements]0 :
+ temp_b := if beam_coef=1 : min else: max fi (temp_b,beam_aggr1[i]);
+ endfor;
+ beam_dir := if temp_a = temp_b : 0* elseif temp_a > temp_b : - fi 1;
+% Reduction to relevant notes (irrelevant notes are put in positions 2 and up of beam_aggr).
+% and finding of the closest note, having any inner beams into account too.
+ closest_note:=-100beam_coef;
+ for i:=if (beam_coef*beam_dir) >= 0 : 1 upto beam_elements else: beam_elements downto 1 fi:
+ if beam_aggr[i]0 > 1 :
+ if (beam_coef*beam_aggr[i]1) < (beam_coef*beam_aggr[i]2) :
+ temp_a := beam_aggr[i]1;
+ beam_aggr[i]1 := beam_aggr[i]2;
+ beam_aggr[i]2 := temp_a;
+ fi;
+ fi;
+ temp_b := if beam_coef = 1 : max else: min fi
+ (closest_note,beam_aggr[i]1+beam_coef*beam_no[i]/100);
+ if closest_note <> temp_b :
+ closest_index := beam_index[i]; closest_no:=i; fi;
+ closest_note := temp_b;
+ endfor;
+ closest_note:=round(10temp_b)/10;
+% "Mode" (careful or not)
+ numeric beam_lift;
+ temp_a := closest_note + beam_coef * (stem_length - 3*(beam_no[closest_no]-1)/4);
+ transform yslanted;
+ if (temp_a < max(scantokens staff_[instr_]) + 1) and (temp_a > min(scantokens staff_[instr_]) - 1) :
+ "careful beam";
+ find_inclination("beam_dir");
+ find_position;
+ else :
+ find_inclination("2beam_dir, beam_dir");
+ beam_lift := closest_note + beam_coef * (1/4 + stem_length);
+ fi;
+ enddef;
+
+def prev_staff (expr number) =
+ clearit;
+ staff_lines(index-1,scantokens staff_[number]);
+ addto note_[index-1][number] also currentpicture;
+ clearit;
+ enddef;
+
+def staff_lines(expr char_ind)(text t) =
+ pickup pencircle scaled line_thick;
+ for j=t:
+ draw ((0,j*interline)--(note_axis[char_ind]+width[char_ind]+stretched_width[char_ind],j*interline)) %
+ shifted (-note_axis[char_ind],0);
+ endfor;
+ enddef;
+
+def this_staff =
+ for i:=1 upto no_of_instr:
+ clearit;
+ staff_lines(index,scantokens staff_[i]);
+ addto note_[index][i] also currentpicture;
+ clearit;
+ endfor;
+ enddef;
+
+def total_width(expr idx_) =
+ (width[idx_] + stretched_width[idx_])
+ enddef;