%% This file is public domain.
%% Originally written 1990, Alan Hoenig.
%% Notice added by Clea F. Rees 2010/12/13 following correspondence between Alan Hoenig and Karl Berry.

% This is DTITLE.MF, adapted from Knuths title.mf (Jan 8, 1990).
% This makes a short font (caps only)
 
% This file also contains special macros universally needed in the durer font
%  but not in CM.BAS.
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  MACRO SECTION %%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def formal=not informal enddef;
 
vardef antiserif(suffix $,$$,@)(expr darkness, jut) suffix modifier=
 % erases a serif-like region at |z_$| from |z_{$$}|
pickup crisp.nib; pair downward; downward=z$-z$$;
y@2=jut; x@1=lft x$l+jut; top y@1=bot y$;
z@2-penoffset downward of currentpen=
 z$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
erase filldraw z@2{downward}...darkness[(x@2,y@1), .5[z@2,z@1]]{z@1-z@2}
 ...{right}z@1--(x@1,y@1-eps)--origin--(x@2-eps,y@2)--z@2&cycle;
labels(@1, @2); enddef;
 
 
let cm_arm=arm;
 
vardef arm(suffix $,$$,@)(expr darkness, armjut) =  % arm from |z$| to |z$$|
numeric vjut_; vjut_= abs(bot y$l-bot y$$);
x@0=good.x(x$$r-armjut); y@0=y$r;
 if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
   if x$$>=x$: x@2=x@1 - vjut_; else: x@2=x@1+vjut_; fi y@2=y$l;
  filldraw z$$l{z@1-z$$l}...darkness[z@1,.5[z@2,z$$l]]{z@2-z$$l}...
  z@2if x$$>=x$: {left} else: {right} fi
   ---z$l--z$r--z@0--z$$r..cycle; % arm and beak
 else: filldraw z$l--z$r--z@0--z$$r--cycle; fi  % sans-serif arm
 penlabels(@0,@1,@2); enddef;
 
vardef foot(suffix $, $$, @)(expr darkness, armjut) = % curved beak on E and L
numeric vjut_; vjut_= abs(bot y$-bot y$$);
x@0=good.x(x$$r-armjut); y@0=y$r;
if x@0>w-.5u: x@0:=w-.5u; fi
 if serifs: y@1=y$l; z@1=z$$l+whatever*(z$$r-z@0);
   x@2=x@1-vjut_; y@2=y$l;
  filldraw z$$l{z@1-z$$l}...darkness[z@1,.5[z@2,z$$l] ]...z@2
   ---z$l--z$r--z@0..tension1.2..{up}z$$r..cycle; % arm and beak
 else: filldraw z$l--z$r--(x$$r,y$r)--(x$$r,y$l)--cycle; fi
 penlabels(@0,@1,@2); enddef;
 
