% This file contains macro definitions for accents common to text roman 
% and italic fonts.  It is directly derived from accent.mf, which is
% one of the standard Computer Modern Program files released by Donald
% Knuth in 1986.  These accents are intended for pre-defined character
% and diacritical combinations in fonts derived from Computer Modern.

% Written by P. A. MacKay, University of Washington

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%   Beta release (some accents not completely coded) 8 May, 1988   %%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%

% Accents are intended to be exact copies of the accents in the
% Computer Modern file accent.mf, with the following exceptions:
%    1.  Bar accents are adjusted to the width of the associated letter.
%    2.  The hat accent is pinched in to fit the letter i.
%    3.  Acute and grave accents are rotated to whatever angle
%        best suits the associated letter. (Especially for Upper Case.)
%    4.  The under_h accent is based on an inverted tie accent.

% No attempt is made to put the accent in the same position
% that it would occupy if \TeX\ put it in with the \accent primitive.
% Each accent has been adjusted for vertical and horizontal position
% position to best fit the associated letter.

accsub:=1; % when |accsub| is known, this file has been input

numeric xxxpr; xxxpr:=0;

def Grave_accent (expr xxxpr) =
if serifs: pickup crisp.nib; x@_1-.5stem=hround 2u; x@_2=2/3[x@_1,w-x@_1];
 y@_1+.5stem=h+eps; y@_2=max(2/3[h,x_height],x_height+o+hair);
 numeric theta; theta=angle(z@_2-z@_1)+90;
 pos@_1(stem,theta); pos@_2(hair,theta);
 filldraw circ_stroke z@_1e--z@_2e;  % diagonal
else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0);
 lft x@_1l=hround 1.5u; rt x@_2r=hround(.5w+.25u+.5vair);
 top y@_1=h; bot y@_2=vround 2/3[h,x_height];
 filldraw stroke z@_1e--z@_2e; fi  % diagonal
penlabels(1,2); enddef;

def Acute_accent (expr xxxpr) =
if serifs: pickup crisp.nib; x@_1+.5stem=hround(w-2u); x@_2=2/3[x@_1,w-x@_1];
 y@_1+.5stem=h+eps; y@_2=max(2/3[h,x_height],x_height+o+hair);
 numeric theta; theta=angle(z@_2-z@_1)+90;
 pos@_1(stem,theta); pos@_2(hair,theta);
 filldraw circ_stroke z@_1e--z@_2e;  % diagonal
else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0);
 rt x@_1r=hround(w-1.5u); lft x@_2l=hround(.5w-.25u-.5vair);
 top y@_1=h; bot y@_2=vround 2/3[h,x_height];
 filldraw stroke z@_1e--z@_2e; fi  % diagonal
penlabels(1,2); enddef;

