% This is blbbase.mf (29-03-93) v1.0
% The base file for Computer Modern Blackboard (a supplement to {\tt cmbase.mf})
% Most of the code is borrowed from cmbase.mf but slightly modified
% Gilles F. ROBERT March 93

if unknown cmbase: input cmbase; fi
blbbase:=1;

numeric interspace#,cap_interspace#,interspace,cap_interspace,
 curve_interspace,cap_curve_interspace;

def normal_adjust_fit(expr left_adjustment,right_adjustment) =
 l:=-hround(left_adjustment*hppp)-letter_fit;
 interim xoffset:=-l;
 charwd:=charwd+2letter_fit#+left_adjustment+right_adjustment+cap_interspace#;
 r:=l+hround(charwd*hppp)-shrink_fit;
 w:=r-hround(right_adjustment*hppp)-letter_fit;
 enddef;

def mono_adjust_fit(expr left_adjustment,right_adjustment) =
 numeric expansion_factor;
 mono_charwd#+cap_interspace#=2letter_fit#
   +expansion_factor*(charwd+left_adjustment+right_adjustment+cap_interspace#);
 forsuffixes $=u,jut,cap_jut,beak_jut,apex_corr:
   $:=$.#*expansion_factor*hppp; endfor
 l:=-hround(left_adjustment*expansion_factor*hppp)-letter_fit;
 interim xoffset:=-l;
 r:=l+mono_charwd+cap_interspace-shrink_fit;
 w:=r-hround(right_adjustment*expansion_factor*hppp)-letter_fit;
 charwd:=mono_charwd#; charic:=mono_charic#;
 enddef;

extra_beginchar := extra_beginchar &"numeric Delta_x;";

vardef pen_duplicate(text t) =
 forsuffixes $=t :
  x$=.5[x.G$,x.D$]; y.G$=y.D$=y$;
  forsuffixes e=l,r : 
   z.G$e-z.G$ = z.D$e-z.D$ = z$e-z$;
  endfor
 endfor
 forsuffixes $=t : x.D$ - x.G$ = endfor Delta_x;
 enddef;

vardef double text t =
 forsuffixes z=z.G,z.D : t; endfor 
 enddef;

vardef define_upper(suffix @,$)(expr p) =
 forsuffixes e=l,r:
  top z@e = (z$e--(x$e,infinity)) intersectionpoint p;
  x@e := x$e;
 endfor enddef;

vardef define_lower(suffix @,$)(expr p) =
 forsuffixes e=l,r:
  bot z@e = (z$e--(x$e,-infinity)) intersectionpoint p;
  x@e := x$e;
 endfor enddef;

vardef define_upper_and_lower(suffix @,@@,$)(expr p) =
 define_upper(@,$,p);
 define_lower(@@,$,p);
 enddef;

vardef mid_biserif(suffix $,$$,@)  % serif at |z$| for stroke from |z$$|
  (expr darkness) suffix modifier =
 pickup crisp.nib; numeric bracket_height; pair downward;
 bracket_height=if dark.modifier: 1.5 fi\\ bracket;
 if y$<y$$: y@2=min(y$+bracket_height,y$$);
  top y@1-slab=bot y@0+eps=tiny.bot y$; downward=z$-z$$;
  if y@1>y@2: y@2:=y@1; fi
 else: y@2=max(y$-bracket_height,y$$);
  bot y@1+slab=top y@0-eps=tiny.top y$; downward=z$$-z$;
  if y@1<y@2: y@2:=y@1; fi fi
 y@3=y@2; 
 forsuffixes @@= @0,@2,@3:
  z@@=.5[z.G@@,z.D@@]; y.G@@=y.D@@;
 endfor
 z@3=z@2=whatever[z$,z$$]; z@0=whatever[z$,z$$];
 z.D@2+penoffset downward of currentpen =
   z.D$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
   z.D@0=z.D$+whatever*downward; z.D@3=z.D@0+whatever*downward;
   if x.D@3<x.D@2+eps: x.D@3:=x.D@2+eps; fi
 %z.G@2-penoffset downward of currentpen =
 %  z.G$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
 %  x.G@0=x.G$; z.G@3=z.G@0+whatever*downward;
 %  if x.G@3>x.G@2-eps: x.G@3:=x.G@2-eps; fi
 pair base; ypart base=y@1; base=z$+whatever*downward;
 filldraw z.G@2{z$-z$$}
  ...darkness[base,z@2]{[email protected]@2}
  ...{z$$-z$}[email protected]@[email protected]@0--z.G@3--cycle; % the serif
 labels (G@2,D@2); enddef;

vardef sloped_mid_biserif(suffix $,$$,@)  % serif at |z$| for stroke from |z$$|
  (expr darkness,drop) suffix modifier =
 pickup crisp.nib; numeric bracket_height; pair downward;
 bracket_height=if dark.modifier: 1.5 fi\\ bracket;
 if y$<y$$: y.G@2=min(y$+slab+bracket_height,y$$);
  top [email protected]=bot y@0+eps=tiny.bot y$; downward=z$-z$$;
  if y@1>y.G@2: y.G@2:=y@1; fi
 else: y.G@2=max(y$-slab-bracket_height,y$$);
  bot y@1+slab+.5drop=top y@0-eps=tiny.top y$; downward=z$$-z$;
  if y@1<y.G@2: y.G@2:=y@1; fi fi
 y@3=y@2;
 z@0=.5[z.G@0,z.D@0]; y.G@0=y.D@0; 
 forsuffixes @@= @2,@3:
  z@@=.5[z.G@@,z.D@@]; y.G@@=y.D@@-drop;
 endfor
 %z@3=z@2=whatever[z$,z$$]; z@0=whatever[z$,z$$];
 z.D@2+penoffset downward of currentpen =
   z.D$l+penoffset downward of pen_[tiny.nib]+whatever*downward;
   z.D@0=z.D$+whatever*downward; z.D@3=z.D@0+whatever*downward;
   if x.D@3<x.D@2+eps: x.D@3:=x.D@2+eps; fi
 z.G@2-penoffset downward of currentpen =
   z.G$r-penoffset downward of pen_[tiny.nib]+whatever*downward;
   x.G@0=x.G$; z.G@3=z.G@0+whatever*downward;
   if x.G@3>x.G@2-eps: x.G@3:=x.G@2-eps; fi
 pair base; ypart base=y@1; base=z$+whatever*downward;
 filldraw z.G@2{z$-z$$}
  ...darkness[base,z@2]{[email protected]@2}
  ...{z$$-z$}[email protected]@[email protected]@0--z.G@3--cycle; % the serif
 labels (G@2,D@2); enddef;

def dish_biserif(suffix $,$$,@)(expr left_darkness,left_jut)
  (suffix @@@)(expr mid_darkness)
  (suffix @@)(expr right_darkness,right_jut) suffix modifier =
 serif(G$,G$$,@,left_darkness,-left_jut) modifier;
 mid_biserif($,$$,@@@,mid_darkness) modifier;
 serif(D$,D$$,@@,right_darkness,right_jut) modifier;
 if dish>0: pickup tiny.nib; numeric dish_out,dish_in;
  if y$<y$$: dish_out=bot y$; dish_in=dish_out+dish; let rev_=reverse;
  else: dish_out=top y$; dish_in=dish_out-dish; let rev_=relax; fi
 erase fill rev_
  ((x@1,dish_out)..(x$,dish_in){right}..(x@@1,dish_out)--cycle);
 fi enddef;

def nodish_biserif(suffix $,$$,@)(expr left_darkness,left_jut)
  (suffix @@@)(expr mid_darkness)
  (suffix @@)(expr right_darkness,right_jut) suffix modifier =
 serif(G$,G$$,@,left_darkness,-left_jut) modifier;
 mid_biserif($,$$,@@@,mid_darkness) modifier;
 serif(D$,D$$,@@,right_darkness,right_jut) modifier; enddef;

vardef sloped_biserif.l(suffix $,$$,@)(expr darkness,jut,drop)
  (suffix @@)(expr mid_darkness) =
 sloped_serif.l(G$,G$$,@,darkness,jut,drop);
 sloped_mid_biserif($,$$,@@,mid_darkness,drop);
 if drop>0: erase fill z.D@@0--top z.D@@0
   --(x@2r,top y.D@@0)--z@2r--cycle; fi % erase excess at top
 enddef;

vardef sloped_biserif.r(suffix $,$$,@)(expr darkness,jut,drop)
  (suffix @@)(expr mid_darkness) =
 sloped_serif.r(D$,D$$,@,darkness,jut,drop);
 sloped_mid_biserif($,$$,@@,mid_darkness,-drop);
 if drop>0: erase fill z.D@@0--top z.D@@0
   --(x@2r,top y.D@@0)--z@2r--cycle; fi % erase excess at top
 enddef;

def f_double_stroke(suffix $,$$,@,left_serif,mid_serif,right_serif)(expr left_jut,right_jut)=
 pickup tiny.nib; bot y$=0; pen_duplicate(@0,@0',@1);
 penpos@0(x$r-x$l,0); x@0l=x$l; top y@0=x_height;
 pickup fine.nib; pos@0'(x$r-x$l+tiny,180); % removed stem_corr GFR
 y@0'=y@0; lft x@0'r=tiny.lft x$l;
 penpos@1(x@0'l-x@0'r,180); x@1=x@0'; y@1+.5vair=.5[x_height,h];
 pos@2(vair,90); top y@2r=h+oo;
 if serifs: x@2=.6[x.G@1,x$$r]; (x@,y@2r)=whatever[z@2l,z.G@1l];
  x@2r:=min(x@,.5[x@2,x$$r]); pos@3(hair,0); bulb(@2,@3,$$);  % bulb
 else: x@2=.6[x.G@1,x$$]; y.G@1l:=1/3[y.G@1l,y@2l]; fi
 pickup tiny.nib;
 Delta_x = min(hround(interspace+.5stem'),[email protected]@1l);
 double filldraw stroke z$e--z@0e;  % double stem
 define_upper(D@2,D@0',super_arc.l(G@1,@2));
 filldraw stroke z.D@0'e--z.D@2e; % inner stroke
 pickup fine.nib;
 if serifs: filldraw stroke z.G@0'e--z.G@1e & super_arc.e(G@1,@2);  % arc
  dish_biserif($,@0,left_serif,1/3,left_jut,mid_serif,1/3,right_serif,1/3,right_jut); % serif
 else: filldraw stroke z.G@0'e--z.G@1e & super_arc.e(G@1,@2)
   & term.e(@2,$$,right,.9,4); % arc and terminal
  mid_biserif($,@0,mid_serif,1/3); fi  % terminal
 penlabels(G@0,D@0,G@1,D@1,@2,D@2); enddef;