vardef flourish(suffix from, at, to, @) % flourish for top of `A'
  (expr darkness)=
 pickup pencircle scaled 0pt; % use this after all serifs have been drawn
 pair downward; pair upward;
 upward=z.at.l-z.from.l; downward=z.to.r-z.at.r;
 top y@1=top y.at; x@1=.5[x.from,x.at];
   % leftmost point of flourish
 numeric alpha[]; alpha1=angle(upward); 
 y@2=vround(top y.at-bracket/sind alpha1 ); lft z@2=whatever[z.at.l,z.from.l];
  % |z@2| lies on the `from' limb and marks the beginning of the flourish 
 x@1'=x@1; y@1'=y@1-.8min(tiny,thin); % point to give end of flourish some thickness
 top y@3=y.at; z@3=whatever[z@2,z.at.l]; % |z@3| is like Knuth's `corner' point 
 filldraw z@2{upward}...darkness[.5[z@1',z@2],z@3]{z@1'-z@2}
  ...z@1'{left}..{right}z@1--lft z.at.r--z@2..cycle; 
 labels(@1,@2,@3); enddef;
 
vardef pulled_super_arc.l(suffix $, $$)(expr darkness)=
 pair corner;
 if y$=y$r: corner=(x$l, y$$l);
 else: corner=(x$$l,y$l); fi
 z$l{corner-z$l}...(darkness)[corner, .5[z$l, z$$l]]{z$$l-z$l}
 ...{z$$l-corner}z$$l enddef;
 
vardef pulled_super_arc.r(suffix $, $$)(expr darkness)=
 pair corner;
 if y$=y$r: corner=(x$r,y$$r);
 else: corner=(x$$r, y$r); fi
 z$r{corner-z$r}...(darkness)[corner, .5[z$r, z$$r]]{z$$r-z$r}
 ...z$$r{z$$r-corner} enddef;
 
vardef pulled_arc@#(suffix $, $$)=
 pulled_super_arc@#($,$$)(eta) enddef;
 
let cm_font_setup=font_setup; % Knuth's original font_setup
 
def slim_font_setup = % trimmed font_setup for use with Durer caps only
 if monospace: let adjust_fit=mono_adjust_fit;
  def mfudged=fudged enddef;
  mono_charic#:=body_height#*slant;
  if mono_charic#<0: mono_charic#:=0; fi
  mono_charwd#:=9u#; define_whole_pixels(mono_charwd);
 else: let adjust_fit=normal_adjust_fit;
  def mfudged= enddef; fi
 define_pixels(u,width_adj,serif_fit,cap_serif_fit,jut,cap_jut,bar_height,
  dish,bracket,beak_jut,apex_o,apex_corr); 
 define_whole_pixels(letter_fit,fine,crisp,tiny);
 define_whole_vertical_pixels(body_height,asc_height,
  cap_height,x_height,comma_depth,desc_depth);
 define_whole_blacker_pixels(hair,stem,cap_stem);
 define_whole_vertical_blacker_pixels(vair,dslab,slab);
if slab<eps: slab:=eps fi;
 define_corrected_pixels(o);
 forsuffixes $=hair,stem,cap_stem:
  fudged$.#:=fudge*$.#; fudged$:=hround(fudged$.#*hppp+blacker);
  forever: exitif fudged$>.9fudge*$; fudged$:=fudged$+1; endfor endfor
 rule_thickness:=ceiling(rule_thickness#*hppp);
 heavy_rule_thickness:=ceiling(3rule_thickness#*hppp);
 oo:=vround(.5o#*hppp*o_correction)+eps;
 apex_oo:=vround(.5apex_o#*hppp*o_correction)+eps;
 lowres_fix(stem) 1.3;
 ess:=(ess#/stem#)*stem; cap_ess:=(cap_ess#/cap_stem#)*cap_stem;
 dw:=(curve#-stem#)*hppp; bold:=curve#*hppp+blacker;
 dh#:=.6designsize;
 more_super:=max(superness,sqrt .77superness);
 hein_super:=max(superness,sqrt .81225258superness); % that's $2^{-.3}$
 clear_pen_memory;
 if fine=0: fine:=1; fi
 forsuffixes $=fine,crisp,tiny:
%%% fine $ %%%% temporary formatting convention for MFT
  if $>fudged.hair: $:=fudged.hair; fi
  $.breadth:=$;
  pickup if $=0: nullpen else: pencircle scaled $; $:=$-eps fi;
  $.nib:=savepen; breadth_[$.nib]:=$;
  forsuffixes $$=lft,rt,top,bot: shiftdef($.$$,$$ 0); endfor endfor
%%% @ $ %%%% restore ordinary formatting for $
 min_Vround:=max(fine.breadth,crisp.breadth,tiny.breadth);
 if min_Vround<vround min_Vround: min_Vround:=vround min_Vround; fi
 pickup pencircle scaled rule_thickness; rule.nib:=savepen;
 currenttransform:=identity slanted slant
  yscaled aspect_ratio scaled granularity;
 if currenttransform=identity: let t_=relax
 else: def t_ = transformed currenttransform enddef fi;
 numeric paren_depth#; .5[body_height#,-paren_depth#]=math_axis#;
 numeric asc_depth#; .5[asc_height#,-asc_depth#]=math_axis#;
 body_depth:=desc_depth+body_height-asc_height;
 shrink_fit:=1+hround(2letter_fit#*hppp)-2letter_fit;
 if not string mode: if mode<=smoke: shrink_fit:=0; fi fi
 enddef;
 
def durer_font_setup= % contains special stuff for Durer fonts
define_pixels(side,thick,thin);  
if not known dslab#: dslab=eps; fi
enddef;
 
vardef T_flourish(suffix at,from,aux)(expr top_dark, bot_dark)=
 pickup tiny.nib; pair xeps_,yeps_; yeps_=(0,eps);
 numeric stroke_angle_; stroke_angle_=angle(z.at.r-z.at.l);
 numeric slab'; slab'=.6slab;
 pos.at'(alpha*thin+alpha*cap_jut,stroke_angle_); z.at'=z.at;
 if x.at<x.from: xeps_=(eps,0);% left flourish
  rt x.aux2-lft x.at'r=alpha*slab';
  x.aux1=x.at.r+bracket+slab';    
  else: xeps_=(-eps,0); % right flourish
  rt x.at'r-lft x.aux2=alpha*slab';
  x.aux1=x.at.r-bracket-slab'; fi
y.aux1=y.at.r; y.aux4=y.at.l; z.aux1-z.aux4=whatever*(z.at.r-z.at.l); 
y.aux2=y.at'r; y.aux3=y.at'l; z.aux2-z.aux3=whatever*(z.at.r-z.at.l); 
if top_dark>=0: z.aux0 =whatever[z.at.r,z.aux1]=whatever[z.aux2,z.aux3];
 filldraw z.aux1{z.at.r-z.aux1}..
 top_dark[z.aux0 ,.5[z.aux1,z.aux2]]..
 if not monospace:{z.at'r-z.at}z.aux2--
 else: {z.at'r-z.at}(z.at'r+xeps_).. fi
 z.at'r--2/3[z.at.r,z.at.l]--2/3[z.aux1,z.aux4]--cycle; fi
if bot_dark>=0: z.aux0'=whatever[z.at.l,z.aux4]=whatever[z.aux2,z.aux3];
 filldraw z.aux4{z.at.l-z.aux4}..
 bot_dark[z.aux0',.5[z.aux4,z.aux3]]..
 if not monospace:{z.at'l-z.at}z.aux3--
 else: {z.at'l-z.at}(z.at'l+xeps_).. fi
 z.at'l--2/3[z.at.l,z.at.r]--2/3[z.aux4,z.aux1]--cycle; fi
penlabels(aux1, aux2,aux3,aux4);
enddef;
 
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%%  END OF MACROS %%%%%%%%%%%%%%%%%%%%%%%%%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
 
font_coding_scheme:="ASCII caps and digits";
 
mode_setup; 
 
durer_font_setup;
if whole_font: font_setup; %slab:=eps;  
 define_whole_vertical_blacker_pixels(dslab,slab);
 else: slim_font_setup; fi
 
if informal: input dromani; % Durer upper case---informal style
 else: input dromanu; fi % Durer upper case (majuscules)
 
if whole_font: 
 input dromanl; 
 input dromand; 
 fi 
 
font_slant slant; font_x_height x_height#;
if monospace: font_normal_space 9u#; % no stretching or shrinking
 font_quad 18u#;
 font_extra_space 9u#;
else: font_normal_space 6u#+2letter_fit#;
 font_normal_stretch 3u#; font_normal_shrink 2u#;
 font_quad 18u#+4letter_fit#;
 font_extra_space 2u#;
 k#:=-.5u#; kk#:=-1.5u#; kkk#:=-2u#; % three degrees of kerning
 ligtable "P": "T": "Y": "A" kern kk#;
 ligtable "F": "V": "W": "A" kern if serifs: kkk# else: kk#fi,
  "K": "X": "O" kern k#, "C" kern k#, "G" kern k#, "Q" kern k#;
 ligtable "O": "D": "X" kern k#, "W" kern k#, "A" kern k#,
   "V" kern k#, "Y" kern k#;
 ligtable "A": if serifs: "R": fi
  "C" kern k#, "O" kern k#, "G" kern k#, "U" kern k#, "Q" kern k#,
  "L": "T" kern kk#, "Y" kern kkk#, "V" kern kk#, "W" kern kkk#;
ligtable "I": "I" kern -k#; fi % Richard III
 
bye.
 
 ligtable "k": if serifs: "v": "a" kern -u#, fi "w": "e" kern k#,
  "a" kern k#, "o" kern k#, "c" kern k#;
 ligtable "P": 
  "y": "o" kern k#, "e" kern k#, "a" kern k#, "." kern kk#, "," kern kk#;
 ligtable "F": "V": "W": if serifs: "o" kern kk#, "e" kern kk#, "u" kern kk#,
    "r" kern kk#, "a" kern kk#, "A" kern kkk#,
   else: "o" kern k#, "e" kern k#, "u" kern k#,
    "r" kern k#, "a" kern k#, "A" kern kk#; fi
 ligtable "T": "y" kern if serifs: k# else: kk# fi,
  "Y": "e" kern kk#, "o" kern kk#,
   "r" kern kk#, "a" kern kk#, "A" kern kk#, "u" kern kk#;
 if serifs: ligtable "h": "m": "n":
   "t" kern k#, "u" kern k#, "b" kern k#, "y" kern k#, "v" kern k#, "w" kern k#;
  ligtable "c": "h" kern k#, "k" kern k#; fi
 ligtable "o": "b": "p": "e" kern -k#, "o" kern -k#, "x" kern k#,
   "d" kern -k#, "c" kern -k#, "q" kern -k#,
  "a": if serifs: "v" kern k#, "j" kern u#, else: "r" kern k#, fi
  "t": "y" kern k#,
  "u": "w" kern k#;
 ligtable "g": "j" kern -k#; % logjam
 
bye.
 
 
