fontbase.mf

mode_setup;
currenttransform:=identity slanted slant;
define_pixels(s,u,xgap,px,py,ptiny,x_ht,ht,o,desc_depth);

%if unknown slant: slant:=0 else: currenttransform:=
% identity slanted slant yscaled aspect_ratio fi;
 
%ho#:=o#;                                % horizontal overshoot
%leftstemloc#:=2.5u#+s#;                 % position of left stem

font_coding_scheme "T1";
font_slant slant;
font_normal_stretch 3u#;
font_normal_shrink 2u#;
font_x_height x_ht#;
%font_quad 18u#+2s#;
font_extra_space 2u#;

%define_pixels(s,u);
%define_whole_pixels(xgap);
%define_whole_vertical_pixels(ygap);
%define_blacker_pixels(px,py);
%pickup pencircle xscaled px yscaled py rotated prot;
%logo_pen:=savepen;
%define_good_x_pixels(leftstemloc);
%define_good_y_pixels(barheight,x_ht,ht);
%define_corrected_pixels(o);
%define_horizontal_corrected_pixels(ho);

% enc encodes names to numbers, so enc("A")=65
% altough defining an array first seems to be 
% a good idea, it turns out that this variant
% is significantly faster!
def enc(expr name)=
 if (font_coding_scheme_="T1"):
  if name="grave":
   0
  elseif name="acute":
   1
  elseif name="circumflex":
   2
  elseif name="tilde":
   3
  elseif name="dieresis":
   4
  elseif name="hungarumlaut":
   5
  elseif name="ring":
   6
  elseif name="caron":
   7
  elseif name="breve":
   8
  elseif name="macron":
   9
  elseif name="dotaccent":
   10
  elseif name="cedilla":
   11
  elseif name="ogonek":
   12
  elseif name="quotesinglbase":
   13
  elseif name="guilsinglleft":
   14
  elseif name="guilsinglright":
   15
  elseif name="quotedblleft":
   16
  elseif name="quotedblright":
   17
  elseif name="quotedblbase":
   18
  elseif name="guillemotleft":
   19
  elseif name="guillemotright":
   20
  elseif name="endash":
   21
  elseif name="emdash":
   22
  elseif name="cwm":
   23
  elseif name="perthousandzero":
   24
  elseif name="dotlessi":
   25
  elseif name="dotlessj":
   26
  elseif name="ff":
   27
  elseif name="fi":
   28
  elseif name="fl":
   29
  elseif name="ffi":
   30
  elseif name="ffl":
   31
  elseif name="visiblespace":
   32
  elseif name="exclam":
   33
  elseif name="quotedbl":
   34
  elseif name="numbersign":
   35
  elseif name="dollar":
   36
  elseif name="percent":
   37
  elseif name="ampersand":
   38
  elseif name="quoteright":
   39
  elseif name="parenleft":
   40
  elseif name="parenright":
   41
  elseif name="asterisk":
   42
  elseif name="plus":
   43
  elseif name="comma":
   44
  elseif name="hyphen":
   45
  elseif name="period":
   46
  elseif name="slash":
   47
  elseif name="zero":
   48
  elseif name="one":
   49
  elseif name="two":
   50
  elseif name="three":
   51
  elseif name="four":
   52
  elseif name="five":
   53
  elseif name="six":
   54
  elseif name="seven":
   55
  elseif name="eight":
   56
  elseif name="nine":
   57
  elseif name="colon":
   58
  elseif name="semicolon":
   59
  elseif name="less":
   60
  elseif name="equal":
   61
  elseif name="greater":
   62
  elseif name="question":
   63
  elseif name="at":
   64
  elseif name="A":
   65
  elseif name="B":
   66
  elseif name="C":
   67
  elseif name="D":
   68
  elseif name="E":
   69
  elseif name="F":
   70
  elseif name="G":
   71
  elseif name="H":
   72
  elseif name="I":
   73
  elseif name="J":
   74
  elseif name="K":
   75
  elseif name="L":
   76
  elseif name="M":
   77
  elseif name="N":
   78
  elseif name="O":
   79
  elseif name="P":
   80
  elseif name="Q":
   81
  elseif name="R":
   82
  elseif name="S":
   83
  elseif name="T":
   84
  elseif name="U":
   85
  elseif name="V":
   86
  elseif name="W":
   87
  elseif name="X":
   88
  elseif name="Y":
   89
  elseif name="Z":
   90
  elseif name="bracketleft":
   91
  elseif name="backslash":
   92
  elseif name="bracketright":
   93
  elseif name="asciicircum":
   94
  elseif name="underscore":
   95
  elseif name="quoteleft":
   96
  elseif name="a":
   97
  elseif name="b":
   98
  elseif name="c":
   99
  elseif name="d":
   100
  elseif name="e":
   101
  elseif name="f":
   102
  elseif name="g":
   103
  elseif name="h":
   104
  elseif name="i":
   105
  elseif name="j":
   106
  elseif name="k":
   107
  elseif name="l":
   108
  elseif name="m":
   109
  elseif name="n":
   110
  elseif name="o":
   111
  elseif name="p":
   112
  elseif name="q":
   113
  elseif name="r":
   114
  elseif name="s":
   115
  elseif name="t":
   116
  elseif name="u":
   117
  elseif name="v":
   118
  elseif name="w":
   119
  elseif name="x":
   120
  elseif name="y":
   121
  elseif name="z":
   122
  elseif name="braceleft":
   123
  elseif name="bar":
   124
  elseif name="braceright":
   125
  elseif name="asciitilde":
   126
  elseif name="dash":
   127
  elseif name="Abreve":
   128
  elseif name="Aogonek":
   129
  elseif name="Cacute":
   130
  elseif name="Ccaron":
   131
  elseif name="Dcaron":
   132
  elseif name="Ecaron":
   133
  elseif name="Eogonek":
   134
  elseif name="Gbreve":
   135
  elseif name="Lacute":
   136
  elseif name="Lcaron":
   137
  elseif name="Lslash":
   138
  elseif name="Nacute":
   139
  elseif name="Ncaron":
   140
  elseif name="Eng":
   141
  elseif name="Ohungarumlaut":
   142
  elseif name="Racute":
   143
  elseif name="Rcaron":
   144
  elseif name="Sacute":
   145
  elseif name="Scaron":
   146
  elseif name="Scedilla":
   147
  elseif name="Tcaron":
   148
  elseif name="Tcedilla":
   149
  elseif name="Uhungarumlaut":
   150
  elseif name="Uring":
   151
  elseif name="Ydieresis":
   152
  elseif name="Zacute":
   153
  elseif name="Zcaron":
   154
  elseif name="Zdotaccent":
   155
  elseif name="IJ":
   156
  elseif name="Idotaccent":
   157
  elseif name="dcroat":
   158
  elseif name="section":
   159
  elseif name="abreve":
   160
  elseif name="aogonek":
   161
  elseif name="cacute":
   162
  elseif name="ccaron":
   163
  elseif name="dcaron":
   164
  elseif name="ecaron":
   165
  elseif name="eogonek":
   166
  elseif name="gbreve":
   167
  elseif name="lacute":
   168
  elseif name="lcaron":
   169
  elseif name="lslash":
   170
  elseif name="nacute":
   171
  elseif name="ncaron":
   172
  elseif name="eng":
   173
  elseif name="ohungarumlaut":
   174
  elseif name="racute":
   175
  elseif name="rcaron":
   176
  elseif name="sacute":
   177
  elseif name="scaron":
   178
  elseif name="scedilla":
   179
  elseif name="tcaron":
   180
  elseif name="tcedilla":
   181
  elseif name="uhungarumlaut":
   182
  elseif name="uring":
   183
  elseif name="ydieresis":
   184
  elseif name="zacute":
   185
  elseif name="zcaron":
   186
  elseif name="zdotaccent":
   187
  elseif name="ij":
   188
  elseif name="exclamdown":
   189
  elseif name="questiondown":
   190
  elseif name="sterling":
   191
  elseif name="Agrave":
   192
  elseif name="Aacute":
   193
  elseif name="Acircumflex":
   194
  elseif name="Atilde":
   195
  elseif name="Adieresis":
   196
  elseif name="Aring":
   197
  elseif name="AE":
   198
  elseif name="Ccedilla":
   199
  elseif name="Egrave":
   200
  elseif name="Eacute":
   201
  elseif name="Ecircumflex":
   202
  elseif name="Edieresis":
   203
  elseif name="Igrave":
   204
  elseif name="Iacute":
   205
  elseif name="Icircumflex":
   206
  elseif name="Idieresis":
   207
  elseif name="Eth":
   208
  elseif name="Ntilde":
   209
  elseif name="Ograve":
   210
  elseif name="Oacute":
   211
  elseif name="Ocircumflex":
   212
  elseif name="Otilde":
   213
  elseif name="Odieresis":
   214
  elseif name="OE":
   215
  elseif name="Oslash":
   216
  elseif name="Ugrave":
   217
  elseif name="Uacute":
   218
  elseif name="Ucircumflex":
   219
  elseif name="Udieresis":
   220
  elseif name="Yacute":
   221
  elseif name="Thorn":
   222
  elseif name="Germandbls": 
   223
  elseif name="agrave":
   224
  elseif name="aacute":
   225
  elseif name="acircumflex":
   226
  elseif name="atilde":
   227
  elseif name="adieresis":
   228
  elseif name="aring":
   229
  elseif name="ae":
   230
  elseif name="ccedilla":
   231
  elseif name="egrave":
   232
  elseif name="eacute":
   233
  elseif name="ecircumflex":
   234
  elseif name="edieresis":
   235
  elseif name="igrave":
   236
  elseif name="iacute":
   237
  elseif name="icircumflex":
   238
  elseif name="idieresis":
   239
  elseif name="eth":
   240
  elseif name="ntilde":
   241
  elseif name="ograve":
   242
  elseif name="oacute":
   243
  elseif name="ocircumflex":
   244
  elseif name="otilde":
   245
  elseif name="odieresis":
   246
  elseif name="oe":
   247
  elseif name="oslash":
   248
  elseif name="ugrave":
   249
  elseif name="uacute":
   250
  elseif name="ucircumflex":
   251
  elseif name="udieresis":
   252
  elseif name="yacute":
   253
  elseif name="thorn":
   254
  elseif name="germandbls":
   255
  else:
   errmessage("unknown name to encode");
  fi
 else:
  errmessage("tell me somewhere that the font_coding_scheme is T1");
 fi