def Hachek_accent (expr xxxpr) =
if serifs:
 pickup crisp.nib; pos@_2'(.5[vair,curve],90); top y@_2'r=h;
 pos@_2(.5[vair,curve],90); x@_2=.5w;
 x@_1=w-x@_3=good.x 2.25u; top y@_1=top y@_3=h; y@_1-y@_2=.5(y@_2'-x_height);
 pos@_1(hair,angle(z@_2-z@_1)+90); pos@_3(hair,angle(z@_3-z@_2)+90);
 filldraw stroke z@_1e--z@_2e--z@_3e;  % diagonals
else: 
 pickup fine.nib; pos@_1(vair,0); pos@_3(vair,0); x@_1=w-x@_3;
 pos@_2(stem,0); bot y@_2=vround(1/12[x_height,h']+o); x@_2=.5w;
 top y@_1=top y@_3=h+o; lft x@_1l=hround(rt x@_2r-3.25u-.5vair);
 z@_0=whatever[z@_1r,z@_2r]=whatever[z@_2l,z@_3l];
 y@_4l=y@_4r=y@_2; x@_4l=good.x .2[x@_2l,x@_2]; x@_4r=w-x@_4l;
 filldraw z@_4l--z@_1l--z@_1r--z@_0--z@_3l--z@_3r--z@_4r--cycle; fi  % diagonals
penlabels(0,1,2,3,4); enddef;

def cup_accent (suffix $,@)(expr cY_shift) =
save @;
forsuffixes $$=@,@_: transform $$; endfor
pickup crisp.nib; pos@_1(vair,-180); pos@_3(vair,0);
top y@_1=top y@_3=asc_height; 
rt x@_3r-x$=x$-lft x@_1r=2.5u+.5vair;
numeric mid_thickness; mid_thickness=vround 1/3[vair,stem];
pos@_2(mid_thickness,-90); x@_2=.5[x@_1,x@_3];
bot y@_2r=vround 
 max(x_height+o+tiny,1/3[x_height,asc_height]+o-.5mid_thickness);
@ = identity shifted(0,cY_shift);
for n = 1,2,3: forsuffixes e = l,,r: 
 z@[n]e = z@_[n]e transformed @; endfor endfor
filldraw stroke z@1e{down}...z@2e{right}...{up}z@3e;  % stroke
penlabels(@1,@2,@3); enddef;

def bar_accent (suffix $,$$,@)(expr bH) =
numeric macron_breadth#; macron_breadth#=.2[vair#,stem#];
numeric macron_breadth; macron_breadth:=Vround .2[vair,stem];
pickup if serifs: crisp.nib else: fine.nib fi;
pos@1(macron_breadth,90); pos@2(macron_breadth,90);
top y@1r=top y@2r=if bH<0: bH + macron_breadth else: bH+o fi; 
lft x@1=x$; rt x@2=x$$;
filldraw stroke z@1e--z@2e;  % bar
penlabels(@1,@2); enddef;

def circle_accent (expr xxxpr) =
numeric circ_hair,circ_vair;
circ_hair=hround min(hair,u+.5); circ_vair=vround min(vair,(h-x_height)/6+.5);
penpos@_1(circ_vair,90); penpos@_3(circ_vair,-90);
penpos@_2(circ_hair,180); penpos@_4(circ_hair,0);
x@_2r=hround(.5w-1.5u-.5circ_hair);
x@_4r=w-x@_2r; x@_1=x@_3=.5w; y@_1r=h+apex_o; y@_2=y@_4=.5[y@_1,y@_3];
y@_3r=vround(1/3[x_height,h]+apex_o);
penstroke pulled_arc.e(1,2) & pulled_arc.e(2,3)
 & pulled_arc.e(3,4) & pulled_arc.e(4,1) & cycle;  % bowl
penlabels(1,2,3,4); enddef;

def cedilla_accent (suffix $,@)(expr cD_shift) =
save @;
forsuffixes $$=@,@_: transform $$; endfor
if serifs: pickup crisp.nib; pos@_1(stem,0); pos@_2(stem,0);
 pos@_3(vair,90); pos@_4(stem,0); pos@_5(vair,-90);
 x@_1=x@_2=x$; z@_3l=z@_2l; x@_4=x@_2+1.5u; x@_5=x@_3-1.5u;
 bot y@_1=-o; bot y@_2=-vround 2/7d-o; y@_4=.5[y@_3,y@_5]; bot y@_5=-d-o;
 @ = identity shifted(0,cD_shift);
 for n = 1,2,3,4,5: forsuffixes e = l,,r: 
  z@[n]e = z@_[n]e transformed @; endfor endfor
 filldraw stroke z@1e--z@2e;  % stem
 filldraw stroke z@3e{right}...z@4e{down}...{left}z@5e;  % hook
else: pickup fine.nib; pos@_1(vair,0); top y@_1=-o-2;
 pos@_2(.5[vair,stem],0); bot y@_2=-d-o; x@_1=x$; x@_2=x@_1-1.25u;
 @ = identity shifted(0,cD_shift);
 for n = 1,2: forsuffixes e = l,,r: 
  z@[n]e = z@_[n]e transformed @; endfor endfor
 filldraw stroke z@1e--z@2e; fi  % diagonal
penlabels(@1,@2,@3,@4,@5); enddef;

def cross_for_l (expr xxxpr) =
if unknown l_width#:
 l_width#:=5u#+2serif_fit#; fi  % nominal width of `l'
if unknown L_stem#:
 L_stem#:=cap_serif_fit#+max(2u#+.5cap_stem#,3u#); fi  % center of `L' stem
ligtable oct"040": "l" kern -l_width#-2letter_fit#,
 "L" kern -.5l_width#-L_stem#-2letter_fit#;
pickup crisp.nib; x@_2-x@_1=max(4u,2.8u+stem); .5[x@_1,x@_2]=.5w;
y@_1-.5bar=.2[bar_height,x_height]; y@_2+.5bar=.8[bar_height,x_height];
numeric theta; theta=angle(z@_2-z@_1)+90;
pos@_1(bar,theta); pos@_2(bar,theta);
filldraw stroke z@_1e--z@_2e;  % diagonal
penlabels(1,2); enddef;

% hat_accent.  To get the same effect as the Computer modern character,
% set the first $ suffix to the center high-point of the character,
% For lower case characters whose "beginchar" height
% parameter is x_height, change this to asc_height, or a fraction
% of the distance from x_height to asc_height.  Check through
% the character program to make sure that values of "h" are renamed 
% "x_height".

def hat_accent (suffix $,@)(expr hY_shift) =
save @;
forsuffixes $$=@,@_: transform $$; endfor
if serifs:
 pickup crisp.nib; pos@_2(.5[vair,curve],90); 
 top y@_2r=min(asc_height,2x_height); x@_2=x$;
 if w>6u: x@_3-x@_2=x@_2-x@_1=2.25u; 
 else: x@_3-x@_2=x@_2-x@_1=1.65u; fi % reshape over i
 y@_1=y@_3=.5[x_height,y@_2];
 pos@_1(hair,angle(z@_2-z@_1)+90); pos@_3(hair,angle(z@_3-z@_2)+90);
 @ = identity shifted(0,hY_shift);
 for n = 1,2,3: forsuffixes e = l,,r: 
  z@[n]e = z@_[n]e transformed @; endfor endfor
 filldraw stroke z@1e--z@2e--z@3e;  % diagonals
else: 
 pickup fine.nib; pos@_1(vair,0); pos@_3(vair,0); x@_1=w-x@_3;
 pos@_2(stem,0); top y@_2=min(asc_height,2x_height); x@_2=x$;
 bot y@_1=bot y@_3=vround 2/3[min(asc_height,2x_height),x_height]-eps;
 if w>6u:
  lft x@_1l=hround(rt x@_2r-3.25u-.5vair); % same slope as in the acute accent
 else:
  lft x@_1l=hround(rt x@_2r-2.25u-.5vair); fi % pinch it for i
 z@_0=whatever[z@_1r,z@_2r]=whatever[z@_2l,z@_3l];
 y@_4l=y@_4r=y@_2; x@_4l=good.x .2[x@_2l,x@_2]; x@_4r=w-x@_4l;
 @ = identity shifted(0,hY_shift);
 for n = 0,1,2,3,4: forsuffixes e = l,,r: 
  z@[n]e = z@_[n]e transformed @; endfor endfor
 filldraw z@4l--z@1l--z@1r--z@0--z@3l--z@3r--z@4r--cycle; fi  % diagonals
penlabels(@0,@1,@2,@3,@4); enddef;

% This is a bit odd, owing to the fact that what we know is the
% position of the top of the dot, but what we want to position
% correctly is the bottom of the dot.  For this reason, the shift 
% value must be calculated (in the code for the associated letter)
% from the expected top pixel of the dot to the desired bottom
% edge of the dot.  Then dot_span is added to correct the effect.
def dot_accent (suffix $,@) (expr dotY_shift)=
save @;
forsuffixes $$=@,@_: transform $$; endfor
numeric dh#; dh#:=min(asc_height#,10/7x_height#+.5dot_diam#);
define_whole_blacker_pixels(dh,dot_diam);
pickup tiny.nib; pos@_1(dot_diam,0); pos@_2(dot_diam,90);
x@_1=x@_2=x$; top y@_2r=dh+1;
if bot y@_2l<x_height+o+slab: y@_2l:=min(y@_2r-eps,x_height+o+slab+.5tiny); fi
y@_1=.5[y@_2l,y@_2r];  
numeric dot_span; dot_span=dh-bot y@_2l;
@ = identity if dotY_shift <> 0: shifted(0,dotY_shift+dot_span) fi;
for n = 1,2: forsuffixes e = l,,r: 
 z@[n]e = z@_[n]e transformed @; endfor endfor
dot(@1,@2);  % dot
penlabels(@1,@2); enddef;

def dot_sharp_values =
numeric dot_diam#; dot_diam#=max(dot_size#,cap_curve#);
numeric dot_top#; dot_top#=min(asc_height#,10/7x_height#+.5dot_diam#);
enddef;

def Long_Hungarian_accent (expr xxxpr) =
x@_3-x@_1=x@_4-x@_2=hround 3u; y@_3=y@_1; y@_4=y@_2;
if serifs: pickup crisp.nib; x@_3+.5stem=hround(w-1.5u); x@_2=2.5u;
 y@_1+.5stem=h; y@_2=max(2/3[h,x_height],x_height+o+hair);
 numeric theta; theta=angle(z@_2-z@_1)+90;
 pos@_1(stem,theta); pos@_2(hair,theta);
 pos@_3(stem,theta); pos@_4(hair,theta);
 filldraw circ_stroke z@_1e--z@_2e;  % left diagonal
 filldraw circ_stroke z@_3e--z@_4e;  % right diagonal
else: pickup fine.nib; pos@_1(stem,0); pos@_2(vair,0);
 pos@_3(stem,0); pos@_4(vair,0);
 rt x@_3r=hround(w-1.5u); lft x@_4l=hround(.5w+u-.5vair);
 top y@_1=h; bot y@_2=vround 2/3[h,x_height];
 filldraw stroke z@_1e--z@_2e;  % left diagonal
 filldraw stroke z@_3e--z@_4e; fi  % right diagonal
penlabels(1,2,3,4); enddef;

def tilde_accent (suffix $,@)(expr tY_shift) =
save @;
forsuffixes $$=@,@_: transform $$; endfor
if serifs: numeric theta; theta=angle(1/6(6u-vair),1/4(asc_height-x_height));
 pickup crisp.nib; numeric mid_width; mid_width=.4[vair,stem];
 pos@_1(vair,theta+90); pos@_2(vair,theta+90);
 pos@_3(vair,theta+90); pos@_4(vair,theta+90);
 z@_2-z@_1=z@_4-z@_3=(mid_width-crisp)*dir theta;
 rt x@_4l-x$=x$-lft x@_1r=3u; top y@_4r=asc_height;
 bot y@_1l=vround(bot y@_1l+min(2/3[x_height,asc_height],y@_3l-.25vair)-top y@_1r);
 pair delta; ypart delta=3(y@_3l-y@_1l); delta=whatever*dir theta;
 @ = identity shifted(0,tY_shift);
 for n = 1,2,3,4: forsuffixes e = l,,r: 
  z@[n]e = z@_[n]e transformed @; endfor endfor
 filldraw z@1l..controls(z@1l+delta)and(z@3l-delta)..z@3l..z@4l
  --z@4r..controls(z@4r-delta)and(z@2r+delta)..z@2r..z@1r--cycle;  % stroke
else: pickup fine.nib; pos@_1(vair,180); pos@_2(vair,90);
 pos@_3(.5[vair,slab],90); pos@_4(vair,90); pos@_5(vair,180);
 rt x@_5l-x$=x$-lft x@_1r=3u; x@_2-x@_1=x@_3-x@_2=x@_4-x@_3=x@_5-x@_4;
 bot y@_1=bot y@_4l=vround(.75[x_height,asc_height]-vair);
 top y@_2r=top y@_5=asc_height; y@_3=.5[y@_2,y@_4];
 @ = identity shifted(0,tY_shift);
 for n = 1,2,3,4,5: forsuffixes e = l,,r: 
  z@[n]e = z@_[n]e transformed @; endfor endfor
 filldraw stroke z@1e{up}...z@2e{right}..z@3e..{right}z@4e...{up}z@5e; fi % stroke
penlabels(@1,@2,@3,@4,@5); enddef;

def cap_tilde (suffix $,@)(expr tW) =
save @;
forsuffixes $$=@,@_: transform $$; endfor
pickup crisp.nib;
numeric theta,tmp_h;
tmp_h=.5[asc_height,body_height]; 
theta=angle(1/6(tW-vair),1/4(tmp_h-x_height));
numeric mid_width; mid_width=.4[vair,stem];
pos@_1(vair,theta+90); pos@_2(vair,theta+90);
pos@_3(vair,theta+90); pos@_4(vair,theta+90);
z@_2-z@_1=z@_4-z@_3=(mid_width-crisp)*dir theta;
w-rt x@_4l=lft x@_1r=.5w-.5tW; top y@_4r=.5[asc_height,body_height];
bot y@_1l=vround(bot y@_1l+min(2/3[x_height,tmp_h],y@_3l-.25vair)-top y@_1r);
pair delta; ypart delta=3(y@_3l-y@_1l); delta=whatever*dir theta;
@ = identity shifted(0,if dish > 0: y@_4r-y@_1l else: 2(y@_4r-y@_1l) fi);
for n = 1,2,3,4,5: forsuffixes e = l,,r: 
 z@[n]e = z@_[n]e transformed @; endfor endfor
filldraw z@1l..controls(z@1l+delta)and(z@3l-delta)..z@3l..z@4l
 --z@4r..controls(z@4r-delta)and(z@2r+delta)..z@2r..z@1r--cycle;  % stroke
penlabels(@1,@2,@3,@4); enddef;

def double_dot_accent (expr xxxpr) =
numeric dot_diam#,dot_diam;
dot_diam#=max(dot_size#,cap_curve#);
dot_diam=max(tiny.breadth,hround(max(dot_size,cap_curve)-2stem_corr));
pickup tiny.nib; pos@_1(dot_diam,0); pos@_2(dot_diam,90);
x@_1=x@_2=2.75u; top y@_2r=h+1;
if bot y@_2l<x_height+o+slab: y@_2l:=min(y@_2r-eps,x_height+o+slab+.5tiny); fi
y@_1=.5[y@_2l,y@_2r]; dot(1,2);  % left dot
pos@_3(dot_diam,0); penpos@_4(y@_2r-y@_2l,90); y@_3=y@_4=y@_1; x@_3=x@_4=w-x@_1;
dot(3,4);  % right dot
penlabels(1,2,3,4); enddef;

def under_h_accent (suffix $,$$,@) =
pickup fine.nib; pos@1(hair,180); pos@2(vround 1/3[vair,stem],270); pos@3(hair,0);
lft x@1r=x$; x@2=.5[x@1,x@3];
rt x@3r=x$$;
y@1=y@3=vround(-fine-1); bot y@2r=vround (y@1-4/9desc_depth);
filldraw stroke super_arc.e(@1,@2) & super_arc.e(@2,@3);  % arc
penlabels(@1,@2,@3); enddef;