%  glutils.mf: general utilities for use with the gladiator (gl) fonts
%  Author: Bert Bos

pair dirpentilt; dirpentilt=dir pentilt;


%  PENS

uc_xscale#=uc_thick#/cosd pentilt;	%  Make pens wider if tilted
lc_xscale#=lc_thick#/cosd pentilt;	%  Make pens wider if tilted
uc_o_xscale#=uc_thick#/cosd o_pentilt;	%  Make pens wider if tilted
lc_o_xscale#=lc_thick#/cosd o_pentilt;	%  Make pens wider if tilted
define_whole_pixels(uc_xscale, lc_xscale, uc_o_xscale, lc_o_xscale);

forever:
  pickup pencircle xscaled uc_xscale yscaled uc_thin rotated pentilt;
  ucpen:= savepen;
  exitunless pen_rt-pen_lft<>uc_thick;
  if pen_rt-pen_lft>uc_thick:
    uc_xscale:= uc_xscale-1;
  elseif pen_rt-pen_lft<uc_thick:
    uc_xscale:= uc_xscale+1;
  fi
endfor;
forever:
  pickup pencircle xscaled uc_o_xscale yscaled uc_thin rotated o_pentilt;
  uc_o_pen:= savepen;
  exitunless pen_rt-pen_lft<>uc_thick;
  if pen_rt-pen_lft>uc_thick:
    uc_o_xscale:= uc_o_xscale-1;
  elseif pen_rt-pen_lft<uc_thick:
    uc_o_xscale:= uc_o_xscale+1;
  fi
endfor;
forever:
  pickup pencircle xscaled lc_o_xscale yscaled lc_thin rotated o_pentilt;
  lc_o_pen:= savepen;
  exitunless pen_rt-pen_lft<>lc_thick;
  if pen_rt-pen_lft>lc_thick:
    lc_o_xscale:= lc_o_xscale-1;
  elseif pen_rt-pen_lft<lc_thick:
    lc_o_xscale:= lc_o_xscale+1;
  fi
endfor;

pickup pencircle xscaled uc_curve yscaled uc_thin rotated pentilt;
uccurvepen:= savepen;

pickup pencircle scaled uc_thick;
ucthickpen:= savepen;

pickup pencircle scaled uc_med;
ucmedpen:= savepen;

pickup pencircle scaled uc_thin;
ucthinpen:= savepen;

forever:
  pickup pencircle xscaled lc_xscale yscaled lc_thin rotated pentilt;
  lcpen:= savepen;
  exitunless pen_rt-pen_lft<>lc_thick;
  if pen_rt-pen_lft>lc_thick:
    lc_xscale:=lc_xscale-1;
  elseif pen_rt-pen_lft<lc_thick:
    lc_xscale:=lc_xscale+1;
  fi
endfor;

pickup pencircle xscaled lc_curve yscaled lc_thin rotated pentilt;
lccurvepen:= savepen;

pickup pencircle scaled lc_thick;
lcthickpen:= savepen;

pickup pencircle scaled lc_med;
lcmedpen:= savepen;

pickup pencircle scaled lc_thin;
lcthinpen:= savepen;

pickup pencircle scaled fine;		%  For tips of serifs, etc.
finepen:=savepen;

pickup pencircle scaled dotwidth;	%  For dots etc.
dotpen:=savepen;


%  WIDTHS