enddef;

% pen settings %
path penpath;
if penshape=1:
 penpath=fullcircle xscaled px yscaled py rotated prot;
 pickup pencircle xscaled px yscaled py rotated prot; 
elseif penshape=2:
 penpath=unitsquare shifted -(.5,.5) xscaled px yscaled py rotated prot;
 pickup pensquare xscaled px yscaled py rotated prot; 
elseif penshape=3:
 penpath=unitsquare shifted -(.5,.5) xscaled px yscaled eps rotated prot;
 pickup penrazor xscaled px rotated prot;
elseif penshape=4:
 penpath=((dir(-30)--dir(90)--dir(210)--cycle) xscaled .5px yscaled .5py rotated prot);
 capsule_def(pentriangle) makepen(penpath);
 pickup pentriangle;
elseif penshape=5:
 penpath=((dir(-54)--dir(18)--dir(90)--dir(162)--dir(234)--cycle) xscaled .5px yscaled .5py rotated prot);
 capsule_def(penpentagon) makepen(penpath);
 pickup penpentagon; 
fi
cornerpen:=savepen;

def adjustwidth(expr left_adjustment,right_adjustment) = 
 l:=-hround(left_adjustment*hppp);
 interim xoffset:=-l; 
 charwd:=charwd+left_adjustment+right_adjustment; 
 r:=l+hround(charwd*hppp);
 w:=r-hround(right_adjustment*hppp); 
enddef;

def overdraw expr c = erase fill c; draw c enddef;

def overdrawsupreme expr c = begingroup
 picture region; region := nullpicture;
 interim turningcheck := 0; addto region contour c;
 cull region dropping (0,0);
 cullit; addto currentpicture also -region ; cullit;
 draw c endgroup enddef;

% interdotdraw marks a path with equally spaced dots
% the vertices inbetween the starting and end vertices 
% are generally not hit exactly (in contrast to dotdraw)
def interdotdraw expr c =
if drawingstyle=1:
 pickup cornerpen;
 draw c;
elseif (drawingstyle=2) or (drawingstyle=3):
 begingroup
  pickup pencircle scaled ptiny;
  save arclengths,diameter,divlength,divnumber,j,hastostop;
  numeric diameter,divlength,divnumber,j;
  boolean hastostop;
  pair arclengths[]; % needs to be in this format to avoid overflows
  % note: the pair (11,500) means 11500
  diameter:=max(px,py);
  % draw first point:
  if drawingstyle=3: overdraw else: fill fi
   penpath shifted point 0 of c;
  % calculate the arclengths from the beginning to every 1/100-th part
  % of a subpath, hence arclength[200] is the length of the subpath(0,2)
  arclengths[0]:=(0,0);
  for t=1 upto (100*length(c)):
   arclengths[t]:=arclengths[t-1]
    +(0,length((point ((t-1)/100) of c)-(point (t/100) of c)));
   if ypart(arclengths[t])>1000:
    arclengths[t]:=(xpart(arclengths[t])+1,ypart(arclengths[t])-1000);
   fi
  endfor
  divnumber:=round(ypart(arclengths[100*length(c)])/(dnum*diameter)
  +xpart(arclengths[100*length(c)])/(dnum*diameter)*1000); % number of points on one subpath
  divlength:=ypart(arclengths[100*length(c)])/divnumber
  +xpart(arclengths[100*length(c)])/divnumber*1000; % distance inbetween dots
  j:=0; % current path time (will be increased)
  for k=1 upto (divnumber-1): 
   % search for the pathtime j with the correct distance:
   hastostop:=false; % condition for the forever-loop
   forever:
    if (j>=100*length(c)) or 
      ((ypart(arclengths[j])
      +1000*xpart(arclengths[j]))>=k*divlength):
      % check if j or j-1 is the closer index:
      if abs(ypart(arclengths[j-1])
      +1000*xpart(arclengths[j-1])-k*divlength)
      <
      abs((ypart(arclengths[j])
      +1000*xpart(arclengths[j]))-k*divlength): 
       j:=j-1;
      fi
      hastostop:=true;
     fi
    exitif hastostop;
    j:=j+1;
   endfor
   if drawingstyle=3: overdraw else: fill fi
    penpath shifted point (j/100) of c;
  endfor
  if drawingstyle=3: overdraw else: fill fi
   penpath shifted point length(c) of c;
 endgroup
fi
enddef;

% dotdraw marks a path with approximately equally spaced dots
% the vertices inbetween the starting and end vertices 
% are hit exactly (in contrast to interdotdraw)
def dotdraw expr c =
if drawingstyle=1:
 pickup cornerpen;
 draw c;
elseif (drawingstyle=2) or (drawingstyle=3):
 begingroup
  pickup pencircle scaled ptiny;
  save arclengths,diameter,divlength,divnumber,j,hastostop;
  numeric diameter,divlength,divnumber,j;
  boolean hastostop;
  pair arclengths[]; % needs to be in this format to avoid overflows
  % note: the pair (11,500) means 11500
  diameter:=max(px,py);
  % draw first point:
  if drawingstyle=3: overdraw else: fill fi
   penpath shifted point 0 of c;
  % calculate the arclengths from the beginning to every 1/100-th part
  % of a subpath, hence arclength[200] is the length of the subpath(0,2)
  arclengths[0]:=(0,0);
  for t=1 upto (100*length(c)):
   arclengths[t]:=arclengths[t-1]
    +(0,length((point ((t-1)/100) of c)-(point (t/100) of c)));
   if ypart(arclengths[t])>1000:
    arclengths[t]:=(xpart(arclengths[t])+1,ypart(arclengths[t])-1000);
   fi
  endfor
  for i=1 upto length(c): % i is the subpath index
   divnumber:=round(ypart(arclengths[100*i]-arclengths[100*(i-1)])/(dnum*diameter)
   +xpart(arclengths[100*i]-arclengths[100*(i-1)])/(dnum*diameter)*1000); % number of points on one subpath
   divlength:=ypart(arclengths[100*i]-arclengths[100*(i-1)])/divnumber
   +xpart(arclengths[100*i]-arclengths[100*(i-1)])/divnumber*1000; % distance inbetween dots
   j:=0; % current path time (will be increased)
   for k=1 upto (divnumber-1): 
    % search for the pathtime j with the correct distance:
    hastostop:=false; % condition for the forever-loop
    forever:
     if (j>=100*length(c)) or 
      ((ypart(arclengths[j]-arclengths[100*(i-1)])
      +1000*xpart(arclengths[j]-arclengths[100*(i-1)]))>=k*divlength):
      % check if j or j-1 is the closer index:
      if abs((ypart(arclengths[j-1]-arclengths[100*(i-1)])
      +1000*xpart(arclengths[j-1]-arclengths[100*(i-1)]))-k*divlength)
      <
      abs((ypart(arclengths[j]-arclengths[100*(i-1)])
      +1000*xpart(arclengths[j]-arclengths[100*(i-1)]))-k*divlength): 
       j:=j-1;
      fi
      hastostop:=true;
     fi
     exitif hastostop;
     j:=j+1;
    endfor
    if drawingstyle=3: overdraw else: fill fi
     penpath shifted point (j/100) of c;
   endfor
   if drawingstyle=3: overdraw else: fill fi
    penpath shifted point i of c;
  endfor
 endgroup
fi
enddef;

%code_offset:=0; %later used for small caps

numeric charwidths_[];
numeric charheights_[];
numeric chardepths_[];
numeric charitalcorrs_[];
picture charpictures_[];
pair charanchortops_[]; 
pair charanchorbots_[]; 
pair charanchortoprights_[];

def clpchar(expr name, width, height, depth) =
 beginchar(enc(name),width,height,depth)
enddef;

%def ffmchar(expr name, unit_width, height, depth) =
% beginchar(enc(name)+code_offset,if unit_width=0: 0 else: unit_width*u#+2s# fi,height,depth);
% pickup logo_pen 
%enddef;

%extra_endchar := extra_endchar&"charpictures_[charcode]:=currentpicture;"
% &"charwidths_[charcode]=charwd;"
% &"charheights_[charcode]=charht;"
% &"chardepths_[charcode]=chardp;"
% &"charitalcorrs_[charcode]=charic;";

def ffmcombinedchar(expr namea,nameb,namec,anchor,height,depth) =
 beginchar(enc(namea)+code_offset,charwidths_[enc(nameb)+code_offset],height,depth);
 charic:=charitalcorrs_[enc(nameb)+code_offset];
 addto currentpicture also charpictures_[enc(nameb)+code_offset];
 if anchor="top":
  addto currentpicture also charpictures_[enc(namec)] shifted 
  ((charanchortops_[enc(nameb)+code_offset]-charanchortops_[enc(namec)]) slanted slant);
 elseif anchor="bot":
  addto currentpicture also charpictures_[enc(namec)] shifted 
  ((charanchorbots_[enc(nameb)+code_offset]-charanchorbots_[enc(namec)]) slanted slant);
 elseif anchor="topright":
  addto currentpicture also charpictures_[enc(namec)] shifted 
  ((charanchortoprights_[enc(nameb)+code_offset]-charanchortoprights_[enc(namec)]) slanted slant);
 else:
  errmessage "Wrong anchor name";
 fi
 endchar;
enddef;

% chain two chars like "f" and "l" to "fl"
def ffmchainedchar(expr namea,nameb,namec) =
 beginchar(
  enc(namea)+code_offset,
  charwidths_[enc(nameb)+code_offset]
  +charwidths_[enc(namec)+code_offset],
  max(charheights_[enc(nameb)+code_offset],
  +charheights_[enc(namec)+code_offset]),
  max(chardepths_[enc(nameb)+code_offset],
  +chardepths_[enc(namec)]+code_offset)
 );
 charic:=charitalcorrs_[enc(nameb)+code_offset]; 
 addto currentpicture also charpictures_[enc(nameb)+code_offset];
 addto currentpicture also charpictures_[enc(namec)+code_offset] 
  shifted (charwidths_[enc(nameb)+code_offset]*hppp,0);
 endchar;
enddef;

% copy a letter nameb to namea
def ffmcopiedchar(expr namea,nameb) =
 beginchar(
  enc(namea),
  charwidths_[enc(nameb)],
  charheights_[enc(nameb)],
  chardepths_[enc(nameb)]
 );
 charic:=charitalcorrs_[enc(nameb)]; 
 addto currentpicture also charpictures_[enc(nameb)];
 endchar;
enddef;

% kernings
numeric kernclassesf_[][], % list of kerning classes (first position)
 kernclassess_[][], % list of kerning classes (second position)
 ligmatrix_[][][]; % matrix with kern and ligature entries: 255 times X times 2
kernclassesf_[0][0]=0; % number of kernclassesf (will be increased)
kernclassess_[0][0]=0; % number of kernclassess (will be increased)
for i=0 upto 255:
 ligmatrix_[i][0][0]:=0; % every char i begins with no kernings (will be increased)
endfor

def addkernclassf(text a) = % add a kerning class to kernclassesf
 kernclassesf_[0][0]:=kernclassesf_[0][0]+1; % number of kernclassesf
 begingroup
  save i;
  i:=0; % number of chars in current class
  for b=a:
   i:=i+1;
   kernclassesf_[kernclassesf_[0][0]][i]:=enc(b);
  endfor
  % number of chars in current class is stored at 0th position
  kernclassesf_[kernclassesf_[0][0]][0]:=i; 
 endgroup
enddef;

def addkernclasss(text a) = % add a kerning class to kernclassess 
 kernclassess_[0][0]:=kernclassess_[0][0]+1; % number of kernclassess
 begingroup
  save i,n;
  n:=kernclassess_[0][0]; % current last class (being written)
  i:=0; % number of chars in current class
  for b=a:
   i:=i+1;
   kernclassess_[n][i]:=enc(b);
  endfor
  % number of chars in current class is stored at 0th position
  kernclassess_[n][0]:=i; 
 endgroup
enddef;

def addlig(expr first,second,third) = % replace first and second to the ligature third
 begingroup
  save i,n;
  i:=enc(first); % encoding number of first
  ligmatrix_[i][0][0]:=ligmatrix_[i][0][0]+1;
  n:=ligmatrix_[i][0][0]; % current last ligature entry index of i (being written)
  ligmatrix_[i][0][0]:=n;
  ligmatrix_[i][n][0]:=-enc(second); % the minus is a flag for "ligature" instead of "kern"
  ligmatrix_[i][n][1]:=enc(third);
 endgroup
enddef;

def addclasskern(expr first,second,kvalue) = % kern all chars of first class and second class by kvalue
 begingroup
  save i,j,m,n;
  % get the indices i and j of the two classes:
  i:=0; % default value (cannot be true)
  j:=0; % default value (cannot be true)
  forever:
   i:=i+1;
   exitif kernclassesf_[i][1]=enc(first);
   if i>255:
    errmessage("unknown first kerning class");
   fi
  endfor
  forever:
   j:=j+1;
   exitif kernclassess_[j][1]=enc(second);
   if j>255:
    errmessage("unknown first kerning class");
   fi
  endfor
  for k=1 upto kernclassesf_[i][0]:
   m:=kernclassesf_[i][k]; % current first glyph
   for l=1 upto kernclassess_[j][0]:
    ligmatrix_[m][0][0]:=ligmatrix_[m][0][0]+1;
    n:=ligmatrix_[m][0][0]; % current last entry index (being written)
    ligmatrix_[m][n][0]:=kernclassess_[j][l]; 
    ligmatrix_[m][n][1]:=kvalue;
   endfor
  endfor
 endgroup
enddef;

def writeligtable = % write all kernings/ligatures at once
 begingroup
  save n;
  for i=0 upto 255: % current glyph i
   n:=ligmatrix_[i][0][0]; % number n of entries  for glyph i
   if n<>0: % skip empty entries 
    ligtable i:
    for j=1 upto n-1: %last entry needs a semicolon
     if ligmatrix_[i][j][0]<0: % the minus is a flag for "ligature"
      -ligmatrix_[i][j][0]=:ligmatrix_[i][j][1],
     else:
      ligmatrix_[i][j][0] kern ligmatrix_[i][j][1],
     fi
    endfor
    %last entry needs a semicolon:
    if ligmatrix_[i][n][0]<0: % the minus is a flag for "ligature"
     -ligmatrix_[i][n][0]=:ligmatrix_[i][n][1];
    else:
     ligmatrix_[i][n][0] kern ligmatrix_[i][n][1];
    fi
   fi
  endfor
 endgroup
enddef;