summaryrefslogtreecommitdiff
path: root/Master/texmf-dist/fonts/source/public/bookhands/tgothtitle.mf
diff options
context:
space:
mode:
Diffstat (limited to 'Master/texmf-dist/fonts/source/public/bookhands/tgothtitle.mf')
-rw-r--r--Master/texmf-dist/fonts/source/public/bookhands/tgothtitle.mf842
1 files changed, 842 insertions, 0 deletions
diff --git a/Master/texmf-dist/fonts/source/public/bookhands/tgothtitle.mf b/Master/texmf-dist/fonts/source/public/bookhands/tgothtitle.mf
new file mode 100644
index 00000000000..1aa2c111689
--- /dev/null
+++ b/Master/texmf-dist/fonts/source/public/bookhands/tgothtitle.mf
@@ -0,0 +1,842 @@
+%%
+%% This is file `tgothtitle.mf',
+%% generated with the docstrip utility.
+%%
+%% The original source files were:
+%%
+%% tgothic.dtx (with options: `mfd')
+%%
+%% Copyright 1999 Peter R. Wilson
+%%
+%% This program is provided under the terms of the
+%% LaTeX Project Public License distributed from CTAN
+%% archives in directory macros/latex/base/lppl.txt.
+%%
+%% Author: Peter Wilson (CUA)
+%% now at: peter.r.wilson@boeing.com
+%%
+def makebox(text rule) =
+ for y=0,half_height,cap_height,body_height,x_height,-desc_depth,-body_depth:
+ rule((l,y)t_,(r,y)t_); endfor % horizontals
+ for x=l,r: rule((x,-body_depth)t_,(x,body_height)t_); endfor % verticals
+ for x=u*(1+floor(1/u)) step u until r-1:
+ rule((x,-body_depth)t_,(x,body_height)t_); endfor % more verticals
+ if charic<>0:
+ rule((r+charic*pt,h.o_),(r+charic*pt,.5h.o_)); fi % italic correction
+enddef;
+
+
+def proofpcbb(suffix $)(expr xoff, yoff) =
+if proofing > 0:
+ x$bl = x$ - xoff; y$bl = y$ - yoff; % Bottom Left Hand Corner
+ z$br = (x$bl+side, y$bl); % BRHC
+ z$tr = (x$bl+side, y$bl+side); % TRHC
+ z$tl = (x$bl, y$bl+side); % TLHC
+ z$bc = 1/2[z$bl,z$br]; z$tc = 1/2[z$tl,z$tr]; % horizontal mid points
+ pair hc, vc;
+ hc = (2u,0); vc = (0,2u);
+ pickup pensquare scaled 2;
+ for s = z$bl, z$br, z$tr, z$tl, z$bc, z$tc:
+ draw s-hc--s+hc;
+ draw s-vc--s+vc;
+ endfor
+fi
+enddef;
+
+
+def tgothic_font_setup= % contains special stuff for tgothic fonts
+ define_pixels(side,half_height,carol_height,comma_width);
+ define_pixels(u,dot_size,letter_size,cap_height,width_adj,serif_fit,
+ cap_serif_fit,jut,clubjut,cap_jut,trijut);
+ define_pixels(fig_width);
+ define_whole_pixels(letter_fit,sb,cap_sb);
+ define_whole_vertical_pixels(body_height,asc_height,cap_height,x_height,
+ desc_depth,body_depth,fig_height);
+ define_corrected_pixels(o);
+ define_blacker_pixels(thick,thin);
+ define_pixels(stem_width);
+ define_pixels(perpdec,angdec);
+ let adjust_fit = normal_adjust_fit;
+ pickup pencircle scaled thin;
+ stylus:=savepen;
+ pickup pencircle scaled (1.5thin);
+ thickstylus:=savepen;
+ pickup pencircle xscaled thick yscaled thin rotated pangle;
+ quill:=savepen;
+
+ pickup pencircle xscaled 3/4thick yscaled thin rotated pangle;
+ threequarterquill := savepen;
+
+ pickup pencircle xscaled 1/2thick yscaled thin rotated pangle;
+ halfquill := savepen;
+
+ pickup pencircle xscaled 1/4thick yscaled thin rotated pangle;
+ quarterquill := savepen;
+
+ numeric pcshiftx#; % x value of LHS of box wrt origin of char box
+ define_pixels(pcshiftx);
+ numeric sqxside#; % x size of the square
+ numeric sqyside#; % y size of the square
+ define_pixels(sqxside,sqyside);
+
+enddef; % end of tgothic_font_setup
+
+boolean ductus;
+ductus:=false;
+numeric qhor, qvert;
+qhor:=cosd(pangle); qvert:=sind(pangle);
+pair pdir; pdir=dir(pangle);
+pair ppdir; ppdir=dir(pangle+90);
+
+def draw_upforkstem(suffix $, $$)=
+ pen oldpen; oldpen:=currentpen;
+ x$a=x$; top y$a = bot y$; % top of straight stem
+ draw z$a--z$$; % straight part
+ z$b = (rt x$, y$); z$c = (x$b, top y$a);
+ z$d = (lft x$, bot y$a); z$e = (x$d, y$);
+ pickup stylus;
+ rt x$cc = x$c; y$cc = y$c;
+ lft x$bb = x$b; y$bb = y$b;
+ lft x$dd = x$d; y$dd = y$d;
+ rt x$ee = x$e; y$ee = y$e;
+ filldraw z$a--z$bb..z$cc--cycle; % fork
+ filldraw z$a--z$dd..z$ee--cycle;
+ pickup oldpen;
+ labels($a,$b,$c,$d,$e);
+enddef; % end of draw_upforkstem
+
+
+def draw_downforkstem(suffix $, $$)=
+ pen oldpen; oldpen:=currentpen;
+ x$$a=x$$; bot y$$a = top y$$; % bottom of straight stem
+ draw z$--z$$a; % straight part
+ z$$b = (rt x$$, y$$); z$$c = (x$$b, top y$$a);
+ z$$d = (lft x$$, bot y$$a); z$$e = (x$$d, y$$);
+ pickup stylus;
+ rt x$$cc = x$$c; y$$cc = y$$c;
+ lft x$$bb = x$$b; y$$bb = y$$b;
+ lft x$$dd = x$$d; y$$dd = y$$d;
+ rt x$$ee = x$$e; y$$ee = y$$e;
+ filldraw z$$a--z$$bb..z$$cc--cycle; % fork
+ filldraw z$$a--z$$dd..z$$ee--cycle;
+ pickup oldpen;
+ labels($$a,$$b,$$c,$$d,$$e);
+enddef; % end of draw_downforkstem
+
+
+def draw_upcurlstem(suffix $, $$)=
+ pen oldpen; oldpen:=currentpen;
+ path curlp[]; numeric curln[];
+ x$a=x$; top y$a = y$; % top of straight stem
+ draw z$a--z$$; % straight part
+ curln1 := rt x$a - lft x$a; % stem width
+ x$b = x$a - 4/2curln1; y$b = y$a; % left jut
+ curlp1 := z$a{-pdir}..{left}z$b;
+ draw curlp1;
+
+ x$c = x$a-3curln1; top y$c = bot y$a-1/2curln1;
+ x$f = x$b; y$f = 1/3[y$c,y$b];
+ x$tb = rt x$b; y$tb = top y$b;
+ x$bb = lft x$b; y$bb = bot y$b;
+ curlp2 := z$tb--z$bb..{down}z$c..{ppdir}z$f;
+ pickup stylus;
+ draw curlp2;
+ pickup oldpen;
+ labels($a,$b,$c,$d,$e,$f);
+enddef; % end of draw_upcurlstem
+
+
+def draw_updiamondstem(suffix $, $$)(expr fr, minfr, wd, phi)=
+ pen oldpen; oldpen:=currentpen;
+ numeric sj; sj := fr*stem_width; % jut distance
+ numeric sjr; sjr := minfr*stem_width; % right jut distance
+ numeric jw; jw := wd*stem_width; % jut width
+ %% $b is bottom left of jut, on LHS of stem
+ %% $c is leftmost point on jut
+ %% $d is topmost point on jut
+ %% $g is topmost point on stem
+ %% $e is on exprapolation of line from $d through $g
+ %% i.e., the rightmost point on jut
+ %% $f is on RHS of stem
+ pickup quill;
+ x$b = lft x$;
+ x$c = x$b - sj; y$c = y$ - jw*(cosd phi); % $c done
+ y$b = y$c - sj*(sind phi); % $b done
+ x$d = x$c + jw*(sind phi); y$d = y$; % $d done
+ x$g = x$f = rt x$;
+ y$g = y$ - (x$g-x$d)*(sind phi)/(cosd phi); % $g done
+ x$a = x$; top y$a = y$g; % $a done
+ x$e = x$g + sjr; z$e = whatever[z$d,z$g]; % $e done
+ z$f-z$e = whatever*(z$c-z$d); % $f done
+ x$h = x$b; y$h = bot y$a;
+ draw z$a--z$$; % straight part
+ pickup stylus;
+ lft x$cc = x$c; y$cc = y$c;
+ x$dd = x$d; top y$dd = y$d;
+ rt x$ee = x$e; bot y$ee=y$e;
+ filldraw z$b--z$cc--z$dd--z$ee--z$f--cycle; % diamond
+ if y$b > y$h:
+ lft x$hh = x$h; y$hh=y$h;
+ filldraw z$b--z$hh--z$g--cycle;
+ fi
+ pickup oldpen;
+ labels($a,$b,$c,$d,$e,$f);
+enddef; % end of draw_updiamondstem
+
+
+def draw_downdiamondstem(suffix $, $$)(expr fr, minfr, wd, phi)=
+ pen oldpen; oldpen:=currentpen;
+ numeric sj; sj := fr*stem_width; % (left) jut distance
+ numeric sjr; sjr := minfr*stem_width;; % right jut distance
+ numeric jw; jw := wd*stem_width; % jut width
+ %% $$b is top right of jut, on RHS of stem
+ %% $$c is rightmost point on jut
+ %% $$d is bottommost point on jut
+ %% $$g is bottommost point on stem
+ %% $$e is on exprapolation of line from $d through $g
+ %% i.e., the leftmost point on jut
+ %% $$f is on LHS of stem
+ pickup quill;
+ x$$b = rt x$$;
+ x$$c = x$$b + sj; y$$c = y$$ + jw*(cosd phi); % $$c done
+ y$$b = y$$c + sj*(sind phi); % $$b done
+ x$$d = x$$c - jw*(sind phi); y$$d = y$$; % $$d done
+ x$$g = x$$f = lft x$$;
+ y$$g = y$$ + (x$$d-x$$g)*(sind phi)/(cosd phi); % $$g done
+ x$$a = x$$; bot y$$a = y$$g; % $$a done
+ x$$e = x$$g - sjr; z$$e = whatever[z$$d,z$$g]; % $$e done
+ z$$f-z$$e = whatever*(z$$c-z$$d); % $$f done
+ x$$h = x$$b; y$$h = top y$$a;
+ draw z$--z$$a; % straight part
+ pickup stylus;
+ rt x$$cc = x$$c; y$$cc=y$$c;
+ x$$dd = x$$d; bot y$$dd = y$$d;
+ lft x$$ee = x$$e; top y$$ee = y$$e;
+ filldraw z$$b--z$$cc--z$$dd--z$$ee--z$$f--cycle; % diamond
+ if y$$b < y$$h:
+ rt x$$hh = x$$h; y$$hh=y$$h;
+ filldraw z$$b--z$$hh--z$$g--cycle;
+ fi
+ pickup oldpen;
+ labels($$a,$$b,$$c,$$d,$$e,$$f);
+enddef; % end of draw_downdiamondstem
+
+
+def draw_serif(suffix $, $$)(expr fr)=
+ numeric beta, ajut, bjut;
+ beta=1-fr;
+ ajut=fr*jut; bjut=beta*jut;
+ pair vec[]; vec1=unitvector(z$$-z$);
+ vec2=ajut*vec1;
+ z$a=z$ shifted vec2;
+ z$b=z$a rotatedaround (z$,-90);
+ boolean top_serif;
+ if y$>y$$:
+ top_serif := true;
+ z$c=z$b shifted (-bjut*pdir);
+ else:
+ top_serif:=false;
+ z$c=z$b shifted (bjut*pdir);
+ fi
+ if top_serif:
+ draw z$c--z$b{pdir}..{z$$-z$}z$a; % the serif
+ else:
+ draw z$c--z$b{-pdir}..{z$$-z$}z$a;
+ fi
+ labels($a,$b,$c);
+enddef; % end of draw_serif
+
+
+def draw_roundserif(suffix $, $$)(expr fr)=
+ draw_serif($, $$, fr);
+ undraw z$--z$a;
+enddef; % end of draw_roundserif
+
+
+def draw_flatserif(suffix $, $$)(expr fr)=
+ numeric beta, ajut, bjut;
+ beta=1-fr;
+ ajut=fr*jut; bjut=beta*jut;
+ pair vec[]; vec1=unitvector(z$$-z$);
+ vec2=ajut*vec1;
+ z$a=z$ shifted vec2;
+%%% z$b=z$a rotatedaround (z$,-90);
+ boolean top_serif;
+ if y$>y$$:
+ top_serif := true;
+ z$c=z$ shifted (-jut*pdir);
+ else:
+ top_serif:=false;
+ z$c=z$ shifted (jut*pdir);
+ fi
+ z$b = fr[z$,z$c];
+ draw z$a--z$;
+ if top_serif:
+ draw z$c--z$b{pdir}..{z$$-z$}z$a; % the serif
+ else:
+ draw z$c--z$b{-pdir}..{z$$-z$}z$a;
+ fi
+ labels($a,$b,$c);
+enddef; % end of draw_flatserif
+
+
+def draw_clubserif(suffix $, $$)(expr fr)=
+ numeric beta, ajut, bjut;
+%% beta=1-fr;
+ ajut=clubjut; bjut=beta*jut;
+ pair vec[]; vec1=unitvector(z$$-z$);
+%% vec2=ajut*vec1;
+%% z$a=z$ shifted vec2;
+ boolean top_serif;
+ if y$>y$$:
+ top_serif := true;
+ z$c=z$ shifted (-clubjut*pdir);
+ else:
+ top_serif:=false;
+ z$c=z$ shifted (clubjut*pdir);
+ fi
+ z$a = fr[z$,z$$];
+ draw z$c..z$a{vec1};
+ labels($a,$b,$c);
+enddef; % end of draw_clubserif
+
+
+def draw_triserif(suffix $)(expr tj)=
+ pen oldpen; oldpen:=currentpen;
+ pickup quill;
+ x$ts1'=lft x$; y$ts1'=bot y$;
+ pickup stylus;
+ lft x$ts1=x$ts1'; bot y$ts1=y$ts1';
+ x$ts2=x$ts1-tj; z$ts2=whatever[z$,z$ts1];
+ x$ts3=x$ts1; y$ts3=y$ts2-tj;
+ pickup stylus;
+%% filldraw z$ts1--z$ts2--z$ts3--cycle;
+ filldraw z$--z$ts2--z$ts3--cycle;
+ pickup oldpen;
+ labels($ts1,$ts2,$ts3);
+enddef; % end of draw_triserif
+
+
+def draw_istem(suffix $, $$)(expr fr)=
+ draw_serif($, $$, fr); % top serif
+ draw_serif($$, $, fr); % bottom serif
+ draw z$a--z$$a; % the stem
+enddef; % end of draw_istem
+
+
+def draw_tstem(suffix $, $$)(expr fr)=
+%% draw_serif($$, $, fr); % the serif
+%% draw z$--z$$a; % the stem
+ draw z$--z$$;
+enddef; % end of draw_tstem
+
+
+def draw_tlserif(suffix $, $$)(expr fr)=
+ draw_serif($, $$, fr); % the serif
+ draw z$a--z$$; % the stem
+enddef; % end of draw_tlserif
+
+
+def draw_flick(suffix $)(expr rise, fall, fjut)=
+ rt x$b = x1+fjut; top y$b=y$-fall;
+ x$a=0.5[x$,x$b]; top y$a=y$+rise;
+ draw z$..z$a..z$b;
+ labels($a,$b);
+enddef; % end of draw_flick
+
+
+def draw_wave(suffix $,$$)(expr f)=
+ x$wl=x$; y$wl=y$-f;
+ x$wr=x$$; y$wr=y$$+f;
+ z$wc=0.5[z$wl,z$wr];
+ draw z$wl{pdir}..z$wc{right}..{pdir}z$wr;
+ labels($wl,$wc,$wr);
+enddef; % end of draw_wave
+
+def draw_tail(suffix $)(expr fj)=
+ pen oldpen; oldpen:=currentpen;
+ pickup quill;
+ x$tl' = lft x$; y$tl=bot y$;
+ pickup stylus;
+ lft x$tl=x$tl';
+ x$tb=x$tl-fj; bot y$tb=y$tl-1/2desc_depth;
+ filldraw z${down}..{-pdir}z$tb & z$tb{pdir}..{up}z$tl--cycle;
+ pickup oldpen;
+ labels($tb,$tl);
+enddef; % end of draw_tail
+
+def draw_triangle(suffix $)(expr sz)=
+ pen oldpen; oldpen:=currentpen;
+ pickup stylus;
+ x$t1=x$-sz/2; x$t3=x$+sz/2;
+ y$t1=y$t3=y$;
+ x$t2=x$; y$t2=y$-0.9sz; % approx sqrt(3)/2
+ filldraw z$t1--z$t2--z$t3--cycle;
+ pickup oldpen;
+ labels($t1,$t2,$t3);
+enddef; % end of draw_triangle
+
+def draw_utriangle(suffix $)(expr sz)=
+ pen oldpen; oldpen:=currentpen;
+ pickup stylus;
+ x$t1=x$-sz/2; x$t3=x$+sz/2;
+ y$t1=y$t3=y$;
+ x$t2=x$; y$t2=y$+0.9sz; % approx sqrt(3)/2
+ filldraw z$t1--z$t2--z$t3--cycle;
+ pickup oldpen;
+ labels($t1,$t2,$t3);
+enddef; % end of draw_utriangle
+
+def draw_rtriangle(suffix $)(expr sz)=
+ pen oldpen; oldpen:=currentpen;
+ pickup stylus;
+ x$t1=x$-sz; rt x$t3=x$;
+ y$t1=y$t3=y$;
+ x$t2=x$t3; y$t2=y$-sz;
+ filldraw z$t1--z$t2--z$t3--cycle;
+ pickup oldpen;
+ labels($t1,$t2,$t3);
+enddef; % end of draw_rtriangle
+
+def draw_rutriangle(suffix $)(expr sz)=
+ pen oldpen; oldpen:=currentpen;
+ pickup stylus;
+ x$t1=x$-sz; rt x$t3=x$;
+ y$t1=y$t3=y$;
+ x$t2=x$t3; y$t2=y$+sz;
+ filldraw z$t1--z$t2--z$t3--cycle;
+ pickup oldpen;
+ labels($t1,$t2,$t3);
+enddef; % end of draw_rutriangle
+
+def draw_fork(suffix $, $$)(expr sz)=
+ pen oldpen; oldpen:=currentpen;
+ pickup quill;
+ x$f1'=lft x$; y$f1'=bot y$;
+ x$f3'=rt x$; y$f3'=top y$;
+ pickup stylus;
+ lft x$f1=x$f1'; bot y$f1=y$f1';
+ rt x$f3=x$f3'; y$f3-y$=2*(y$-y$f1);
+ rt x$f2=x$$-sz; bot y$f2=y$$;
+ rt x$f4= rt x$f5=x$$;
+ bot y$f5=y$$-sz; top y$f4=y$$+1/2sz;
+ filldraw z$f1--z$f2--z$f3--cycle; % the line
+ draw z$f2{right}..z$f4; % upper fork
+ draw z$f2{right}..z$f5; % lower fork
+ pickup oldpen;
+ labels($f1,$f2,$f3,$f4,$f5);
+enddef; % end of draw_fork
+
+def draw_urswish(suffix $, $$)=
+ pen oldpen; oldpen:=currentpen;
+ pickup quill;
+ rt x$$s1=x$$-thick; top y$$s1=y$$;
+ rt x$$s2=x$$;
+%% x$$s3=x$$-thick;
+ lft x$$s3=x$$s1;
+ bot y$$s3=y$$-thick; y$$s2=0.5[y$$s1,y$$s3];
+%% draw z$---z$$s1{right}..z$$s2{down}..{-pdir}z$$s3;
+ draw z$..z$$s1{pdir}..z$$s2{down};
+ labels($$s1,$$s2,$$s3);
+enddef; % end of draw_urswish
+
+def bowl_stem(suffix $, $$)=
+ x$'=0.5[x$,x$$]; y$'=y$; % the mid-point
+ z$''=z$' shifted (thick*pdir);
+ x$i=x$$; z$i=whatever[z$',z$''];
+ labels($',$i);
+enddef; % end of bowl_stem
+
+def draw_clubbase(suffix $, $$)(expr st, lft, rt)=
+ z$$l = z$$ shifted (lft*thick*(-pdir));
+ z$$r = z$$ shifted (rt*thick*(pdir));
+ z$$t = st[z$$,z$];
+ draw z$$t{z$$-z$}..z$$l--z$$r..{z$-z$$}z$$t;
+ labels($$t,$$l,$$r);
+enddef; % end of draw_clubbase
+
+
+def draw_pdot(suffix $)(expr sz)=
+ z$s = z$ shifted (0.5sz*left);
+ z$t = z$ shifted (0.5sz*up);
+ z$u = z$s shifted (sz*right);
+ z$v = z$t shifted (sz*down);
+ pickup stylus;
+ filldraw z$s--z$t--z$u--z$v--cycle;
+ labels($s,$t,$u,$v);
+enddef; % end of draw_pdot
+
+
+def draw_pcomma(suffix $)(expr sz, ar)=
+ z$s = z$ shifted (0.5sz*left);
+ z$t = z$s shifted (sz*right);
+ x$v=x$s-ar; y$v=y$s-2ar;
+ z$u = z$v shifted (sz*right);
+ z$sv = (x$s, 1/3[y$s,y$v]);
+ z$tu = (x$t, y$sv);
+ z$uv = 1/3[z$u,z$v];
+ z$vu = 1/3[z$v,z$u];
+ pickup stylus;
+%% filldraw z$s--z$t--z$u--z$v--cycle;
+ filldraw z$s--z$t--z$tu--z$uv--z$vu--z$v--z$sv--cycle;
+ labels($s,$t,$u,$v);
+enddef; % end of draw_pcomma
+
+
+def draw_plq(suffix $)(expr sz, ar)=
+ z$s = z$ shifted (0.5sz*left);
+ z$t = z$s shifted (sz*right);
+ x$v=x$s+ar; y$v=y$s-2ar;
+ z$u = z$v shifted (sz*right);
+ z$sv = (x$s, 1/3[y$s,y$v]);
+ z$tu = (x$t, y$sv);
+ z$uv = 1/3[z$u,z$v];
+ z$vu = 1/3[z$v,z$u];
+ pickup stylus;
+%% filldraw z$s--z$t--z$u--z$v--cycle;
+ filldraw z$s--z$t--z$tu--z$uv--z$vu--z$v--z$sv--cycle;
+ labels($s,$t,$u,$v);
+enddef; % end of draw_plq
+
+
+path obouter, obinner, obfirst, obsecond;
+def offsetbowl(suffix $)(expr sx, sy, fx, fy)=
+ numeric inx, iny, cx, cy;
+ pair pt[];
+ path pth[];
+ inx := 1/2thick*cosd(pangle); iny := 1/2thick*sind(pangle);
+ cx := x$+fx*sx; cy := y$+fy*sy;
+ z$obc = (cx,cy);
+ if pangle = 90:
+ z$wt=(x$+1/2thin, cy);
+ z$et=(x$+sx-1/2thin, cy);
+ else:
+ z$wt=(x$+inx, cy);
+ z$et=(x$+sx-inx, cy);
+ penpos$wt(thick,pangle);
+ penpos$et(thick,pangle);
+ fi
+ if pangle = 0:
+ z$nh=(cx, y$+sy-1/2thin);
+ z$sh=(cx, y$+1/2thin);
+ else:
+ z$nh=(cx, y$+sy-iny);
+ z$sh=(cx, y$+iny);
+ penpos$nh(thick,pangle);
+ penpos$sh(thick,pangle);
+ fi
+ obfirst := z$nh{right}..z$et{down}..z$sh{left}..z$wt{up}..cycle;
+ if pangle = 90:
+ z$minl = z$wt; z$maxr = z$nh; z$minr = z$et; z$maxl = z$sh;
+ else:
+ if pangle = 0:
+ z$minl = z$nh; z$maxr = z$et; z$minr = z$sh; z$maxl = z$wt;
+ else:
+ z$minl = directionpoint dir(pangle) of obfirst;
+ z$minr = directionpoint -dir(pangle) of obfirst;
+ pt1 := z$minr - z$minl; % direction
+ pt2 := (- ypart pt1, xpart pt1); % perpendicular
+ pt3 := 1/2[z$minl, z$minr];
+ pt4 := pt3 shifted pt2;
+ pt5 := pt3 shifted -pt2;
+ pth1 := pt3--pt4;
+ pth2 := pt3--pt5;
+ z$maxr = pth1 intersectionpoint obfirst;
+ z$maxl = pth2 intersectionpoint obfirst;
+ \fi
+ \fi
+ penpos$minl(thin,pangle+90);
+ penpos$maxr(thick,pangle);
+ penpos$minr(thin,pangle+90);
+ penpos$maxl(thick,pangle);
+ obsecond := z$minl..z$maxr..z$minr..z$maxl..cycle;
+ z$minlo = z$minl.r; z$maxro = z$maxr.r;
+ z$minro = z$minr.l; z$maxlo = z$maxl.l;
+ obouter := z$minlo{dir(pangle)}...z$maxro...z$minro{-dir(pangle)}...z$maxlo...cycle;
+ z$minli = z$minl.l; z$maxri = z$maxr.l;
+ z$minri = z$minr.r; z$maxli = z$maxl.r;
+ obinner := z$minli...z$maxri...z$minri...z$maxli...cycle;
+ labels($obc, $nh, $et, $sh, $wt);
+ labels($minl, $maxr, $minr, $maxl);
+ labels($minlo, $maxro, $minro, $maxlo);
+ labels($minli, $maxri, $minri, $maxli);
+enddef;
+
+
+def obowl(suffix $)(expr sx, sy)=
+ offsetbowl($, sx, sy, 1/2, 1/2);
+enddef;
+
+
+primarydef v scalarprod w =
+ (xpart v * ypart w - ypart v * xpart w)
+enddef;
+
+
+def tangentpoint(suffix $)(expr pth)=
+ pair vecll, veclr, veclm; % "tangent" line directions
+ numeric pl, pr, pm; % path parameter values
+ pair vecpl, vecpr, vecpm; % path directions
+ pair ptl, ptr, ptm; % path points
+ numeric sl, sr, sm; % scalar products of path/line directions
+ numeric stpsize; % size of current binary step
+ numeric tantol; % tolerance
+ boolean wtest; % a boolean
+
+ tantol := eps;
+ pl:=0; pr:=length pth; pm:=0.5(pl+pr); stpsize:=pr-pl;
+ ptl := point pl of pth;
+ ptm := point pm of pth;
+ ptr := point pr of pth;
+ vecll := unitvector (z$-ptl);
+ veclm := unitvector (z$-ptm);
+ veclr := unitvector (z$-ptr);
+ vecpl := unitvector (direction pl of pth);
+ vecpm := unitvector (direction pm of pth);
+ vecpr := unitvector (direction pr of pth);
+ sl := vecll scalarprod vecpl;
+ sm := veclm scalarprod vecpm;
+ sr := veclr scalarprod vecpr;
+ wtest := (stpsize < tantol) or (sl*sr > 0) or
+ (abs sl < tantol) or (abs sm < tantol) or (abs sr < tantol);
+ if wtest:
+ if (stpsize < tantol):
+ z$tan=(0,0);
+ errmessage("No tangent; path too short");
+ else:
+ if (sl*sr > 0):
+ z$tan=(0,0);
+ errmessage("No tangent; end products have the same sign");
+ else:
+ if (abs sl < tantol):
+ z$tan=ptl;
+ else:
+ if (abs sm < tantol):
+ z$tan=ptm;
+ else:
+ z$tan=ptr;
+ fi
+ fi
+ fi
+ fi
+ else:
+ forever:
+ if (sl*sm < 0): % opposite signs, look between pl & pm
+ pr:=pm; pm:=0.5(pr+pl);
+ vecpr := vecpm; veclr := veclm; sr:=sm;
+ else:
+ pl:=pm; pm:=0.5(pr+pl);
+ vecpl:=vecpm; vecll:=veclm; sl:=sm;
+ fi
+ stpsize:=pr-pl;
+ ptm := point pm of pth;
+ veclm := unitvector (z$-ptm);
+ vecpm := unitvector (direction pm of pth);
+ sm := veclm scalarprod vecpm;
+ wtest := (stpsize < tantol) or (abs sm < tantol);
+ if wtest:
+ if (abs sm < tantol):
+ z$tan = ptm;
+ else:
+ z$tan = ptm;
+%%%%%% errmessage("Warning: tangent approximated");
+ fi
+ fi
+ exitif wtest;
+ endfor
+ fi
+enddef;
+
+
+font_coding_scheme:="ASCII minuscules and punctuation";
+mode_setup;
+tgothic_font_setup;
+
+
+input tgothl; % lower case
+input tgothu; % capitals
+input tgothpunct; % punctuation
+input tgothlig; % the several dashes
+input tgothdig; % arabic digits
+
+
+font_slant slant; font_x_height x_height#;
+if monospace:
+ font_normal_space 2vstretch*stem_width#; % no stretching or shrinking
+ font_quad vstretch*18u#;
+ font_extra_space vstretch*9u#;
+else:
+ font_normal_space 2vstretch*stem_width#+2letter_fit#;
+ font_normal_stretch vstretch*3u#; font_normal_shrink vstretch*2u#;
+ font_quad vstretch*18u#+4letter_fit#;
+ font_extra_space vstretch*2u#;
+
+
+fi
+
+bye.
+
+ k#:=-.5u#; kk#:=-1.5u#; kkk#:=-2u#; % three degrees of kerning
+ kks#:=-4u#; kkx#:=-1.5u#; kkj#:=-2u#; kkr#:=-5u#; kkrs#:=-2u#; kkrl#:=-8u#;
+ ligtable "s":
+ "a" kern kks#, "A" kern kks#,
+ "c" kern kks#, "C" kern kks#,
+ "d" kern kks#, "D" kern kks#,
+ "e" kern kks#, "E" kern kks#,
+ "f" kern kks#, "F" kern kks#,
+ "g" kern kks#, "G" kern kks#,
+ "i" kern kks#, "I" kern kks#,
+ "j" kern kks#, "J" kern kks#,
+ "k" kern kks#, "K" kern kks#,
+ "m" kern kks#, "M" kern kks#,
+ "n" kern kks#, "N" kern kks#,
+ "o" kern kks#, "O" kern kks#,
+ "p" kern kks#, "P" kern kks#,
+ "q" kern kks#, "Q" kern kks#,
+ "r" kern kks#, "R" kern kks#,
+ "t" kern kks#, "T" kern kks#,
+ "u" kern kks#, "U" kern kks#,
+ "v" kern kks#, "V" kern kks#,
+ "w" kern kks#, "W" kern kks#,
+ "x" kern kks#, "X" kern kks#,
+ "y" kern kks#, "Y" kern kks#,
+ "z" kern kks#, "Z" kern kks#;
+
+ ligtable "S":
+ "a" kern kks#, "A" kern kks#,
+ "c" kern kks#, "C" kern kks#,
+ "d" kern kks#, "D" kern kks#,
+ "e" kern kks#, "E" kern kks#,
+ "f" kern kks#, "F" kern kks#,
+ "g" kern kks#, "G" kern kks#,
+ "i" kern kks#, "I" kern kks#,
+ "j" kern kks#, "J" kern kks#,
+ "k" kern kks#, "K" kern kks#,
+ "m" kern kks#, "M" kern kks#,
+ "n" kern kks#, "N" kern kks#,
+ "o" kern kks#, "O" kern kks#,
+ "p" kern kks#, "P" kern kks#,
+ "q" kern kks#, "Q" kern kks#,
+ "r" kern kks#, "R" kern kks#,
+ "t" kern kks#, "T" kern kks#,
+ "u" kern kks#, "U" kern kks#,
+ "v" kern kks#, "V" kern kks#,
+ "w" kern kks#, "W" kern kks#,
+ "x" kern kks#, "X" kern kks#,
+ "y" kern kks#, "Y" kern kks#,
+ "z" kern kks#, "Z" kern kks#;
+
+ ligtable "x":
+ "a" kern kkx#, "A" kern kkx#,
+ "b" kern kkx#, "B" kern kkx#,
+ "c" kern kkx#, "C" kern kkx#,
+ "d" kern kkx#, "D" kern kkx#,
+ "e" kern kkx#, "E" kern kkx#,
+ "g" kern kkx#, "G" kern kkx#,
+ "j" kern kkx#, "J" kern kkx#,
+ "l" kern kkx#, "L" kern kkx#,
+ "o" kern kkx#, "O" kern kkx#,
+ "q" kern kkx#, "Q" kern kkx#,
+ "t" kern kkx#, "T" kern kkx#,
+ "u" kern kkx#, "U" kern kkx#,
+ "v" kern kkx#, "V" kern kkx#,
+ "w" kern kkx#, "W" kern kkx#,
+ "y" kern kkx#, "Y" kern kkx#;
+
+ ligtable "X":
+ "a" kern kkx#, "A" kern kkx#,
+ "b" kern kkx#, "B" kern kkx#,
+ "c" kern kkx#, "C" kern kkx#,
+ "d" kern kkx#, "D" kern kkx#,
+ "e" kern kkx#, "E" kern kkx#,
+ "g" kern kkx#, "G" kern kkx#,
+ "j" kern kkx#, "J" kern kkx#,
+ "l" kern kkx#, "L" kern kkx#,
+ "o" kern kkx#, "O" kern kkx#,
+ "q" kern kkx#, "Q" kern kkx#,
+ "t" kern kkx#, "T" kern kkx#,
+ "u" kern kkx#, "U" kern kkx#,
+ "v" kern kkx#, "V" kern kkx#,
+ "w" kern kkx#, "W" kern kkx#,
+ "y" kern kkx#, "Y" kern kkx#;
+
+ ligtable "a": "A":
+ "b": "B":
+ "c": "C":
+ "d": "D":
+ "e": "E":
+ "h": "H":
+ "i": "I":
+ "k": "K":
+ "l": "L":
+ "m": "M":
+ "n": "N":
+ "o": "O":
+ "p": "P":
+ "t": "T":
+ "u": "U":
+ "v": "V":
+ "w": "W":
+ "z": "Z":
+ "j" kern kkj#, "J" kern kkj#;
+
+ ligtable "r":
+ "a" kern kkr#, "A" kern kkr#,
+ "b" kern kkr#, "B" kern kkr#,
+ "c" kern kkr#, "C" kern kkr#,
+ "d" kern kkr#, "D" kern kkr#,
+ "e" kern kkr#, "E" kern kkr#,
+ "f" kern kkrs#, "F" kern kkrs#,
+ "g" kern kkrs#, "G" kern kkrs#,
+ "h" kern kkr#, "H" kern kkr#,
+ "i" kern kkr#, "I" kern kkr#,
+ "j" kern kkj#, "J" kern kkj#,
+ "k" kern kkrs#, "K" kern kkrs#,
+ "l" kern kkr#, "L" kern kkr#,
+ "m" kern kkr#, "M" kern kkr#,
+ "n" kern kkrs#, "N" kern kkrs#,
+ "o" kern kkr#, "O" kern kkr#,
+ "p" kern kkrs#, "P" kern kkrs#,
+ "q" kern kkr#, "Q" kern kkr#,
+ "r" kern kkrs#, "R" kern kkrs#,
+ "s" kern kkr#, "S" kern kkr#,
+ "t" kern kkr#, "T" kern kkr#,
+ "u" kern kkr#, "U" kern kkr#,
+ "v" kern kkr#, "V" kern kkr#,
+ "w" kern kkr#, "W" kern kkr#,
+ "x" kern kkx#, "X" kern kkx#,
+ "y" kern kkr#, "Y" kern kkr#,
+ "z" kern kkr#, "Z" kern kkr#;
+
+ ligtable "R":
+ "a" kern kkr#, "A" kern kkr#,
+ "b" kern kkr#, "B" kern kkr#,
+ "c" kern kkr#, "C" kern kkr#,
+ "d" kern kkr#, "D" kern kkr#,
+ "e" kern kkr#, "E" kern kkr#,
+ "f" kern kkrs#, "F" kern kkrs#,
+ "g" kern kkrs#, "G" kern kkrs#,
+ "h" kern kkr#, "H" kern kkr#,
+ "i" kern kkr#, "I" kern kkr#,
+ "j" kern kkj#, "J" kern kkj#,
+ "k" kern kkrs#, "K" kern kkrs#,
+ "l" kern kkr#, "L" kern kkr#,
+ "m" kern kkr#, "M" kern kkr#,
+ "n" kern kkrs#, "N" kern kkrs#,
+ "o" kern kkr#, "O" kern kkr#,
+ "p" kern kkrs#, "P" kern kkrs#,
+ "q" kern kkr#, "Q" kern kkr#,
+ "r" kern kkrs#, "R" kern kkrs#,
+ "s" kern kkr#, "S" kern kkr#,
+ "t" kern kkr#, "T" kern kkr#,
+ "u" kern kkr#, "U" kern kkr#,
+ "v" kern kkr#, "V" kern kkr#,
+ "w" kern kkr#, "W" kern kkr#,
+ "x" kern kkx#, "X" kern kkx#,
+ "y" kern kkr#, "Y" kern kkr#,
+ "z" kern kkr#, "Z" kern kkr#;
+
+fi
+
+bye.
+