path: root/fonts/malvern/source/makit.mf

% makit.mf 1.2.0 94/10/11 -- bits of "kit"
% Copyright  1991, 1992, 1993 P. Damian Cugley.

%%% @METAFONT-file {
%%%   filename       = "makit.mf",
%%%   version        = "1.2.0",
%%%   date           = "1994/10/11",
%%%   package        = "Malvern 1.2",
%%%   author         = "P. Damian Cugley",
%%%   email          = "damian.cugley@comlab.ox.ac.uk",
%%%   address        = "Oxford University Computing Laboratory,
%%%                     Parks Road, Oxford  OX1 3QD, UK",
%%%   codetable      = "USASCII",
%%%   keywords       = "Malvern, METAFONT, font, typefont, TeX",
%%%   supported      = "Maybe",
%%%   abstract       = "Macro definitions for the Malvern
%%%                     font family.",
%%%   dependencies   = "other program files",
%%% }

%  See the Malvern Handbook (maman.tex) for more info about Malvern.
%  This software is available freely but without warranty.
%  See the file COPYING for details.

%{{{ makit.mf
% See the file COPYING for details.

%{{{  oneof -- check if elt in set

%  if oneof(1,5,7)var: ...; fi

def oneof(text t) suffix $ =
    false 
    for i = t: or ($ = i) endfor
enddef;

%}}}
%{{{  |ma_char| -- macro to start/end characters with

%  Instead of giving the width of the bounding box and then
%  drawing within it -- as with most font programs -- I make explicit in
%  the character program's header how much space is left on either side
%  of the glyph itself.

%  This is used to calculate the usual |w| value, and also |l| and |r|,
%  which are set to be the left and right edges of the glyph.  The
%  character programs then set points etc. relative to |l| and |r|
%  rather than |0| and |w|.

def ma_char(expr code, w_sharp, h_sharp, d_sharp, l_sp, r_sp) =
    beginchar(code_offset + byte code,   % matched by endchar
    	if known force_wd#: force_wd# else: w_sharp + (l_sp + r_sp) * sp# fi, 
    	h_sharp, d_sharp);
    	h# := charht; l# := l_sp * sp#; r# := charwd - r_sp * sp#; 
    	    % for italcor calc
    	l := hround (l_sp * sp); 
    	if known force_wd#: 
    	    r := hround (charwd * hppp - r_sp*sp); 
    	else: 
    	    r := l + hround (w_sharp * hppp);
    	fi
    	pickup the_pen;
enddef;
%}}}
%{{{  beginglyph etc. -- new conventions

%  New beginglyph acts like beginchar but has no code parameter
%  The code is given to shipglyph or endglyph.

def beginglyph(expr w_sharp, h_sharp, d_sharp) =
    begingroup					  % matched by endglyph
    charcode := -1;
    charwd := w_sharp; w := hround(charwd * hppp);
    charht := h_sharp; h := vround(charht * hppp); 
    chardp := d_sharp; d := vround(chardp * hppp);
    charic := 0; clearxy; clearit; clearpen; 
    glyph_tmp := nullpicture; glyph_set := false;
    scantokens extra_beginchar;
    scantokens extra_beginglyph
enddef;

def endglyph(expr code) =
    if known code:
	scantokens extra_endchar; scantokens extra_endglyph;
	if proofing > 0: makebox(proofrule); fi
    	charcode := code_offset + byte code; chardx := w;
	shipit;
    	if displaying > 0: makebox(screenrule); showit; fi
    fi
    endgroup					  % matches beginglyph
enddef;

%  Shipglyph may be used between beginglyph and endglyph
%  it ships out the current picture with the goven code
%  and then if this is a composite glyph it restores the base glyph
%  (the picture that was current the first time shipglyph was invoked).
%
%  thus
%  beginglyph(w,h,d);
%      ...
%  shipglyph(base);
%      ... (draw acute)
%  shipglyph(base.acute)
%      ... (draw grave)
%  shipglyph(base.grave)
%      ... (draw circumflex)
%  endchar(base.circumflex)
%
def shipglyph(expr code) =
    if known code:
    	if not glyph_set: glyph_tmp := currentpicture; fi
	scantokens extra_endchar; scantokens extra_endglyph;
	if proofing > 0: makebox(proofrule); fi
    	charcode := code_offset + byte code; chardx := w;
	shipit;
    	if displaying > 0: makebox(screenrule); showit; fi
    	if glyph_set: 
    	    currentpicture := glyph_tmp;
    	else:
    	    glyph_set := true;			  % for next time
    	fi
    fi
enddef;
    
string extra_beginglyph, extra_endglyph; 
extra_beginglyph = extra_endglyph = "";
picture glyph_tmp;
boolean glyph_set;

def ma_glyph(expr w_sharp, h_sharp, d_sharp, l_sp, r_sp) =
    beginglyph(	    	% matched by endchar
    	if known force_wd#: force_wd# else: w_sharp + (l_sp + r_sp) * sp# fi, 
    	h_sharp, d_sharp);
    	h# := charht; l# := l_sp * sp#; r# := charwd - r_sp * sp#; 
    	    % for italcor calc
    	l := hround (l_sp * sp); 
    	if known force_wd#: 
    	    r := hround (charwd * hppp - r_sp*sp); 
    	else: 
    	    r := l + hround (w_sharp * hppp);
    	fi
    	pickup the_pen;
enddef;
    
%}}}
%{{{  alter some standard macros to fit with my l,r convention

def force_symmetry =
    if odd ((r - l) - pn.wd): change_width; fi
enddef;

def change_width =
    begingroup save delta; delta = if w>charwd*hppp: -1 else: +1 fi;
    	w := w + delta; r := r + delta;
    endgroup
enddef;

def change_depth =
    begingroup save delta; delta = if d>chardp*hppp: -1 else: +1 fi;
    	d := d + delta;
    endgroup
enddef;

def makebox(text rule) =
    for y = if charht > x_ht#: body_ht, brack_ht, cap_ht, asc_ht, fig_ht, fi
    	x_ht, axis_ht
    	if chardp <> 0: , -desc_dp, -brack_dp, -body_dp fi:
    	rule ((l,y)t_, (r,y)t_); 
    endfor
    for x = 0, w: rule ((x, h + v)t_, (x, -d - v)t_); endfor % set width
    rule ((0, 0)t_, (w,0)t_);
    for x = l step u until r: rule ((x,-d)t_, (x, h)t_); endfor
    if charic <> 0:
    	rule ((w + charic/pt#*pt, h o_), (w + charic/pt#*pt, 1/2h o_)); 
    fi
enddef;
%}}}
%{{{  macros to start l.c. characters with

def lctitle expr s =
    if (byte s > 96) and (byte s < 123):
    	"lower case " & if string s: s else: "code " & decimal s fi;
    fi
enddef;

def x_char(expr code, w_sharp) = 
    lctitle code; ma_char(code, w_sharp, x_ht#, 0v#) 
enddef;

def y_char(expr code, w_sharp) = 
    lctitle code; ma_char(code, w_sharp, x_ht#, desc_dp#) 
enddef;

def b_char(expr code, w_sharp) = 
    lctitle code; ma_char(code, w_sharp, asc_ht#, 0v#) 
enddef;

def b_glyph(expr w_sharp) = 
    ma_glyph(w_sharp, asc_ht#, 0v#) 
enddef;
%}}}
%{{{  macros to start cap letters with

def capttl expr code =
    if string code:
    	if (ASCII code > 64) and (ASCII code < 91): 
		"Capital " & code; 
    	fi
    fi
enddef;

def ma_cap(expr code, wd_sh) = 
    capttl code; ma_char(code, wd_sh, height#, 0v#)
enddef;

%}}}  macros to start cap letters with
%{{{  The usual iff macro to skip characters with

%  I originally used the more straightforward method of surrounding
%  character programs in if ... fi.  But this gets too cluttered,
%  and the indentation gets out of control... 

%  METAFONTbook p.307
let semi_=; ; let colon_ = : ;  let endchar_ = endchar;
let endglyph_ = endglyph;

def iff expr b =
    if b: let next_ = use_it; else: let next_ = lose_it; fi
    next_
enddef;

def use_it = let : = restore_colon; enddef;
def restore_colon = let : = colon_; enddef;

def lose_it = 
    let endchar = fi; let endglyph = fi; let ; = fix_ semi_
    if false % everything from colon to matching |endchar| deleted
enddef;

def fix_ = 
    let ; = semi_; let endchar = endchar_; let endglyph = endglyph_;
enddef;

%}}}
%{{{  |similarly| -- One character program makes several characters

%  Several characters are made by combining one basic glyph (usually a
%  letter) with some sort of mark -- for example, `\'e' is a composite
%  letter made from `e' and `\'{}'.

%  The |anotherchar| macro ships out the current charcter and then
%  starts a new character with the same currentpicture, pen, variables
%  etc.  |yetanotherchar| reuses the picture from the first char.
%  If the new code is |whatever|, the old code + 1 is used.


picture anothercharpicture;
boolean finishcharp;

def remember = 
    anothercharpicture := currentpicture;
    save_chardp := chardp; save_charht := charht;
    finishcharp := not co_only
enddef;

def similarly(expr newcode) =
    if known newcode:
	if finishcharp: finishchar; else: finishcharp := true; fi
	charcode := code_offset + newcode;
    	chardp := save_chardp; charht := save_charht;
	scantokens extra_beginchar;
	currentpicture := anothercharpicture;
    	let next_ = \;
    	let wug = \;
    else:
    	let next_ = skip_subprog;
    fi
    next_
enddef;

def skip_subprog =
    let wug = fi; let ; = sim_fix_ semi_
    if false:  % matched by |wug|, whose following |;| becomes |sim_fix_|.
enddef;

def sim_fix_ =
    semi_ let ; = semi_; let wug = \; 
enddef;

def finishchar =
    scantokens extra_endchar;
    if proofing > 0: makebox(proofrule); fi
    chardx := w; shipit;
    if displaying > 0: makebox(screenrule); showit; fi
enddef;

%  beginchar(...)
%  ...
%  remember;
%  similarly(...)
%  ...
%  wug;
%  similarly(...)
%  ...
%  wug;
%  endchar;
%}}}
%{{{  italic corrections

def set_ic expr z = 
    italcorr r# + slant*z + 1/2sp# - charwd
enddef;

def set_icc(expr tx, ty) expr y =
    charic := max(0, tx + slant*ty + 1/2sp# - charwd, 
    	    r# + slant*y + 1/2sp# - charwd);
enddef;

def set_ic_Oo(expr wd, ht)  =
    for theta = angle (1, slant):
    	x# := wd * cosd theta + (r# - wd) 
    	    + slant * (ht * sind theta + ht);
    	charic := max(0, x# + 1/2sp# - charwd);
    endfor
enddef;
def set_ic_o = set_ic_Oo(4u#, 4v#) enddef;
def set_ic_O = 
    if hratio >= 0.9:
         set_ic_Oo(1/2width#, 1/2height#) 
    else:
    	set_ic(11/12h#)
    fi
enddef;
def set_ic_tr = set_ic h# enddef;
def set_ic_e = set_ic_o enddef;
%}}}
%{{{  Circles & arcs

vardef draw_circle@#(expr leftx, topy, rightx, boty) =
    x1@# = x3@# = 1/2[x0@#, x2@#]; y0@# = y2@# = 1/2[y1@#, y3@#];
    top y1@# = topy; bot y3@# = boty; 
    rt x0@# = rightx; lft x2@# = leftx;
    z1a@# = z3b@# = z0@#; z1b@# = z3a@# = z2@#;  % for later calculations
    draw superellipse(z0@#, z1@#, z2@#, z3@#)(1/sqrt2);
    labels(0@#, 1@#, 2@#, 3@#)
enddef;

def hvarc(suffix f, t) =
    z.f
    ... (1/sqrt2)[(x.f, y.t), (x.t, y.f)]{z.t - z.f}
    ... z.t
enddef;

def vharc(suffix f, t) =
    z.f
    ... (1/sqrt2)[(x.t, y.f), (x.f, y.t)]{z.t - z.f}
    ... z.t
enddef;

%}}}
%{{{  "box" x.l, x.r, ... for simple boxlike chars

vardef box_points@# =
    lft x@#l = l; rt x@#r = r;
    top y@#t = h; bot y@#b = -d;
    y@#m = good.y (0.55[y@#b,y@#t]);
enddef;

vardef draw_box_l@# = draw (x.l, y.t) -- (x.l, y.b) enddef;
vardef draw_box_r@# = draw (x.r, y.t) -- (x.r, y.b) enddef;
vardef draw_box_l_o@# = draw (x.l, y.t + o) -- (x.l, y.b - o) enddef;
vardef draw_box_r_o@# = draw (x.r, y.t + o) -- (x.r, y.b - o) enddef;
vardef draw_box_t@# = draw (x.l, y.t) -- (x.r, y.t) enddef;
vardef draw_box_m@# = draw (x.l, y.m) -- (x.r, y.m) enddef;
vardef draw_box_b@# = draw (x.l, y.b) -- (x.r, y.b) enddef;
vardef draw_box@# = 
    draw (x.l, y.b) -- (x.r, y.b) -- (x.r, y.t) -- (x.l, y.t) -- cycle
enddef;
%}}}
%{{{  apex

vardef apex.x primary x =
    save trial; trial := hround x;
    if odd apex_adjust: 
    	if trial > x: trial - 1/2 else: trial + 1/2 fi
    else:
    	trial
    fi
enddef;

vardef apex_path@# =
    x@#a = x@# - 1/2apex_adjust;
    x@#c = x@# + 1/2apex_adjust;
    x@#b = 1/2[x@#a, x@#c];
    y@#a = y@#c = y@#; y@#b = y@# + apex_o; 
    labels(@#a,@#b,@#c);
    z@#a & z@#a .. z@#b .. z@#c & z@#c
enddef;

vardef vpex_path@# =
    x@#a = x@# - 1/2apex_adjust;
    x@#c = x@# + 1/2apex_adjust;
    x@#b = 1/2[x@#a, x@#c];
    y@#a = y@#c = y@#; y@#b = y@# - apex_o; 
    labels(@#a,@#b,@#c);
    z@#a & z@#a .. z@#b .. z@#c & z@#c 
enddef;
%}}}

vardef draw_dot@# = 
    fill fullcircle xscaled dot_wd yscaled dot_ht shifted z@#
enddef;

%{{{  Left stem

vardef left_stem@#(expr to, bo) =
    lft x@#1 = lft x@#2 = l;
    top y@#1 = h + to; bot y@#2 = -d - bo;
    draw z@#1 -- z@#2;
    labels(@#1, @#2);
enddef;

vardef D_stem@# = left_stem@#(0,0) enddef;
vardef P_stem@# = left_stem@#(0,o) enddef;
vardef H_stem@# = left_stem@#(o,o) enddef;
%}}}
%{{{  Macros for symetrical characters:

boolean b;

def leftright  = if b: "left " else: "right " fi & enddef;
def lftrt = if b: lft else: rt fi enddef;
def rtlft = if b: rt else: lft fi enddef;
def topbot = if b: top else: bot fi enddef;
def bottop = if b: bot else: top fi enddef;
def lr = if b: l else: r fi enddef;
def rl = if b: r else: l fi enddef;
def hd = if b: h else: -d fi enddef;
def dh = if b: -d else: h fi enddef;
def minmax = if b: min else: max fi enddef;
def maxmin = if b: max else: min fi enddef;
def plus = if b: + else: - fi enddef;
def minus = if b: - else: + fi enddef;

pair ne, se; ne = (hratio, 1); se = (hratio, -1);
%}}}
%{{{  Marks

%  These have an anchor point and width and height
%  For marks that go above characters, anchor point is optical centre
%  of top of character.
%  For cedilla, it is bottom of character.
%  Width and height are of the mark itself

%{{{   cedilla

def cedilla_pen(expr w, h) = 
    begingroup
    	save ww, hh;
    	hh = min(pn.ht, 0.4h);
    	ww = min(pn.wd, 0.5w);
        pencircle xscaled ww yscaled hh
    endgroup
enddef;

vardef draw_cedilla@#(expr anchorx, anchory, wd, ht) =
    pickup cedilla_pen(wd, ht);
    top y1@# = vround anchory; bot y5@# = vround(anchory - ht);
    y3@# = 0.5[y1@#, y5@#]; x5@# = 0.66[x3@#, x6@#];
    anchorx = 1/2[x1@#, x3@#];
    lft x6@# + hround wd = rt x3@#;
    y6@# = y5@# + 1/2v#;
    x1@# = 1/2[x6@#, x3@#];
    draw z1@#{right} ... z3@#{down} ... z5@#{left} ... z6@#;
    labels(1@#, 2@#, 3@#, 4@#, 5@#, 6@#);
    pickup the_pen;
enddef;

%}}}   cedilla
%{{{   ring

% pdc Wed. 30 Oct. 1991
vardef draw_clear_ring@#(expr anchorx, anchory, wd_, ht_) =
    numeric wd, ht;
    %  will shrink ring slightly to make it circular:
    if (wd_ < ht_) and (wd_/ht_ > 0.9): 
    	ht = wd = wd_;
    elseif (ht_ < wd_) and (ht_/wd_ > 0.9):
    	wd = ht = ht_;
    else:
    	wd = wd_; ht = ht_;
    fi
    numeric ring.pn.ht, ring.pn.wd; 
    ring.pn.ht = vround max(1, min(1/3(ht), acc.pn.th));
    ring.pn.wd = hround max(1, min(1/3wd, acc.pn.th));
    pickup pencircle xscaled ring.pn.wd yscaled ring.pn.ht;
    top y1@# = vround (anchory + ht);
    bot y3@# = vround (anchory);
    lft x2@# = hround (anchorx - 1/2wd - eps);
    rt x4@#  = hround (anchorx + 1/2wd + eps);
    x1@# = x3@# = 1/2[x2@#, x4@#]; y2@# = y4@# = 1/2[y1@#, y3@#];
    draw superellipse(z4@#, z1@#, z2@#, z3@#, 
    	(max(0, weight - 1))[1/sqrt2, 0.8]);
    labels(1@#, 2@#, 3@#, 4@#);
    pickup the_pen;
enddef;


%  A ring that connects to the top of the character!
% pdc Fri.  1 Nov. 1991
vardef draw_joined_ring@#(expr anchorx, anchory, wd_, ht_) =
    numeric lap; lap = pn.ht - o;
    numeric wd, ht;
    %  will shrink ring slightly to make it circular:
    if (wd_ < ht_ )  and (wd_/(ht_ + lap) > 0.9): 
    	ht + lap = wd = wd_;
    elseif (ht_ < wd_) and (ht_/wd_ > 0.9):
    	wd = ht= ht_;
    else:
    	wd = wd_; ht = ht_;
    fi
    numeric ring.pn.ht, ring.pn.wd; 
    ring.pn.ht = vround max(1, min(1/3ht, acc.pn.th));
    ring.pn.wd = hround max(1, min(1/3wd, acc.pn.th));
    pickup pencircle xscaled ring.pn.wd yscaled ring.pn.ht;
    top y1@# = vround (anchory + ht - lap);
    bot y3@# = vround (anchory - lap);
    lft x2@# = hround (anchorx - 1/2wd - eps);
    rt x4@#  = hround (anchorx + 1/2wd + eps);
    x1@# = x3@# = 1/2[x2@#, x4@#]; y2@# = y4@# = 1/2[y1@#, y3@#];
    draw superellipse(z4@#, z1@#, z2@#, z3@#, 
    	(max(0, weight - 1))[1/sqrt2, 0.8]);
    labels(1@#, 2@#, 3@#, 4@#);
    pickup the_pen;
enddef;
%}}}   ring
%{{{   acute & grave

vardef draw_acute_grave@#(expr anchorx, anchory, wd_, ht_) expr grave =
    b := grave;  pickup mark_pn;
    rtlft x2@# = hround (anchorx plus 1/3wd_);
    lftrt x1@# = hround (rtlft x2@# minus wd_);
    x1'@# = x1@# plus (pn.wd - acc.pn.th);
    top y1@# = top y1'@# = anchory + ht_; 
    bot y2@# = anchory;
    draw z2@# -- z1@# -- z1'@# -- z2@#;
    labels(1@#, 1'@#, 2@#, 3@#)
enddef;

%}}}   acute
%{{{   dot & twodots

vardef draw_dot_mark@#(expr anchorx, anchory, wd, ht) =
    pickup pencircle xscaled dot_wd yscaled dot_ht;
    x@# = anchorx; 
    y@# = min(anchory + ht - 1/2dot_ht,
    	    max(anchory + 1/2ht, anchory + 1/2dot_wd));
    drawdot z@#;
    labels(@#);
enddef;

vardef draw_twodots@#(expr anchorx, anchory, wd, ht) =
    pickup pencircle xscaled dot_wd yscaled dot_ht;
    lft x1@# = hround (anchorx - 1/2(hround wd) - eps); 
    rt x2@# = hround (anchorx + 1/2(hround wd) + eps);
    y1@# = y2@# = min(anchory + ht - 1/2dot_ht,
    	    max(anchory + 1/2ht, anchory + 1/2dot_wd));
    drawdot z1@#; drawdot z2@#;
    labels(1@#, 2@#);
enddef;

%}}}   dot & twodots
%{{{   circumflex

vardef draw_circumflex@#(expr anchorx, anchory, width, height) expr inverted_p =
    b := inverted_p;
    pickup mark_pn;
    lft x1@# = hround (anchorx - 1/2width - eps);  % |-eps| is for symmetry
    rt x3@# = good.x (anchorx + 1/2width); 
    x2@# = x2'@# = 1/2[x1@#,x3@#];
    topbot y1@# = topbot y3@# 
    	= vround (if inverted_p: anchory + height else: anchory fi); 
    bottop y2@# = bottop y2'@# minus pn.wd plus acc.pn.th 
	= vround (if inverted_p: anchory else: anchory + height fi);
    %  Now for some digitization hacks:
    numeric rat; rat :=  (x2@# - x1@#) / (y2@# - y1@#);
    if not inverted_p and (rat > 1):
    	y1@# := y3@# := 
    	    max(top anchory - 1/2v, y2@# - (x2@# - x1@#)); 
    elseif inverted_p and (rat < 1):
    	y2@# := max(top anchory - 1/2v, y1@# - (x2@# - x1@#)); 
    	y2'@# := y2@# + pn.wd - acc.pn.th;
    fi
    draw z1@# -- z2@# -- z3@#;  %%%% -- z2'@# -- z1@#
    labels(1@#,2@#,2'@#,3@#);
enddef;

%}}}
%{{{   tilde

%  This glyph is rather simpler than the original in  mamarks.mf.

vardef draw_tilde@#(expr anchorx, anchory, width, height) =
    pickup mark_pn;
    lft x1@# = hround (anchorx - 1/2width - eps); 
    rt x5@# = hround (anchorx + 1/2width);
    z3@# = (1/2[x1@#, x5@#], 1/2height + anchory);
    x2@# = 1/2[x1@#,x3@#]; x4@# = 1/2[x3@#,x5@#];
    top y2@# = anchory + height; bot y4@# = anchory;
    bot y1@# = anchory + 1/4height - o;
    top y5@# = anchory + 3/4height + o;
    draw z1@# ... z2@#{right} ... z3@# ... z4@#{right} ... z5@#;
    labels(1@#, 2@#, 3@#, 4@#, 5@#);
enddef;

%}}}   tilde
%{{{   breve

vardef draw_breve@#(expr anchorx, anchory, width, height) =
    pickup mark_pn;
    top y1@# = top y3@# = anchory + height;
    bot y2@# = anchory;
    lft x1@# = hround (anchorx - 1/2width);
    rt  x3@# = hround (anchorx + 1/2width);
    x2@# = 1/2[x1@#, x3@#];
    draw z1@#{down} ... z2@# ... z3@#{up};
    labels(1@#, 2@#, 3@#);
enddef;

%}}}   breve
%{{{   variant hacek -- for d and t
%  resembles an apostrophe stuck onto the right hand side of letter
%  corresponds to the inverted circumflex mark on c, e, n, r, s, z

vardef draw_hook@# =
    top z1a@# = (r - 0.55hook_wd, asc_ht);
    top z1@# = (r - hook_wd, asc_ht - 1/4v);
    rt x2@# = r;  y2@# = 0.77[y3@#, y1@#];
    bot lft z3@# = (min(r - hook_wd + 1/2u, lft x2@#), x_ht);
    draw z1@# ... z1a@#{right} ... z2@#{down} ... z3@#;
    labels(1@#, 2@#, 3@#);
enddef;

%}}}   variant hacek
%{{{   macron

vardef draw_macron@#(expr anchorx, anchory, wd, ht) =
    pickup mark_pn;
    1/2[x@#1, x@#2] = good.x anchorx; y@#1 = y@#2 = good.y anchory + 1/2ht;
    lft x@#1 = hround (good.x anchorx - 1/2wd);
    draw z@#1 -- z@#2;
    labels(@#1, @#2);
enddef;

%}}}   amcron
%}}}  Marks
%{{{  Macros for letters that are same in caps as l.c.
%{{{   slash for O and o

def draw_O_slash =
    x1slash = good.x (1/12[l,r] - eps);
    y1slash = good.y (1/12[0,h] - eps);
    z2slash = z1slash + whatever*(hratio,1);
    y2slash = h - y1slash;
    draw z1slash -- z2slash;
    labels(1slash, 2slash);
enddef;

%}}}
%{{{   V

def draw_V =
    if 1/2w <> hround 1/2w: change_width; fi
    top lft z1 = (l, h + o); top rt z3 = (r, h + o);
    bot z2 = (1/2w, -d); 
    draw z1 -- vpex_path2 -- z3;
    labels(1, 2, 3);
enddef;

%}}}   V
%{{{   X
def draw_X expr magic =
    lft x1 = w - rt x3 = magic[l, r]; top y1 = top y3 = h + o;
    rt x2 = w - lft x4 = r; bot y2 = bot y4 = -d -o;
    draw z1 -- z2; draw z3 -- z4;
    labels(1,2,3,4)
enddef;
%}}}   X
%{{{   Y, yen

def draw_Y(expr ytwo) =
    if 1/2w <> good.x 1/2w: change_width; fi
    lft x1 = w - rt x3 = l; top y1 = top y3 = h + o;
    x2 = x4 = 1/2[x1,x3]; bot y4 = -d -o;
    y2 = ytwo; 
    draw z1 -- apex_path2 -- z3; draw z2 -- z4;
    labels(1,2,3,4);
enddef;

%}}}
%{{{   C

% become ovals when compressed -- pdc Fri.  3 May 1991

vardef draw_C@#(expr leftx, topy, rightx,  boty) expr curl =
    lft x3@# = leftx; y3@# = 1/2[boty, topy];
    rt x1@# = rt x5@# = rightx; 
    z2@# = z3@# + whatever*(hratio,1); top y2@# = topy + o;
    z4@# = z3@# + whatever*(hratio,-1); bot y4@# = boty - o;
    % round form:
    %  The top edge curls is an arc with centre z4@#
    save deltay, deltax;
    deltax = lft rightx - x4@#;
    deltay = (y2@# - y4@#) +-+ deltax;
    z1@# = z4@# + whatever*(deltax, deltay);
    z5@# = z2@# + whatever*(deltax, -deltay);
    %% top y1@# = topy + boty - bot y5@# = good.y curl[topy,boty];
    draw z1@#{(-deltay, deltax)}
	.. z2@#{left} .. z3@#{down} .. z4@#{right} .. 
	{(deltay, deltax)}z5@#;
    labels(1@#,2@#,3@#,4@#,5@#);
enddef;
%}}}
%{{{   S

def draw_S(expr topy, boty)(expr magic, top_magic, bot_magic) =
    x2 = x4 = x6;
    top y2 = topy + o; bot y6 = boty - o; 
    lft x3 = w - rt x1 
	= if r - l > 15: hround (1/20[l,r] - eps) else: l fi; 
    lft x7 = w - rt x5 = l; 
    y3 = 1/2[y2,y4]; y5 = 1/2[y4,y6]; 
    y4 = good.y (magic[boty, topy] + eps);
    top y1 = top_magic[topy, boty]; 
    bot y7 = bot_magic[boty, topy];
    z4 = whatever[z3, z5];
    draw  z1 ... hvarc(2,3) .. z4 .. vharc(5,6) ... z7;
    labels(range 1 thru 7);
enddef;

%}}}
%}}}
%{{{  cap kit
%{{{   cap codes

numeric capmode; capmode := 1; % 1 for LC, 2 for MC, 3 for SC
vardef capcode@# =
    if capmode = 1: code.cap@#
    elseif capmode = 2: code.mc@#
    else: code.sc@#
    fi
enddef;

%}}}   cap codes
%{{{   set_cap_widths

def set_cap_widths =
    if unknown height#: height# := cap_ht#; fi
    width# := height# * hratio;
    % narrow etc. s.cap letters will be proportionately wider:
	narrow_wd# := 1/2[0.6width#,  6u#];
	medium_wd# := 1/3[0.7width#,  8u#];
	wide_wd#   := 1/4[0.8width#, 10u#];
    % define these as pixels for making ligature chars: 
	define_pixels(width, narrow_wd, medium_wd, wide_wd);
    % adjustment for width of pen for some letters:
	pn_adj# := 1/2(pn_wd# - 1/12width#);
    % width and spacing of capital O:
	O_wd# := width# + cap.pn.wd# - cap.pn.ht#;
	O_sp := 1/2;
    % size of marks:
    	mark_b# := min(body_ht#, height# + 0.75v#);
    	mark_t# := min(mark_b# + 2.5v#, body_ht# + 1.25v#);
    	define_whole_vertical_pixels(mark_t, mark_b);
        mark_ht := mark_t - mark_b;
enddef;

%}}}   set_cap_widths
%{{{   A/Delta/Lambda

%  Draw a letter A -- sets IC, changes width to make symmetrical etc.
%  apex is z@#2, feet are z@#1 and z@#3
%  barp and boolp are booleans

vardef A_body@#(expr barp, basep) = 
    if 1/2w <> apex.x 1/2w: change_width; fi
    lft x1@# = w - rt x3@# = l; 
    bot y1@# = bot y3@# = 0 if not basep: - o fi;
    top z2@# = (1/2w, h); 
    draw z1@# -- apex_path2@# -- z3@# if basep: -- cycle fi;
    if barp:
    	lft z1@#bar = whatever[z1@#, z2@#]; rt z2@#bar = whatever[z3@#, z2@#];
        y1@#bar = y2@#bar = good.y ((1 - golden_ratio) * h);
        draw z1@#bar -- z2@#bar;
    	labels(1@#bar, 2@#bar);
    fi
    labels(1@#, 2@#, 3@#); 
    set_ic 0v#;
enddef;

%}}}
%{{{   EFL

def do_EFL(expr code, tb_p, mbl, mb, bb_p) =
    ma_cap(code, narrow_wd# + pn_adj#)(1, 1/2);
    	box_points;
    	draw (x.l, y.t) -- (x.l, y.b);
    	if tb_p: draw_box_t; set_ic_tr; else: set_ic 0v#; fi
    	if mb > 0: draw (mbl[x.l,x.r], y.m) -- (mb[x.l,x.r], y.m); fi
    	if bb_p: draw_box_b; fi
    endchar
enddef;

%}}}   EFL
%{{{   O

def draw_O =
    draw_circle(l - ho, h + oo, r + ho, - oo)
enddef;
%}}}   O
%{{{   how to draw the bowl of a D or P

vardef D_bowl@#(expr topy, boty, rightx) suffix $ =	  % $ is a [DP]_stem
    x1@# = x5@# = x$1;  x2@# = x4@#;
    top y1@# = top y2@# = topy; bot y4@# = bot y5@# = boty;
    y3@# = 1/2[y1@#, y5@#]; rt x3@# = rightx;
    z2@# = z3@# + whatever*(min(1, hratio),-1);
    draw z1@# --- z2@# .. z3@# .. z4@# --- z5@#;
    labels(1@#,2@#,3@#,4@#,5@#);
enddef;

%}}}
%{{{   cap marks

def some_cap_marks(expr nicex) suffix @ =
if not no_co:
    similarly(capcode@acute); str @ & " acute";
	charht := mark_t#;
	draw_acute_grave.acute(nicex, mark_b, acute_wd, mark_ht) false;
    wug;
    similarly(capcode@grave); str @ & " grave";
	charht := mark_t#;
	draw_acute_grave.grave(nicex, mark_b, acute_wd, mark_ht) true;
    wug;
    similarly(capcode@twodots); "Capital " & str @ & " two-dots";
	charht := mark_t#;
	draw_twodots.twodots(nicex, mark_b, acute_wd + dot_wd, mark_ht);
    wug;
    similarly(capcode@circumflex); "Capital " & str @ & " circumflex";
	charht := mark_t#;
	draw_circumflex.circumflex(nicex, mark_b, 
    	    	    	    	    max(acute_wd, 2mark_ht * hratio - pn.wd), 
    	    mark_ht) false;
    wug;
    similarly(capcode@tilde); "Capital " & str @ & " tilde";
	charht := mark_t#;
	draw_tilde.tilde(nicex, mark_b, 
    	    max(acute_wd, 2mark_ht * hratio - pn.wd), mark_ht);
    wug;
    similarly(capcode@breve); "Capital " & str @ & " breve";
	charht := mark_t#;
	draw_breve.breve(nicex, mark_b, 
    	    max(acute_wd, 2mark_ht * hratio - pn.wd), mark_ht);
    wug;
    similarly(capcode@hook); "Capital " & str @ & " hook";
	charht := mark_t#;
	draw_circumflex.hook(nicex, mark_b, 
	    max(acute_wd, 2mark_ht * hratio - pn.wd), mark_ht) true;
    wug;
fi
enddef;

%}}}   cap marks
%}}}  cap kit
%{{{  l.c. kit
%{{{   how to draw b bowl

b_wd# := if italic: 1/2pn.wd# + 5.75u# else: 1/2pn.wd# + 6.5u# fi;

let {{ = if; let }} = fi; let | = elseif; 
if italic:
    vardef draw_b_bowl@#(expr l, by, r, h, bl,  x_ht) expr left_p =
	b := left_p;
	{{b: lft else: rt}} x@#1stem = 
    	{{b: lft else: rt}} x@#2stem = 
    	{{b: lft else: rt}} x@#1bowl = 
    	{{b: lft else: rt}} x@#5bowl = {{b: l else: r}};
	{{b: rt else: lft}} x@#3bowl = {{b: r else: l}};
	top y@#1stem = {{b: h + o else: h }}; 
    	bot y@#2stem = {{b: by else: by - o}};
    
	if b: 
	    x@#2bowl = 0.7[x@#1bowl,x@#3bowl]; 
    	    x@#4bowl = 0.45[x@#1bowl,x@#3bowl];
    	    top y@#2bowl = x_ht + o; bot y@#4bowl = bl; 
	    bot y@#5bowl = bl; top y@#1bowl = 5/8[bot bl, x_ht];
	else:
	    x@#4bowl = 0.7[x@#1bowl,x@#3bowl]; 
    	    x@#2bowl = 0.45[x@#1bowl,x@#3bowl];
    	    top y@#2bowl = x_ht; bot y@#4bowl = bl - o; 
	    bot y@#5bowl = 3/8[bl, x_ht]; top y@#1bowl = x_ht;
	fi    
    	y@#3bowl = 1/2[y@#2bowl, y@#4bowl];
	draw z@#1bowl if b: {(z@#2bowl - z@#1bowl) yscaled 2} fi 
	    ... z@#2bowl{plus right} .. z@#3bowl .. z@#4bowl{plus left}
	    ... if not b: {(z@#5bowl - z@#4bowl) yscaled 2} fi z@#5bowl;
	labels(@#1bowl, @#2bowl, @#3bowl, @#4bowl, @#5bowl, @#1stem, @#2stem);
    enddef;
else:
    vardef draw_b_bowl@#(expr l, by, r, h, bl, x_ht) expr left_p =
	b := left_p;
	{{b: lft else: rt}} x@#1stem = 
    	{{b: lft else: rt}} x@#2stem = 
    	{{b: lft else: rt}} x@#1bowl = 
    	{{b: lft else: rt}} x@#5bowl = {{b: l else: r}};
	{{b: rt else: lft}} x@#3bowl = {{b: r else: l}};
	top y@#1stem = h + o; bot y@#2stem = by - o;
    	x@#2bowl = x@#4bowl = 0.45[x@#1bowl, x@#3bowl];
	top y@#2bowl = x_ht + o; bot y@#4bowl = bl - o; 
    	y@#3bowl = 1/2[y@#2bowl, y@#4bowl];
	bot y@#5bowl = 1/16[bl, x_ht]; top y@#1bowl = 15/16[bl, x_ht];
	draw z@#1bowl  
	    ... z@#2bowl{plus right} .. z@#3bowl .. z@#4bowl{plus left}
	    ... z@#5bowl;
	labels(@#1bowl, @#2bowl, @#3bowl, @#4bowl, @#5bowl, @#1stem, @#2stem);
    enddef;
fi

vardef draw_b@#(expr l, by, r, h, bl, x_ht) expr left_p = 
    draw_b_bowl(l, by, r, h, bl, x_ht) left_p;
    draw if italic or (h > x_ht): z@#1stem else: z@#1bowl fi
    	-- if italic or (by < bl): z@#2stem else: z@#5bowl fi;
enddef;

%}}}    
%{{{   How to draw tail of g or y

vardef draw_tail@# = % attaches to @#
    x1tail = x@#; lft x3tail = 0.85[r,l];
    bot y2tail = -d - o; x2tail = 0.55[x1tail, x3tail];
    z1tail = z2tail + whatever*(hratio,1);
    y3tail = good.y (y2tail + 1/2v);
    draw z@# --- z1tail .. z2tail{left} .. z3tail;
    labels(1tail, 2tail, 3tail)
enddef;

%}}}
%{{{   how to draw the arch on an `n'

n_wd# := 1/2pn.wd# + 6u#; 
n_dip := if italic: 5v else: 1v fi;
define_pixels(n_wd);

vardef draw_n_arch@#(expr leftrightx, rightleftx) =
    b := leftrightx < rightleftx;
    if b: 
    	top y1@# = x_ht - n_dip;
    	top y2@# = x_ht + o; bot y4@# = -o;
    else:
    	bot y1@# = n_dip;
    	bot y2@# = -o; top y4@# = x_ht + o;
    fi
    lftrt x1@# = hround leftrightx; 
    rtlft x3@# = rtlft x4@# = rightleftx;    
    x2@# = if italic: 0.3 else: 0.45 fi[x3@#, x1@#]; 
    z3@# = z2@# + whatever*se if italic: yscaled 2 fi;
    draw z1@#{(z2@# - z1@#) yscaled 2}
    	.. z2@#{(x3@# - x1@#, 0)} .. z3@# --- z4@#;
    labels(1@#,2@#,3@#,4@#);
enddef;

def set_ic_n = set_ic(0.75x_ht#) enddef;
%}}}
%{{{   how to draw an `f'

f_bar_left# := 1u#; f_wd# := f_bar_left# + 5u#;
f_dp# := if italic: 3/4desc_dp# else: 0v# fi;

f_join# := f_rsp*sp# + sp#;
 %  First two terms give where an "i" would go relative to rt of "f".
fi_kern# := -1/4u#;

define_pixels(f_bar_left, f_join, f_wd, fi_kern);

def f_char(expr code, w_sharp) =
    lctitle code; ma_char(code, w_sharp, asc_ht#, f_dp#) 
enddef;

% leftx is left of main stroke
vardef draw_f@#(expr leftx, kernamount) expr join_p = 
    top y@#2 = h + o; bot y@#4 = -d - o;
    lft x@#3 = lft x@#4 = hround leftx;
    if join_p:  % Why is this bit causing me so much hassle?
    	lft x@#1 = (leftx + (f_wd - f_bar_left)) + f_join + kernamount;
    	%  |lft x@#1| is where left edge of "i" following "f" would go
    else:
    	rt x@#1 = leftx + (f_wd - f_bar_left);
        %  |rt x@#1| is |f_wd| from left end of the bar
    fi
    y@#1 = good.y (h - 1v); y@#3 = h - 3v; 
    z@#2 = z@#3 + whatever*ne;
    draw z@#1 .. z@#2 .. z@#3 --- z@#4;
    labels(@#1, @#2, @#3, @#4);
enddef;

vardef draw_f_bar@# expr join_p =
    top y1bar = top y2bar = x_ht;
    lft x1bar = l; x2bar = good.x x@#2;  %%%% if join_p: x@#1 else: x@#2 fi;
    draw z1bar -- z2bar;
    labels(1bar,2bar);
enddef;
%}}}    
%{{{   how to draw an "i" (!)

def draw_i = 
    if 1/2w <> good.x 1/2w: change_width; fi
    top z1 = (1/2w, x_ht + o); bot z2 = (1/2w, -d - o);
    draw z1 -- z2; labels(1, 2); set_ic_tr;
enddef;

%}}}   how to draw an "i" (!)
%{{{   generate lc letter with composites (new conventions)

%  There must be a vardef macro draw_lc@# that draws the base letter.
%  It takes 6 parameters: leftx, boty, rightx, topy, baseline, x-ht.
%  It must set variable x.anchor to x-coordinate of anchor for marks.

vardef lc_with_composites@#(expr w_sharp, h_sharp, d_sharp, l_sp, r_sp) =
    iff known code.lc@#:
    ma_char(code.lc@#, w_sharp, h_sharp, d_sharp, l_sp, r_sp)
	"lower case " & str @#;
	draw_lc@#(l, -d, r, h, 0, x_ht);
    endchar;
    lc_composites_only@#(w_sharp, h_sharp, d_sharp, l_sp, r_sp)
enddef;

vardef lc_composites_only@#(expr w_sharp, h_sharp, d_sharp, l_sp, r_sp) =
    mh# := max(d_sharp, lc_mark_t#);		  % height of glyph with mark
    hh := vround(h_sharp * hppp);		  % height of base glyph
    iff known code.lc@#acute: 
    ma_char(code.lc@#acute, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " acute";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_acute_grave.acute(x.anchor, lc_mark_b, acute_wd, 
    	    lc_mark_ht) false;
    endchar;
    iff known code.lc@#grave:
    ma_char(code.lc@#grave, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " grave";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_acute_grave.grave(x.anchor, lc_mark_b, acute_wd, 
	    lc_mark_ht) true;
    endchar;
    iff known code.lc@#twodots:
    ma_char(code.lc@#twodots, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " two-dots";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_twodots.twodots(x.anchor, lc_mark_b, acute_wd + dot_wd, 
	    lc_mark_ht);
    endchar;
    iff known code.lc@#circumflex:
    ma_char(code.lc@#circumflex, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " circumflex";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_circumflex.circumflex(x.anchor, lc_mark_b, 
	    2lc_mark_ht * hratio - pn.wd, lc_mark_ht) false;
    endchar;
    iff known code.lc@#tilde:
    ma_char(code.lc@#tilde, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " tilde";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_tilde.tilde(x.anchor, lc_mark_b, 
	    2lc_mark_ht * hratio - pn.wd, lc_mark_ht);
    endchar;
    iff known code.lc@#breve:
    ma_char(code.lc@#breve, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " breve";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_breve.breve(x.anchor, lc_mark_b, 
	    2lc_mark_ht * hratio - pn.wd, lc_mark_ht);
    endchar;
    iff known code.lc@#hook:
    ma_char(code.lc@#hook, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " inverted circumflex";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_circumflex.hook(x.anchor, lc_mark_b, 
	    2lc_mark_ht * hratio - pn.wd, lc_mark_ht) true;
    endchar;
    iff known code.lc@#dot:
    ma_char(code.lc@#dot, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " inverted circumflex";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_dot_mark.dot(x.anchor, lc_mark_b, 0, lc_mark_ht);
    endchar;
    iff known code.lc@#macron:
    ma_char(code.lc@#macron, w_sharp, mh#, d_sharp, l_sp, r_sp); 
	"lower case " & str @# & " inverted circumflex";
    	draw_lc@#(l, -d, r, hh, 0, x_ht);
	draw_macron.macron(x.anchor, lc_mark_b, 0.8 * (r - l), lc_mark_ht);
    endchar;
enddef;

%}}}   generate lc letter with composites (new conventions)
%}}}  l.c. kit
%{{{  kit for lower case Greek

%  Draw an acute or grave mark.
%  Set its position with some equation mentioning x1@# or x2@#
%  before using this macro.
vardef gr_draw_ag@# expr b =
    top y1@# = gr_mk_top; bot y2@# = gr_mk_bot;
    z1@# - z2@# = whatever * if b: ne else: se fi yscaled 2;
    draw z1@# -- z2@#;
enddef;

vardef gr_draw_twodots@#(expr width, boty) =
    x1@# = 1/2dot_wd + hround (1/2w - 1/2width - 1/2dot_wd);
    x2@# = 1/2dot_wd + hround (1/2w + 1/2width - 1/2dot_wd);
    y2@# = y1@# = 1/2dot_ht + boty;
    draw_dot1@#; draw_dot 2@#;
    labels(1@#, 2@#);
enddef;

vardef gr_breathing@#(expr leftx, topy, rightx, boty) expr b_ =
    b := b_;
    top y1@# = topy;  bot y3@# = boty;
    y2@# = 0.6[y3@#, y1@#];
    lftrt x1@# = if b: leftx else: rightx fi; 
    rtlft x2@# = hround if b: rightx else: leftx fi;
    x3@# = 0.75[x1@#, x2@#];
    draw z1@#{ (x2@# - x1@#, 0) } .. z2@#{down} .. z3@#;
    labels(1@#, 2@#, 3@#);
enddef;

vardef gr_circ@#(expr leftx, boty, rightx, topy) =
    lft x1@# = hround leftx; rt x3@# = hround rightx; 
    top y2@# = vround topy; bot y1@# = bot y3@# = vround boty;
    x2@# = 1/2[x1@#, x3@#];
    draw z1@#{up} .. z2@# .. z3@#{down};
    labels(1@#, 2@#, 3@#);
enddef;

vardef gr_tilde@#(expr leftx, boty, rightx, topy) =
    lft x1@# = hround leftx; rt x4@# = hround rightx;
    top y2@# = vround topy; bot y3@# = vround boty; 
    x2@# = 0.3[x1@#, x4@#]; x4@# - x3@# = x2@# - x1@#;
    y1@# = 0.15[y3@#, y2@#]; y4@# - y3@# = y2@# - y1@#;
    draw z1@# .. z2@#{right} .. z3@#{right} .. z4@#;
    labels(1@#, 2@#, 3@#, 4@#);
enddef;

%  Add iota subscript to letter.  Note this alters chardp!
vardef gr_iota_sub@#(expr anchorx) =
    chardp := desc_dp#;
    x1@# = x2@# = good.x anchorx;
    top y1@# = -1/2v;
    bot y2@# = -hround desc_dp - o;
    draw z1@# -- z2@#;
    labels(1@#, 2@#)
enddef;

%}\}}  kit for lower case Greek
%}}} makit.mf

%Local variables:
%fold-folded-p: t
%End: