summaryrefslogtreecommitdiff
path: root/fonts/cm/bbm/blbbase.mf
blob: dac11cab49d6d28a60c7e77ba3241d5728a643b5 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
% Copyright 1993 Gilles F. Robert.
% You may freely use, modify and/or distribute this file.
% This statement added 2008/11/14 by Clea F. Rees on the basis of the email exchange archived at http://lists.debian.org/debian-tex-maint/2008/05/msg00040.html.
%
% 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]{z.D@2-z.G@2}
  ...{z$$-z$}z.D@2--z.D@3--z.D@0--z.G@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 y@1-slab-.5drop=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]{z.D@2-z.G@2}
  ...{z$$-z$}z.D@2--z.D@3--z.D@0--z.G@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'),x@2r-x.G@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;