home *** CD-ROM | disk | FTP | other *** search
/ Geek Gadgets 1 / ADE-1.bin / ade-dist / unixtex-6.1b-bin4.lha / lib / texmf / fonts / ams / symbols / src / xbbase.mf < prev    next >
Text File  |  1996-10-12  |  8KB  |  228 lines
  1. %% @metafontfile{
  2. %%     filename="xbbase.mf",
  3. %%     version="2.1",
  4. %%     date="30-MAY-1991",
  5. %%     filetype="Metafont: base",
  6. %%     copyright="Copyright (C) American Mathematical Society,
  7. %%            all rights reserved.  Copying of this file is
  8. %%            authorized only if either:
  9. %%            (1) you make absolutely no changes to your copy
  10. %%                including name; OR
  11. %%            (2) if you do make changes, you first rename it to some
  12. %%                other name.",
  13. %%     author="American Mathematical Society",
  14. %%     address="American Mathematical Society,
  15. %%            Technical Support Department,
  16. %%            P. O. Box 6248,
  17. %%            Providence, RI 02940,
  18. %%            USA",
  19. %%     telephone="401-455-4080 or (in the USA) 800-321-4AMS",
  20. %%     email="Internet: Tech-Support@Math.AMS.org",
  21. %%     codetable="ISO/ASCII",
  22. %%     checksumtype="line count",
  23. %%     checksum="227",
  24. %%     keywords="amsfonts, tex, metafont , AMSSymbols ",
  25. %%     abstract="This is the base file for use with 
  26. %%            the Blackboard Bold characters in AMSFonts 2.1."
  27. %%     }
  28. %
  29. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  30.  
  31. % Changes made for version 2.1:
  32. % Fixed Problems with smode in draw_outlines and showpoints
  33. %   Stefan Lindner, 21-March-1991
  34. % Fixed Problems with serifs at small point sizes
  35. %   Stefan Lindner and Lutz Birkhahn, 14-April-91
  36.  
  37. vardef curve@#(expr a,one,b,two)=
  38.   save x,y;
  39.   z0=if(str@#="br")or(str@#="tl"):(xpart b,ypart a)
  40.      else:(xpart a,ypart b) fi;
  41.   z1=one[a,z0]; z2=two[b,z0];
  42.   a ..controls z1 and z2.. b
  43.  enddef;
  44.  
  45. vardef reversecurve@#(expr a,one,b,two)=reverse curve@#(a,one,b,two) enddef;
  46.  
  47.  
  48. vardef beak(expr injoin,intip,outtip,indent,outjoin,tense)=
  49.   save x,y,t,toward,onright,ref; pair toward; boolean onright; path ref;
  50.   onright=(xpart intip>xpart injoin);    
  51.   toward=if onright: right else: left fi;
  52.   z1=intip if onright:-else:+ fi (inbeak,0);
  53.   z2=outtip if onright:-else:+ fi (outbeak,0);
  54.   ref=outjoin{toward}...(z1 if onright:+else:- fi (2*abs(outjoin-injoin),0));
  55.   y4=.5[ypart outjoin,ypart indent];
  56.   z3=ref intersectionpoint ((0,y4)--(w,y4));
  57.   (t3,t4)=ref intersectiontimes ((0,y4)--(w,y4)); 
  58.  
  59.   injoin{toward}..tension tense..z1--intip--outtip--z2...indent{-toward}...
  60.     {-(direction t3 of ref)}z3--subpath(t3,0) of ref
  61.  enddef; 
  62.  
  63.  
  64.  
  65.  
  66. boolean its_a_leftserif;                
  67.  
  68. vardef full_serif_points@#
  69. (expr A,B,Bl,Br,leftlength,rightlength,midbracket_pull)=
  70. %%%% min_limit(join_radius)(.5serif_thickness);   % -sl 14.04.91
  71.   (z1-B)=whatever*(A@#-B@#);            
  72.   (z1l-Bl)=whatever*(A@#-B@#);          
  73.   (z1r-Br)=whatever*(A@#-B@#);          
  74.  
  75.   y2=y2l=y2r=ypart A;                   
  76.   y1=y1l=y1r=y3=y4=ypart A if ypart A>ypart B:-else:+fi serif_thickness;
  77.                                         
  78.   x5=x2=.5[x1l,x1r];                    
  79.   y5=entasis[y2l,y1l];                  
  80.  
  81.   if its_a_leftserif:x3=x2l=x1l-round(leftlength+serif_constant_amt); 
  82.    else:x4=x2r=x1r+round(rightlength+serif_constant_amt); fi
  83. enddef;                      
  84.  
  85. vardef leftserif@#(expr A,B,Bl,Br,alength,midbracket_pull)=
  86.   its_a_leftserif:=true;  
  87.   save x,y,p; path p[]; 
  88.   min_limit(join_radius)(.5serif_thickness);   % -sl 14.04.91
  89.   full_serif_points@#(A,B,Bl,Br,alength,0,midbracket_pull);                
  90.   p0:=Bl{z1l-Bl}...{z3-z1l}z3;                     
  91.   if midbracket_pull<>0: 
  92.     z3'l=z1l; pos3'(alength+5pt,.5[angle(B-A),if ypart A>ypart B:-fi 180]);
  93.     z8'=p0 intersectionpoint (z3'l--z3'r);         
  94.     z8=(midbracket_pull-eps)[z8',z1l];fi           
  95.   if ypart A>ypart B:reverse fi   
  96.   ((if midbracket_pull=0:p0 else:Bl{z1l-Bl}...z8...{z3-z1l}z3 fi 
  97.    if softpath:)softjoin(z3--z2l)softjoin(else:--fi z2l..z5{right}))
  98. enddef;
  99.  
  100. vardef rightserif@#(expr A,B,Bl,Br,alength,midbracket_pull)=
  101.   its_a_leftserif:=false;
  102.   save x,y,p; path p[]; 
  103.   min_limit(join_radius)(.5serif_thickness);   % -sl 14.04.91
  104.   full_serif_points@#(A,B,Bl,Br,0,alength,midbracket_pull);
  105.   p4:=z4{z1r-z4}...{Br-z1r}Br;                     
  106.   if midbracket_pull<>0:
  107.     z4'l=z1r; pos4'(alength+5pt,.5[angle(B-A),0]);
  108.     z9'=p4 intersectionpoint (z4'l--z4'r);         
  109.     z9=(midbracket_pull-eps)[z9',z1r];fi           
  110.   if ypart A>ypart B:reverse fi
  111.    ((z5{right}..z2r if softpath:)softjoin(z2r--z4)softjoin(else:--fi
  112.     if midbracket_pull=0:p4 else:z4{z1r-z4}...z9...{Br-z1r}Br fi))
  113. enddef;
  114.                             
  115. vardef fullserif@#(expr A,B,Bl,Br,leftlength,rightlength,midbracket_pull)= 
  116.   save x,y,p; path p[];
  117.   p1=rightserif(A,B,Bl,Br,rightlength,midbracket_pull); 
  118.   p2=leftserif(A,B,Bl,Br,leftlength,midbracket_pull);
  119.   if ypart A>ypart B:(p1--p2)else:(p2--p1)fi
  120. enddef;
  121.  
  122.  
  123. vardef straightarm@#(expr join,tip,heel,thickness,pull)=
  124.   save x,y,toward,p; pair toward; path p;
  125.   toward=if (str@#="br")or(str@#="tr"):right else:left fi; 
  126.   z1=tip if (str@#="br")or(str@#="tr"):- else:+ fi (thickness,0);
  127.   z2=point .5 of (join{toward}...{tip-heel}z1);
  128.   z1-z3=whatever*(tip-heel); y3=ypart join;
  129.   p=z1{z3-z1}...{join-z3}join;
  130.   z4=pull[z3,point .5 of p];
  131.   if (str@#="br")or(str@#="tl"):reverse fi
  132.   (join{toward}...z4...{tip-heel}z1--tip--heel)
  133.  enddef; 
  134.  
  135.  
  136. vardef constant_angle(expr top_pt,bot_pt,stem)suffix $=
  137.   save theta;
  138.   theta=if str$="lr":-else:+fi (angle(length(top_pt-bot_pt) +-+ stem,stem));
  139.   angle(top_pt-bot_pt)+theta-90
  140. enddef;
  141.  
  142.  
  143. vardef pos@#(expr b,d) =
  144.  (x@#r-x@#l,y@#r-y@#l)=(b,0)rotated d;x@#=.5(x@#l+x@#r);y@#=.5(y@#l+y@#r)enddef;
  145.  
  146. vardef mpos(text t)(expr b,d)=forsuffixes $=t:pos$(b,d); endfor enddef;
  147.  
  148.  
  149. def draw_outlines=  pickup pencircle scaled linethickness;
  150.   for n=1 upto 3:if known p[n]:draw p[n];fi 
  151.                  if known p[n]':draw p[n]';fi
  152.                  if known p[n]'':draw p[n]'';fi endfor
  153.   if numeric mode:      % -sl    21.03.1991
  154.   if mode=proof: drawgrid; fi
  155.   fi                    % -sl    21.03.1991
  156.   enddef;
  157.  
  158. def drawgrid=
  159.  pickup pencircle scaled 1;
  160.  for y:=h,xheight,0,-descender: draw (0,y)--(w,y); endfor
  161.  for y:=unit step unit until (cap+.5unit): draw (0,y)--(w,y); endfor
  162.  for y:=unit step -unit until (-d-.5unit): draw (0,y)--(w,y); endfor
  163.  for x:=0 step unit until (w+.5unit): draw (x,-d)--(x,h); endfor
  164. enddef;
  165.  
  166.  
  167. vardef onaline(suffix a,b)(text t)=forsuffixes $=t:z$=whatever[z.a,z.b]; endfor
  168.  enddef;
  169.  
  170.  
  171. def showpoints(text t)= 
  172.  if numeric mode:      % -sl    21.03.1991
  173.  if mode=proof:pickup pencircle scaled 3;
  174.  forsuffixes $:=t:forsuffixes s:=l,,r:if known z$.s:draw z$s;fi endfor endfor
  175.  pickup pencircle scaled 1; penlabels(t); fi
  176.  fi                    % -sl    21.03.1991
  177. enddef;
  178.  
  179.  
  180. vardef inlimit(text amt)(expr lowerlimit,upperlimit)=save this;
  181.  this:=max(amt,lowerlimit); this:=min(this,upperlimit);this
  182. enddef;
  183.  
  184.  
  185. let semi_ = ;; let colon_ = :; let endchar_ = endchar;
  186. def iff expr b = if b:let next_=use_it else:let next_=lose_it fi; next_ enddef;
  187. def use_it = let : = restore_colon; enddef;
  188. def restore_colon = let : = colon_; enddef;
  189. def lose_it = let endchar=fi; let ;=restore_endchar semi_ if false enddef;
  190. def restore_endchar=let ;=semi_; let endchar=endchar_; enddef;
  191. def always_iff expr b = use_it enddef;
  192. boolean wanted[];
  193.  
  194.  % for x:="I":
  195.  %   wanted[byte x]:=true; endfor
  196.           % this allows specifying only those characters which are to be shown
  197.           % the chars can be specified inside of quotes("c") or as a number(23)
  198. def OK expr x=known wanted[byte x] enddef;
  199.  %  let iff=always_iff;               % allows testing of all chars in the file
  200.            
  201.  
  202. def min_limit(text this)(expr limit)=if this>limit:save this;this=limit;fi
  203. enddef;
  204.  
  205.  
  206. % def define_adj_whole_pixels(text t)=
  207. % forsuffixes $:=t: $:=hround(max(eps,$.#-linethickness#)*hppp); endfor enddef;
  208.  
  209. def define_min_adj_whole_pixels(text t)=
  210.  forsuffixes $:=t: $:=max(lowres_min,hround(max(eps,$.#-linethickness#)*hppp));
  211.  endfor enddef;
  212.  
  213. def bool(text t)=boolean t; t enddef;
  214.  
  215. def vpix(text t)(text tt)= t:=tt; t:=vround(tt.#*hppp); enddef;   % whole v pix
  216. def wpix(text tt)(text t)= 
  217.  forsuffixes $:=t: $:=hround(tt.#*hppp); endfor enddef;    % whole pixels
  218. def adjpix(text tt)(text t)=                                % adjusted pixels
  219.  forsuffixes $:=t: $:=hround(max(eps,tt.#*hppp-linethickness)); endfor enddef;
  220.  
  221. def minadjpix(text ttt)(text tt)(text t)=      % adjusted pixels with a minimum
  222.  forsuffixes $:=t: $:=max(ttt,hround(tt.#*hppp-linethickness));
  223.  endfor enddef;
  224.  
  225.  
  226. def highres_lowres(text t)(expr a,b)=t:=if lowres:b else:a fi enddef;
  227.  
  228.