A_width#=2U#+0.58width#-2ba#+uc_extrawidth#;
B_width#=2U#+0.52width#-ba#+uc_extrawidth#;
C_width#=2U#+0.58width#-2ba#;
D_width#=2U#+0.56width#-ba#+uc_extrawidth#;
E_width#=2U#+0.50width#-ba#;
F_width#=E_width#-0.027cap#;
G_width#=2U#+0.58width#-ba#+uc_extrawidth#;
H_width#=2U#+0.58width#+uc_extrawidth#;
I_width#=2U#+uc_thick#;
J_width#=I_width#;
K_width#=H_width#-ba#;
L_width#=E_width#-ba#;
M_width#=2U#+0.62width#+uc_extrawidth#;
N_width#=2U#+0.54width#+uc_extrawidth#;
O_width#=2U#+0.67width#-2ba#+uc_extrawidth#;
P_width#=B_width#-0.027cap#;
Q_width#=O_width#;
R_width#=B_width#;
S_width#=2U#+0.54width#-2ba#+uc_extrawidth#;
T_width#=2U#+0.54width#-2ba#;
U_width#=N_width#;
V_width#=N_width#-2ba#;
V_angle=angle((V_width#-2U#+2ba#-fine#)/2,cap#);
W_width#=2H_width#-2U#-uc_thick#/sind V_angle-2ba#;
X_width#=2U#+0.58width#-2ba#+uc_extrawidth#;
Y_width#=H_width#-2ba#;
Z_width#=E_width#-ba#;

a_width#=2u#+0.35width#-ba#+lc_extrawidth#;
b_width#=2u#+0.39width#-ba#+lc_extrawidth#;
c_width#=2u#+0.37width#-2ba#;
d_width#=b_width#;
e_width#=2u#+0.39width#-2ba#+lc_extrawidth#;
f_width#=i_width#;
g_width#=b_width#;
h_width#=2u#+0.37width#+lc_extrawidth#;
i_width#=2u#+lc_thick#;
j_width#=i_width#;
k_width#=2u#+0.39width#-ba#+lc_extrawidth#;
l_width#=i_width#;
m_width#=2n_width#-2u#-lc_thick#;
n_width#=h_width#;
o_width#=2u#+0.42width#-2ba#+lc_extrawidth#;
p_width#=b_width#;
q_width#=b_width#;
r_width#=2u#+0.28width#-ba#;
s_width#=c_width#; %+lc_extrawidth#;
t_width#=2u#+0.20width#-ba#;
u_width#=h_width#;
v_width#=2u#+0.35width#-2ba#+lc_extrawidth#;
v_angle=angle((v_width#-2u#+2ba#-fine#)/2,xheight#);
w_width#=2v_width#-2u#+2ba#-lc_thick#/sind v_angle;
x_width#=2u#+0.37width#-2ba#+lc_extrawidth#;
y_width#=v_width#;
z_width#=2u#+0.37width#-2ba#+lc_extrawidth#;



%  CUTOFF CHANGED FROM PLAIN

%  Cutoff from the Plain macros often leaves traces behind, this is
%  a stab at improving it
%vardef cutoff(expr z, theta) =
%  interim autorounding:= 0; interim smoothing:= 0;
%  addto pic_ doublepath z.t_ withpen currentpen;
%  addto pic_ contour (cut_ scaled (3+max(-pen_lft,pen_rt,pen_top,-pen_bot))
%    rotated theta shifted z)t_;
%  cull pic_ keeping (2,2) withweight -default_wt_;
%  addto currentpicture also pic_;
%  pic_:= nullpicture
%enddef;

%def cutdraw expr p = % caution: you may need autorounding=0
% draw p;
% cutoff(point 0 of p, 180+angle direction 0 of p);
% cutoff(point infinity of p, angle direction infinity of p)
%enddef;


%  DIRECTIONS

%  clockwise can be used to rotate directions slightly clockwise,
%  e.g., in the path: z0--z1{(z0-z1)clockwise}..z2
%
def clockwise = rotated 1 enddef;
def anticlockwise = rotated -1 enddef;


%  UTILITY ROUTINES

%  defchar(c,w,h,d,p,i) replaces beginchar. p is the initial pen, i is
%  the amount to be added to the estimated italic correction: h_sharp*slant
def defchar(expr c,w_sharp,h_sharp,d_sharp,p,i_sharp) =
  begingroup
  charcode:= if known c: byte c else: 0 fi;
  charwd:= w_sharp;
  charht:= h_sharp;
  chardp:= d_sharp;
  w:= hround(charwd*hppp);
  h:= vround(charht*hppp);
  d:= vround(chardp*hppp);
  charic:= 0;
  italcorr h_sharp*slant+i_sharp;
  clearxy;
  clearit;
  clearpen;
  pickup p;
  scantokens extra_beginchar;
enddef;

% pause is for when glyphs are displayed one at a time on screen
%
def pause = stop "done with char "&decimal charcode&". " enddef;

extra_endchar:= "; if known grayletters: grayit fi; labels(range 0 thru 25)";
% extra_endchar:= "; if known grayletters: grayit fi; labels(range 0 thru 25); pause;";


%  align(a,b,c,...) makes sure all points a, b, c,... lie on a straight line
%
def align(expr a, b)(text t) =
  for i = t: i=whatever[a,b]; endfor
enddef;


%  grayit removes 75% of all pixels in the currentpicture, leaving a
%  gray-looking letter. ppi (pixels per inch) stands for the number of
%  cells per inch, each cell will contain a black circle that occupies
%  about 75% of the area. Typical values for ppi are 32, 42 and 50,
%  depending on the capabilities of the printer.
vardef mask(expr blackness) =		%  Create cell with one dot
  save diam, weight, pic;
  numeric diam, weight;
  picture pic;
  pic=nullpicture;
  if blackness <= pi/4:			%  Does black circle fit?
    diam=2graywd*sqrt(blackness/pi);
    weight=1
  else:					%  Draw a white circle instead
    diam=2graywd*sqrt((1-blackness)/pi);
    weight=-1;
    addto pic also contour (unitsquare scaled graywd)
  fi;
  addto pic contour (fullcircle shifted (.5,.5) scaled diam) withweight weight;
  pic
enddef;

%ppi=min(in/8,50);			%  Assures at least 8 pixels/cell
ppi=min(in/4,90);			%  Assures at least 4 pixels/cell
blackness=0.30;				%  Mask will be 30% black
pi=3.1415927;				%  Approximates pi

vardef grayit =
  save x,y, graywd, ic;
  ic=hround(charic*hppp);
  picture graycell;			%  Square containing one dot
  graywd=ceiling(in/ppi);		%  Should be whole number of pixels
  graycell=mask(blackness);
  cullit;
  for y=floor(-d-vo) step 2graywd until h+vo:
    for x=floor(-ho) step graywd until w+ho+ic:
      addto currentpicture also (graycell shifted (x,y));
    endfor
  endfor;
  for y=floor(-d-vo)+graywd step 2graywd until h+vo:
    for x=floor(graywd/2-ho) step graywd until w+ho+ic:
      addto currentpicture also (graycell shifted (x,y));
    endfor
  endfor;
  cull currentpicture keeping (2,infinity);
enddef;


%  DRAWING SERIFS

%  serif$(wd,ht) draws a serif at the end of a vertical stem at point
%  z$, the positioning of the serif depends on the current pen (lft
%  z$, rt z$, etc.). The serif points to the right if wd>0, else it
%  points to the left, it will be a bottom serif if ht>0, else it will
%  be a top serif. The (wd>0, ht>0) serif looks like:
%
%     f    a
%   -  *###*#
%   |  ####|##
%  ht  ####|####
%   |  ####|#######   e
%   -  *###*##########*
%     d    c          b
%          |----wd----|
%
vardef serif@#(expr wd, ht) =
  save a,b,c,d,e; pair a,b,c,d,e,f;
%  if ht<0: d=top z@# else: d=bot z@# fi;
  ypart d=if ht<0: top y@# else: bot y@# fi;
  xpart d=if wd<0: rt x@# else: lft x@# fi;
  b=c+(wd,0);
  a=c+(0,ht);
  f=(xpart d,ypart a);
  xpart c=if wd<0: lft x@# else: rt x@# fi;
  ypart c=ypart d;
  if ht<0: e=b+fine*down else: e=b+fine*up fi;
  if known sans:
    fill a--c--d--f--cycle
  else:
    fill a{if ht<0: up else: down fi}..tension tens..
      {if wd<0:left else: right fi}e--b--d--f--cycle
  fi;
enddef;


%  triangle$(wd,X,Y) defines three points, z$l, z$ and z$r, which
%  constitute the base of the triangle-shaped serif at the top end
%  of a vertical stem. wd is the width of the stem.
%  X is the x-coordinate of the left
%  edge of the stem, Y is the top of the stem.
%
%  Y         c # b
%  ^         ###
%  |      ######
%  | a #########
%  | d    ######
%  |       l ### r
%  |         :$ :
%  |         : :
%   -------> X
%
vardef triangle@#(expr wd,X,Y) =
  z@#l=(X,Y-triangleht);
  penpos@#(wd,0);
  z@#b=(x@#r,Y);
  z@#c=z@#b+fine*left;
%  z@#a=(X-trianglewd,Y-triangleht/2+fine/2);
  z@#a=(X,Y-triangleht/2+fine/2) - trianglewd*dir(seriftilt);
  z@#d=z@#a+fine*down;
  if known sans:
    fill z@#r--z@#b--z@#c--z@#a--z@#l--cycle
  else:
    fill z@#r--z@#b--z@#c{dir(angle(z@#a-z@#c)+10)}..tension tens..z@#a--
      z@#d{z@#c-z@#a}..{down}z@#l--cycle
  fi;
enddef;


%
%          $l $ $r
%  a #######*#*#*##### b
%  f    ###########    c
%        #######
%        #####
%     e ##### d
%      / 
%     /
%    /
%   /alpha
%  /___________
%
vardef diag_tr@#(expr xx, yy, w, alpha) =
  save a, b, c, d, e, f, ww; pair a, b, c, d, e, f; numeric ww, sw;
  ww=w/abs(sind alpha);
%  penpos @#(ww,0); z@#r=(xx,yy);
  penpos @#(ww,seriftilt); x@#r=xx; y@#=yy;
  ypart d=yy-serifht; d=e+(ww,0);
%  b=(xx+serifwd*abs(sind alpha),yy)=a+(2serifwd+ww,0);
  sw=ww/2+serifwd*abs(sind alpha);
  b=z@# + sw*serifdir;
  a=z@# - sw*serifdir;
  f=a+fine*down; c=b+fine*down;
  e=z@#l+whatever*dir alpha;
%  show a, b, c, d, e, f;
  if known sans:
    fill z@#l--z@#r--d--e--cycle;
  else:
%    fill a--b--c{left}..tension tens..{-dir(alpha)}d--e{dir alpha}
%      ..tension tens..{left}f--cycle;
    fill a--b--c{a-b}..tension tens..{-dir(alpha)}d
      --e{dir alpha}..{a-b}f--cycle;
  fi
enddef;
vardef diag_br@#(expr xx, yy, w, alpha) =
  save a, b, c, d, e, f, ww; pair a, b, c, d, e, f; numeric ww, sw;
  ww=w/abs(sind alpha);
%  penpos @#(ww,0); z@#r=(xx,yy);
  penpos @#(ww,seriftilt); x@#r=xx; y@#=yy;
  ypart d=yy+serifht; d=e+(ww,0);
%  b=(xx+serifwd*abs(sind alpha),yy)=a+(2serifwd+ww,0);
  sw=ww/2+serifwd*abs(sind alpha);
  b=z@# + sw*serifdir;
  a=z@# - sw*serifdir;
  f=a+fine*up; c=b+fine*up;
  e=z@#l+whatever*dir alpha;
  if known sans:
    fill z@#l--z@#r--d--e--cycle;
  else:
%    fill a--b--c{left}..tension tens..{dir(alpha-180)}d--e{dir alpha}
%      ..tension tens..{left}f--cycle;
    fill a--b--c{-serifdir}..tension tens..{dir(alpha-180)}d--e{dir alpha}
      ..tension tens..{-serifdir}f--cycle;
  fi
enddef;
vardef diag_tl@#(expr xx, yy, w, alpha) =
  save a, b, c, d, e, f, ww; pair a, b, c, d, e, f; numeric ww, sw;
  ww=w/abs(sind alpha);
%  penpos @#(ww,0); z@#l=(xx,yy);
  penpos @#(ww,seriftilt); x@#l=xx; y@#=yy;
  ypart d=yy-serifht; d=e+(ww,0);
%  a=(xx-serifwd*abs(sind alpha),yy)=b-(ww+2serifwd,0);
  sw=ww/2+serifwd*abs(sind alpha);
  b=z@# + sw*serifdir;
  a=z@# - sw*serifdir;
  f=a+fine*down; c=b+fine*down;
  d=z@#r+whatever*dir alpha;
  if known sans:
    fill z@#l--z@#r--d--e--cycle;
  else:
%    fill a--b--c{left}..tension tens..{dir(alpha-180)}d--e{dir alpha}
%      ..tension tens..{left}f--cycle;
    fill a--b--c{-serifdir}..tension tens..{dir(alpha-180)}d--e{dir alpha}
      ..tension tens..{-serifdir}f--cycle;
  fi
enddef;
vardef diag_bl@#(expr xx, yy, w, alpha) =
  save a, b, c, d, e, f, ww; pair a, b, c, d, e, f; numeric ww, sw;
  ww=w/abs(sind alpha);
%  penpos @#(ww,0); z@#l=(xx,yy);
  penpos @#(ww,seriftilt); x@#l=xx; y@#=yy;
  ypart d=yy+serifht; d=e+(ww,0);
%  a=(xx-serifwd*abs(sind alpha),yy)=b-(ww+2serifwd,0);
  sw=ww/2+serifwd*abs(sind alpha);
  b=z@# + sw*serifdir;
  a=z@# - sw*serifdir;
  f=a+fine*up; c=b+fine*up;
  d=z@#r+whatever*dir alpha;
  if known sans:
    fill z@#l--z@#r--d--e--cycle;
  else:
%    fill a--b--c{left}..tension tens..{dir(alpha-180)}d--e{dir alpha}
%      ..tension tens..{left}f--cycle;
    fill a--b--c{-serifdir}..tension tens..{dir(alpha-180)}d
      --e{dir alpha}..tension tens..{-serifdir}f--cycle;
  fi
enddef;

% Tail for a and d
%    ::
%    l z@# r      b
%    #######    ##
%  ::####### d##### c
% ::: ###########
% :     #######
%         ### a
%
%vardef tail@# =
%  save a, b, c, d, w; pair a, b, c, d; numeric w;
%  w=min(u,lc_thick);
%  xpart c=x@#r+w;
%  ypart b=serifht;
%  a=(1/2[x@#l,xpart c],0);
%  b=c+lc_thin*dir(135);
%  d=(1/3[x@#r,xpart b],lc_thin);
%  fill z@#l{down}..a{right}...{dir inclination}c--
%    b{dir(inclination-180)}...{left}d...{up}z@#r--cycle;
%enddef;

% Tail for a, d and u
%
% :::::::
% l:z@#:r
% #######
% #######
% ####### d
% ########
% ##########
% #############     c
% ##################
% a                 b
vardef tail@# =
  save a, b, c, d; pair a, b, c, d;
%  a=(1/4[x@#l,x@#r],0); b=(x@#r+serifwd,0);
  a=(1/4[x@#l,x@#r],0); b=a+(3/4(x@#r-x@#l)+serifwd)*serifdir;
  c=b+fine*up;
  d=(x@#r,serifht);
  if known sans:
    fill a--b--z@#r--z@#l--cycle
  else:
%    fill a--b--c{left}..tension tens..{up}d---z@#r--z@#l--cycle
    fill a--b--c{-serifdir}..tension tens..{up}d---z@#r--z@#l--cycle
  fi;
enddef;   

%  solveangle(wd,X,Y) returns the angle of a stem of width wd with
%  lower left at (0,0) and upper right at (X,Y).
%
%             a    b
%  Y+--------------+
%   |        /    /|
%   |       /    / |
%   |      /    /  |
%   |     /-_  /   |
%   |    /wd -/    |
%   |   /    /     |
%   |  /    /      |
%   | /    /       |
%   |/    /alpha   |
%   +--------------+
%  0               X
%
vardef solve_angle(expr wd,X,Y)=
  vardef f(expr alpha) =
    save a,b; pair a,b;
    b=(X,Y);
    a=b-(wd/sind alpha,0);
    alpha<angle a
  enddef;
  solve f(1,90)
enddef;

tolerance:= epsilon;			%  For solve; instead of default 0.1