%
% tipabase.mf: TIPA miscellaneous macros
%
% Version 1.0 1996/05/22 FUKUI Rei
%
% This file is based on:
%   Computer Modern font series by D. E. Knuth and
%   TSIPA by KOBAYASHI Hajime, FUKUI Rei and SHIRAKAWA Shun.
%
% N.B. This file is an addition to cmbase.mf, not a replacement.
%

if unknown cmbase:
  errmessage "`cmbase' should have been read before `tipabase'"; fi

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

boolean Times_Compat;

let _font_setup = font_setup;

def font_setup =
  _font_setup;
  vu#:=u#; hair_rule#:=hair#;
  diacritic#:=.2[vair#,stem#]; % breadth of some diacritics
  diacr#:=diacritic#;
  define_whole_vertical_pixels(vu);
  define_whole_blacker_pixels(diacritic,diacr);
  forsuffixes $=diacritic:
    $.breadth:=$;
    pickup if $=0: nullpen else: pencircle scaled $; $:=$-eps fi;
    $.nib:=savepen; breadth_[$.nib]:=$;
    forsuffixes $$=lft,rt,top,bot: shiftdef($.$$,$$ 0); endfor endfor
  hair_rule:=ceiling(hair_rule#*hppp);
  pickup pencircle scaled hair_rule; hair_rule.nib:=savepen;
  enddef;

boolean debug; debug:=false;

let _endchar = endchar;

def endchar =
  _endchar; if debug: stop_here; fi enddef;

def sc_compress(suffix $)(expr rate_fix) = % for small caps
 $.#:=$.# * ((rate_fix[x_height#,cap_height#])/cap_height#); enddef;

def smallcap_setup =
 forsuffixes $=save_var_list: old.$.#:=$.#; endfor
 forsuffixes $= u, letter_fit: $.#:=sc.$.#; endfor
 sc_compress(flare,.7);
 sc_compress(cap_jut,.1);
 sc_compress(beak_jut,.1);
 sc_compress(beak,0);
 sc_compress(slab,.4);
 sc_compress(cap_bar,.8);
 sc_compress(o,.1);
 sc_compress(apex_o,0);
 font_setup; enddef;

def save_var_list =
 u, letter_fit, flare, cap_jut, beak_jut, beak, slab, cap_bar,
  o, apex_o enddef;

def restore_normal_setup =
 forsuffixes $=save_var_list: $.#:=old.$.#; endfor
 font_setup; enddef;

def turn_picture =
 _center_h:=hround(.5charwd*hppp+.5slant*charht*hppp);
 _center_v:=vround(.5charht*hppp);
 currentpicture:=currentpicture
  rotatedabout((_center_h,_center_v),180); enddef;

def turn_picture_lower =
 _center_h:=hround(.5charwd*hppp+.5slant*charht*hppp);
 _center_v:=vround(.5x_height#*hppp);
 currentpicture:=currentpicture
  rotatedabout((_center_h,_center_v),180); enddef;

def comMA(suffix $,@)(expr dot_size,jut,depth) =
 pickup fine.nib; pos$(dot_size,90);
 if square_dots: pos$'(dot_size,0); z$'=z$; dot($',$);  % squarish dot
  comma_join_:=max(fine.breadth,floor .7dot_size);
  comma_bot_:=max(fine.breadth,floor .5dot_size);
  pos@0(comma_join_,0); pos@1(comma_join_,0);
  pos@2(comma_bot_,0); y@0=y$; y@1=y$l; y@2=y@1-depth;
  x@0l=x@1l=x$'l; lft x@2l=good.x(x$+eps);
  filldraw stroke z@0e--z@1e..z@2e;  % tail
 else: pos@1(vair,90); pos@2(vair,180); pos@3(vair,225); % 96/02/10 fkr
  z@1r=z$r; lft x@2r=hround(x$-.5dot_size-jut)-2eps; x@3=x$+.5u;
  y@2=1/3[y@1,y@3]; bot y@3r=vround(y$-.5dot_size-depth);
  y_:=ypart((z@1{right}...z@2{down}...z@3)
   intersectiontimes (z$l{right}..{left}z$r)); if y_<0: y_:=1; fi
  filldraw z$r{left}..subpath (0,y_) of (z$l{right}..{left}z$r)--cycle; % dot
  filldraw stroke z@1e{left}...z@2e{down}...z@3e; fi  % tail
 penlabels(@1,@2,@3); enddef;

def hook_out_bot(suffix $,$$,$$$) % used in ``Viby I'' and ``Viby Y''
 suffix modifier= % |x$| and |x$$$| (only) are known
 pos$(stem,0); pos$$(vair,90);
 x$$$:=hround(x$$$+.5hair-eps)-.5hair; pos$$$(hair,180);
 y$=1/4x_height-d; bot y$$l=-oo-d; y$$$=1/3x_height-d;
 if skewed.modifier: x$$=x$+1.25u;
  filldraw stroke z$e{-u,-x_height}...z$$e{right}...{up}z$$$e;  % hook
 else: x$$=x$+1.5u;
  filldraw stroke z$e{down}...z$$e{right}
   ...{x$$$-(x$+2.5u),x_height}z$$$e; fi enddef;  % hook

def hbar(suffix $, $$)(expr loffset, roffset, ypos) =
 pickup tiny.nib;
 lft x$r = loffset; rt x$$r = roffset;
 top y$r = top y$$r = vround(ypos);
 pos$(bar,90); pos$$(bar,90);
 filldraw stroke z$e--z$$e;
 penlabels($, $$); enddef;

def left_tail(suffix $, $$, @, @@)(expr stem_br, x_offset) =
 if serifs: pickup tiny.nib;
  x$$=x$; bot y$$=-1/3d; pos$$(stem_br,0);
  pos@(vair,-90); pos@@(hair,-180); pos@@'(flare,-180);
  x@=.5[x$$,x@@r]; bot y@r=-d-oo; y@@-.5flare=-.88d;
  z@@r=z@@'r; lft x@@'r= x_offset; 
  numeric xx;
  (xx,y@r)=whatever[z@l,z$$l]; x@r:=max(xx,.5[x@@r,x@]);
  filldraw stroke z$e--z$$e{down}...z@e{left}; bulb(@,@@,@@'); % arc and bulb
 else: pickup fine.nib;
  x$$=x$; bot y$$=-1/3d; pos$$(stem_br,0);
  pos@(vair,-90); x@=.5[x$$,x@@r]; bot y@r=-d-o;
  pos@@(.7[vair,flare],-130); lft x@@r=x_offset;
  y@@r=good.y -5/6d; y@@l:=good.y y@@l;
  filldraw stroke z$e--z$$e & super_arc.e($$,@)
   & term.e(@,@@,left,.9,4); fi
 enddef;

def right_tail(suffix $, $$, @, @@)(expr stem_br, x_offset, y_end,
 x_rate, y_rate) =
 if serifs: pickup tiny.nib;
  pos$.a(stem_br,180); z$=z$.a;
  x$$=x$.a; bot y$$=-y_rate*d; pos$$(stem_br,180);
  pos@(vair,270); pos@@(hair,360); pos@@'(flare,360);
  x@=x_rate[x$$,x@@r]; bot y@r=-d-oo; y@@-.5flare=-y_end*d;
  z@@r=z@@'r; rt x@@'r= x_offset; 
  numeric xx;
  (xx,y@r)=whatever[z@l,z$$l]; x@r:=min(xx,.5[x@,x@@r]);
  filldraw stroke z$.a e--z$$e{down}...z@e{right}; bulb(@,@@,@@');%arc and bulb
 else: pickup fine.nib;
  pos$.a(stem_br,180); z$=z$.a;
  x$$=x$.a; bot y$$=-y_rate*d; pos$$(stem_br,180);
  pos@(vair,270); x@=x_rate[x$$,x@@r]; bot y@r=-d-o;
  pos@@(.7[vair,flare],310); rt x@@r=x_offset;
  y@@r=good.y(-y_end*d); y@@l:=good.y y@@l;
  filldraw stroke z$.a e--z$$e & super_arc.e($$,@)
   & term.e(@,@@,right,.9,4); fi
 enddef;

def hooktop(suffix $, $$, @, @@)(expr stem_br, x_offset, height,
 y_end, x_rate, y_rate) =
 if serifs: pickup tiny.nib;
  pos$.a(stem_br,180); z$=z$.a;
  x$$=x$.a; top y$$=y_rate[y$.a,height]; pos$$(stem_br,180);
  pos@(vair,90); pos@@(hair,0); pos@@'(flare,0);
  x@=x_rate[x$$,x@@r]; top y@r=height+oo; y@@+.5flare=y_end[y$.a,height];
  z@@r=z@@'r; rt x@@'r= x_offset; 
  numeric xx;
  (xx,y@r)=whatever[z@l,z$$l]; x@r:=min(xx,.5[x@,x@@r]);
  filldraw stroke z$.a e--z$$e{up}...z@e{right}; bulb(@,@@,@@'); % arc and bulb
 else: pickup fine.nib;
  pos$.a(stem_br,180); z$=z$.a;
  x$$=x$.a; top y$$=y_rate[y$.a,height]; pos$$(stem_br,180);
  pos@(vair,90); x@=x_rate[x$$,x@@r]; top y@r=height+o;
  pos@@(.7[vair,flare],50); rt x@@r=x_offset;
  y@@r=good.y y_end[y$.a,height]; y@@l:=good.y y@@l;
  filldraw stroke z$.a e--z$$e & super_arc.e($$,@)
   & term.e(@,@@,right,.9,4); fi
 enddef;

def d_stroke(expr Topserif, Botserif, bot_y) =
 pickup tiny.nib; pos1(stem',0); pos2(stem,0);
 pos0'(stem',0); pos0(stem,0); z0r=z0'r; x0'=x1; x0=x2;
 rt x1r=hround(w-2.5u+.5stem'); top y1=h;
 numeric edge; edge=lft x2l;
 pickup fine.nib; pos3(if hefty:thin_join else: hair fi,0);
 pos4(vair,90); pos5(curve,180); pos6(vair,270); penpos7(x3r-x3l,360);
 lft x3l=min(lft x3l-(rt x3r-tiny.rt x2r),1/3[lft x2,edge]);
 y3=1/8[bar_height,x_height];
 x4l=.5(w-serif_fit)-.3u; top y4r=x_height+oo;
 lft x5r=hround max(1.35u-.5curve,.6u); y5=.5x_height;
 x6l=x4l-.2u; bot y6r=-oo;
 x7=x3; y7=min(y3,y6+y4-y3+.6vair);
 (x,y4r)=whatever[z3l,z4l]; x4r:=max(x,.5[x5r,x4]);
 (x',y6r)=whatever[z7l,z6l]; x6r:=max(x',.5[x5r,x6]);
 filldraw stroke z3e{up}...pulled_arc.e(4,5)
  & pulled_arc.e(5,6)...{up}z7e; % bowl
 y0=ypart(((edge,h)--(edge,0))intersectionpoint(z3l{up}...{left}z4l));
 pickup tiny.nib; bot y2=if Botserif:
  if serifs:-min(oo,serif_drop) else: 0 fi; else: bot_y; fi
 if Topserif: filldraw stroke z1e--z0'e--z0e--z2e;  % stem
 else: filldraw stroke z0e--z2e; fi % stem
 if serifs: if Topserif: sloped_serif.l(1,0',a,1/3,jut,serif_drop); fi % upper serif
  if Botserif: sloped_serif.r(2,0,b,1/3,jut,min(oo,serif_drop)); fi fi % lower serif
 enddef;

def epsilon_stroke(expr reverse,mid_jut) = % derived from `3' of cm
 numeric top_thickness,mid_thickness,bot_thickness,mid_thickness';
 top_thickness=max(fine.breadth,vround(slab-2vair_corr));
 mid_thickness=max(fine.breadth,vround 2/3vair);
 bot_thickness=max(fine.breadth,vround(slab-vair_corr));
 mid_thickness'=max(hround .6fine.breadth,
  hround .35[curve,cap_curve]-stem_corr);
 pickup fine.nib; pos2(top_thickness,90);
 pos4(vair,-90); pos5(vair,-90); pos6(mid_thickness,90);
 pos8(bot_thickness,-90); top y2r=h+o; bot y8r=-o;
 if reverse=true: pos3(mid_thickness',0); pos7(mid_thickness',0);
  rt x3r=hround(w-u); rt x7r=hround(w-.75u);
  x2=x6=x8=.5[1.5u,x7]; lft x5=min(hround mid_jut,lft x6)-eps;
  z4=z5+whatever*(150u,h);
 else: pos3(mid_thickness',180); pos7(mid_thickness',180);
  lft x3r=hround(u); lft x7r=hround(.75u);
  x2=x6=x8=.5[x7,w-1.5u]; rt x5=max(hround(w-mid_jut),w-rt x6)+eps;
  z4=z5+whatever*(-150u,h); fi
 x4=1/3[x5,x3l]; y3=.5[top y4l,bot y2l]; y7=.5[bot y6l,top y8l];
 top y5l=vround(.54h+.5vair); y5r=y6l;
 filldraw stroke pulled_super_arc.e(2,3)(.5superpull)
  & z3e{down}...z4e---z5e;  % upper bowl
 filldraw z5r--z6l--z6r--z5l---cycle;  % middle tip
 filldraw stroke pulled_super_arc.e(6,7)(.5superpull)
  & pulled_super_arc.e(7,8)(.5superpull);  % lower bowl
 enddef;

def yogh_stroke(expr xmid,xmidrate,xoffset,Combined,Notail) = % derived from `z' of cm
 numeric arm_thickness[],z_stem,stem[];
 stem1=fudged.stem-4stem_corr;
 if hefty: arm_thickness1=stem1; arm_thickness2=stem1;
  z_stem=fudged.hair;
 else: arm_thickness1=stem1; arm_thickness2=stem1; z_stem=fudged.hair; fi
 if arm_thickness1<tiny.breadth: arm_thickness1:=tiny.breadth; fi
 pickup tiny.nib; rt x1r=rt x2r=hround(w-.8u); 
 lft x3l=lft x4l=hround xmidrate[xmid, w-.8u]; 
 top y1=h; y2=min(y1,h-2/3arm_thickness1);
 bot y4=.3[0,h]; y3=max(y4,2/3arm_thickness2);
 numeric alpha; alpha=diag_ratio(1,z_stem-tiny,y2-y3,x2r-x3l-slant*(y2-y3));
 penpos1(alpha*(z_stem-tiny),0); penpos2(alpha*(z_stem-tiny),0);
 penpos3(alpha*(z_stem-tiny),0); penpos4(alpha*(z_stem-tiny),0);
 pair delta; delta=penoffset z3-z2 of currentpen;
 fill top lft z1l--z2l+delta---z3l+delta..lft z3l---lft z4l..bot z4l
  ---bot rt z4r--z3r-delta---z2r-delta..rt z2r---rt z1r..top z1r
  ---cycle;  % diagonal
 pickup crisp.nib; pos5(arm_thickness1,90); pos6(hair,180);
 top y5r=h; x5=x1;
 lft x6r=if Combined: hround xmid; else: hround xoffset; fi
 y6=if Combined: y5l; else: good.y(y5l-beak/1.8)-eps; fi
 arm(5,6,a',beak_darkness,if Combined: 0 else: -.4beak_jut fi);  % upper arm and beak
 pickup fine.nib;
 pos12(stem,angle(z2-z3)); z12l=z3l;
 pos7(curve,0); pos8(vair,-90);
 rt x7r=hround(w-.75u+.1curve); y7=.5[bot y12l,top y8l];
 x8=hround .5[xoffset, w-.8u]; bot y8r=-d-oo;
 filldraw stroke pulled_arc.e(12,7) & pulled_arc.e(7,8);  % bowl
 if Notail: else:
  if serifs: numeric bulb_diam;
   bulb_diam=flare; %+cap_stem-stem;
   pos10(bulb_diam,-180); pos9(cap_hair,-180);
   lft x10r=hround xoffset; y10=if Combined: -.45d; else: -.3d; fi
   bulb(8,9,10);  % lower bulb
  else: pos9(hair,angle(-4u,-h));
   lft x9r=hround xoffset; top y9l=vround -.3d;
   y9r:=good.y y9r-eps; x9l:=good.x x9l;
   filldraw stroke term.e(8,9,left,1,4); fi  % lower terminal
  fi enddef;

def full_circ_stroke(suffix $,$$) =
  filldraw circ_stroke z$e--z$$e;
  filldraw circ_stroke z$$e--z$e;
  enddef;

% end of tipabase.mf