% -*- Fundamental -*-  (emacs-20 mf mode mucks
% feta-schrift.mf --  implement scripts
% 
% source file of the Feta (defintively not an abbreviation for Font-En-Tja)
% music font
% 
% (c) 1997 Han-Wen Nienhuys <hanwen@stack.nl>
%	Jan Nieuwenhuizen <jan@digicash.com>
% 


fet_begingroup("scripts")


def draw_fermata =
  save alpha, radius, crook_thinness, crook_fatness, dot_diam;
  
	% [Wanske] and some  Baerenreiter editions
	% suggest ca 80 degrees iso half-circle
  alpha := 10;

  radius# = 1.25 interline#;
  crook_thinness# = 1.5stafflinethickness#;
  crook_fatness# = 4 stafflinethickness#;

  radius# + crook_fatness#/2 = h#;
  radius# + crook_thinness#/2 = w#;
  set_char_box(w#, w#, crook_thinness#/2, h#);
  
  define_pixels(radius, crook_thinness, crook_fatness);
  dot_diam = 4/3 crook_fatness;


  penpos1(crook_thinness, 0);
  penpos2(crook_fatness, -90);
  z1 = (-radius,0);
  z2 = (0, radius);

  fill z1l{dir (-alpha-90)}..{dir (90-alpha)}z1r..
  {right}z2r -- z2l{left} .. cycle;

  addto currentpicture also 
  currentpicture xscaled -1;

  pickup pencircle scaled dot_diam;
  x4 =0;
  bot y4 = - crook_thinness/2;
  draw z4;
enddef;

fet_beginchar("fermata up", "ufermata", "ufermata")
	draw_fermata;	
	penlabels(1,2,4);
fet_endchar;

fet_beginchar("fermata down", "dfermata", "dfermata")
	draw_fermata;
	y_mirror_char;
fet_endchar;


%
% FIXME: rounded endings
%
% `\accent' is TeX reserved.
fet_beginchar("> accent", "sforzato", "sforzatoaccent")
	set_char_box(.9 interline#, .9 interline#, .5 interline#, .5 interline#);
	save thickness, diminish;

	thickness = 3/2 stafflinethickness;
	pickup pencircle scaled thickness;

	% prevent blobs at crossing lines
	diminish = .75;

	top y1 = h;
	lft x1 = -b;
	rt x2 = w;
	y2 = .25 thickness* diminish;

	rt z4 = (w,0);
	x3 =0;
	z3 = whatever [z1, z4];

	penpos2(thickness*(2 - diminish)/2 , 90);
	penpos1(thickness, 90);
	penpos3(thickness, 90);

	draw z1 .. z3;
	draw (z1 .. z3) yscaled -1;
	draw z4;
	penstroke z3e .. z2e;
	penstroke (z3e .. z2e) yscaled -1;

	penlabels(1,2,3);
	labels(4);
fet_endchar;

fet_beginchar("staccato dot", "staccato", "staccato")
	save radius;
	radius# = 1.5 stafflinethickness#;
	define_pixels(radius);
	pickup pencircle scaled 2 radius;
	draw (0,0);
	set_char_box(radius#, radius#, radius#, radius#);
fet_endchar;

def draw_staccatissimo =
	save radius, height;
	height# = .8 interline#;
	radius# = 2 stafflinethickness#;
	define_pixels(radius, height);

	draw_brush((0,0), stafflinethickness, (0, height),2 radius);
	set_char_box(radius#,radius#, blot_diameter#/2, height# + radius#);
enddef;

fet_beginchar("staccatissimo/martellato up", "ustaccatissimo", 
		"ustaccatissimo")
	draw_staccatissimo;
fet_endchar;

%
% FIXEM: scale labels too.
%
fet_beginchar("staccatissimo/martellato down", "dstaccatissimo", "dstaccatissimo")
	draw_staccatissimo;
	y_mirror_char;
fet_endchar;

fet_beginchar("portato/single tenuto", "tenuto", "tenuto")
	save thick;
	thick# = 1.2 stafflinethickness#;
	define_pixels(thick);

	set_char_box(.9 interline#, .9 interline#, thick#/2,thick#/2);
	pickup pencircle scaled thick;
	lft x1 = -b;
	rt x2 = w;
	y1 = y2 = 0;
	draw z1 .. z2;
fet_endchar;


def draw_marcato = 
	save fat_factor, thinness;
	set_char_box(interline#/2, interline#/2, 0, 1.1 interline#);

	fat_factor = .3;
	thinness =  stafflinethickness;

	pickup pencircle scaled thinness;
	rt x2 = w;
	lft x5 = -b;
	bot y5 = 0;
	top y3 = h;
	y1 = y2 = y5;

	x3 =0;
	z1 - z4 = whatever * (charwd, -charht);
	z4 = fat_factor [z3, z5];

	filldraw z1 -- z2 -- z3 -- z4 -- cycle;
	draw z3 .. z5;
enddef;

fet_beginchar("marcato up", "umarcato", "umarcato")
	draw_marcato;
	labels(1,2,3,4,5);
fet_endchar;


%
% The down marcato char (not very much used). 
% Contrary to what some MF/TeX `gurus' believe
% it is *point*-symmetric with the "up" version
fet_beginchar("marcato down", "dmarcato", "dmarcato")
	draw_marcato;
	xy_mirror_char;
fet_endchar;
 
%
% used in french horn music todo
%
% TODO: too light at 20pt
fet_beginchar("open (unstopped)", "open", "ouvert")
	save thin, height, width, thick;
	height# = 5/4 width#;
	height# = interline#;
	thin = 1.2 stafflinethickness;
	thick =  1.4 thin;
	set_char_box(width#/2, width#/2, height#/2, height#/2);
	
	penpos1(thick, 0);
	penpos2(thin, 90);
	z1r = (w, 0);
	z2r = (0, h);
	penlabels(1,2);
	penstroke z1e{up} .. {left}z2e;
	addto currentpicture also currentpicture xscaled -1;
	addto currentpicture also currentpicture yscaled -1;
fet_endchar;


fet_beginchar("plus (stopped)", "stopped", "plusstop")
	save thick, size;
	thick = 2 stafflinethickness;
	size# = 1.1 interline#;

	set_char_box(size#/2, size#/2, size#/2, size#/2);
	pickup pencircle scaled thick;

	rt x1 = w;
	y1 = 0;
	z2 = -z1;

	draw z1 .. z2;
	draw (z1 .. z2) rotated 90;
fet_endchar;

%
% FIXME: blotting 
%
fet_beginchar("Upbow", "upbow", "upbow")
	save ht, wd, thick;

	thick = 1.4 stafflinethickness;
	wd# = 1.3 interline#;
	ht# = 1.6 wd#; 

	
	set_char_box(wd#/2, wd#/2, 0, ht#);
	pickup pencircle scaled thick;

	x1 = 0;
	bot y1 = 0;
	rt x2 =  w;
	top y2 = h;

	labels(1,2);
	draw z2 -- z1 -- (z2 xscaled -1);
fet_endchar;


fet_beginchar("Downbow", "downbow", "downbow")
	save stemthick, beamheight;
	save wd;
	define_pixels(wd)

	wd# = 1.5 interline#;
	stemthick = 1.2 stafflinethickness;

	set_char_box(wd#/2, wd#/2, 0, 4/3 interline#);

	beamheight = 4/10 h;


	pickup pencircle scaled blot_diameter;
	top y2 - bot y1  = beamheight;
	top y2 = h;
	rt x1 = w;
	x1 = x2;
	y2 = y3;
	y1 = y4;
	x3 = 0;
	x4 = x3;
	save p;
	path p;
	filldraw z1 -- z2 -- z3 -- z4 --cycle;

	pickup pencircle scaled stemthick;

	bot y5 =0;
	rt x5 = rt x6 = w;
	y6 = h - beamheight;
	draw z6 -- z5;
	labels(1, 2,3,4,5,6);
	addto currentpicture also currentpicture xscaled -1;
fet_endchar;

%
% Inspired by a computer-set version of Auf dem Strom by Baerenreiter. 
%
fet_beginchar("Turn","turn","turn")
	save thin, thick, ball_diam, darkness;
	save wd, ht, thick_nibangle, ball_nib_thick;
	save turndir;
	pair turndir;

	wd# = 35/16 interline#;
	ht# = 18/17 interline#;
	darkness = 1.20 stafflinethickness;

	set_char_box(wd#/2, wd#/2, ht#/2, ht#/2);

	thick_nibangle = 60;
	thick = 3 darkness;
	thin = darkness;
	ball_nib_thick = 2.7 darkness;
	ball_diam = ball_nib_thick + (h - ball_nib_thick) / 10;

	
	x3l = w;
	y3 = 0;
	y4l = h;
	x4 = x2;
	x2l = w/2;
	y2l = -d;
	z1 = (0,0);

	penpos1(1.1 thick, thick_nibangle);
	penpos2(thick, thick_nibangle);
	penpos3(thin, 180);
	penpos4(ball_nib_thick, -90);

	path swoosh, ploop;
	swoosh :=  z1l{curl 0} .. z2l .. z3l{up} .. {left}z4l 
	  -- z4r .. z3r{down} .. z2r{left} ;
	fill swoosh .. (swoosh scaled -1) .. cycle;
	penlabels(2,3,4);

	x5r = x4;
	y5r = y4l - ball_diam /2;
	z6r = z5r;

	penpos5(1.6 ball_diam/2, 10);
	penpos6(ball_diam/2, 150);

	ploop := z4l{left} .. z5l .. z6l -- cycle;
	fill ploop;
	fill ploop scaled -1;


	penlabels(5,6,7);
	
fet_endchar;



%
% Inspired by a (by now) PD edition of Durand & C'ie edition of 
% Saint-Saens' Celloconcerto no. 1 
%
% FIXME take out hardcoded vars.
% FIXME the two loops on the `t' should be smoother (and the left one bigger).
% FIXME generic macros for serifs: top of the t and bottom of r
%
% 

fet_beginchar("Trill (`tr')","trill","trill")
	
	save start_nib_angle,  ascender_extra, ex, hair_thick, fatness,
	  slant_angle, slant, t_fatness, r_fatness, kerning, t_overshoot, 
	  uitschieter, bulb_size;
	;
	pair slant_vec;

	ascender_extra# = 1/2 ex#;
	ascender# = ascender_extra# + ex#;
	ex# = 1.5 interline#;
	kerning# = .75 ex#;
	start_nib_angle = 20;
	bulb_size = 0.47;
	define_pixels(ex, ascender_extra, ascender, kerning);

	t_overshoot = 0.03 ex;
	fatness = 12/40 ex;
	t_fatness = 8/10 fatness;
	r_fatness = .75 fatness;
	uitschieter = 21/40 ex;
	hair_thick =  blot_diameter;

	slant = .2;

	local_copy(transform)(currenttransform);
	currenttransform := currenttransform slanted slant shifted (- interline, 0)  ;

	y1 = ascender;
	x1l = 0;
	x1r = t_fatness;
	penpos1(start_nib_wid, start_nib_angle);
	
	z2 = (x1, 7/18 ex);
	penpos2(start_nib_wid, start_nib_angle);

	z3l = (11/10 t_fatness, - t_overshoot);

	z4l = (13/6 t_fatness, 5/16 ex);
	penpos4(hair_thick, 180);

	1.9 [z3l, z3r] = z4r;
	z3 = .5 [z3l, z3r];
	
	save t_p, krul_p;
	path t_p, krul_p, r_p;


	t_p := z1l -- z2l{down} .. tension (1 + .5 slant)
		.. z3l{right} 
		
		.. z4l{up} -- z4r{down} 
		.. z3r{left} .. z2r{up} .. z1r -- cycle;
	fill t_p ;

	krul_ang = 32;

	pickup pencircle scaled hair_thick;

	z5 = (t_fatness/2, 2/3 ex);
	
	lft x6 = - uitschieter;
	y6 =  y5 - 1/20 ex;

	z7 = z5 + whatever*dir krul_ang;
	up_angle = krul_ang;
	% angle (z7-z5)
	x7 = 5/10 kerning + x5;
	
	penpos7(hair_thick, up_angle + 90);

	
	x8l = .7 [x9r, x7r];
	y8l = y7l;
	penpos8(2 hair_thick, (up_angle +90)/2);

	y9 = 3/4 ex;
	x9 = x1 + kerning;
	penpos9(r_fatness, 0);

	x10 = x9;
	y10 = 0;
	penpos10(r_fatness, 0);

	krul_p := z4{up} .. tension 1.1  .. z5 
		.. tension 1 and .75 .. {down}z6
		.. tension .85 and 1.1 .. z5 --- z7;
	draw krul_p;
	r_p := z7l{z7-z5} .. z8l{right} .. z9l{down} --- z10l -- z10r
		--- z9r{up} 
		..  z8r{left} ..  z7r{z5-z7} -- cycle;
	fill r_p;
	set_char_box(interline# , interline#, 0,ascender#);


	penpos11(1/4 r_fatness, -20);
	z11r = z9r;
	
	z13 = (x9 + 2 r_fatness, y11 );
	penpos13(r_fatness, 180);
	fill z11r{dir 70} .. z13r{down} -- z13l{up} .. z11l{dir 250} -- cycle;
	penlabels(range 1 thru 15);


	draw_bulb(-1, z13r, z13l, bulb_size * r_fatness, 1.5);
fet_endchar;


def draw_heel =
	save radius, thickness, wall;

	radius# := .5 interline#;

	define_pixels(radius);
	set_char_box(radius#, radius#, radius#, 2/3 interline#);

	thickness := 1.5 stafflinethickness;	
	pickup pencircle scaled thickness;
	rt x1 = b;
	top y1 = h;
	
	x2 =x1;
	y2 = 0;

	x3 = 0;
	bot y3 = -d;

	draw z1{down} .. z2{down} .. z3{left};
	addto currentpicture also currentpicture xscaled -1;
	
enddef;


fet_beginchar("left heel", "upedalheel", "upedalheel")
	draw_heel;
	labels(1,2,3);
fet_endchar;

fet_beginchar("right heel", "dpedalheel", "dpedalheel")
	draw_heel;
	y_mirror_char;
fet_endchar;

def draw_toe =
	save ht,wd;

	thickness := 1.5 stafflinethickness;
	ht# := 1.5 interline#;
	wd# := 1/3 ht#;
	define_pixels(ht,wd);


	set_char_box(wd#, wd#, 0, ht#);
	
	pickup pencircle scaled thickness;
	lft x1 = -b;
	bot y1 = 0;
	x2 =0;
	top y2 = h;
	z3 = z1 xscaled -1;


	draw z1 -- z2 -- z3;

enddef;
	
fet_beginchar("left toe", "upedaltoe", "upedaltoe")
	draw_toe;
	labels(1,2,3);
fet_endchar;
fet_beginchar("right toe", "dpedaltoe", "dpedaltoe")
	draw_toe;
	y_mirror_char;
fet_endchar;

fet_beginchar("Flageolet", "flageolet", "flageolet")
	save height,width,thickness;
	height#=4/15 staffsize#;
	width#=height#;
	thickness#=blot_diameter#;
	define_pixels(height,width,thickness);
	set_char_box(width#/2,width#/2,height#/2,height#/2);
	
	pickup pencircle scaled thickness;
	x1= .5 [x2, x4];
	x1 = 0;
	top y1=height/2;
	rt x4  - lft x2 =width; 
	y2 = 0;
	y4=y2;
	x3=x1;
	bot y3=-height/2;

	penlabels(1,2,3,4);
	draw z1..z2..z3..z4..cycle;
fet_endchar;

fet_endgroup("scripts");