home *** CD-ROM | disk | FTP | other *** search
/ Fresh Fonts 1 / freshfonts1.bin / bbs / programs / amiga / metafont.lha / MF / INPUTS / MISC / feynmf.mf < prev    next >
Text File  |  1994-06-09  |  25KB  |  760 lines
  1. %% 
  2. %% This is file `feynmf.mf', generated 
  3. %% on <1994/6/9> with the docstrip utility (2.2h).
  4. %% 
  5. %% The original source files were:
  6. %% 
  7. %% feynmf.dtx  (with options: `base')
  8. %% 
  9. %% Copyright (C) 1989, 1990, 1992-1994 by Thorsten.Ohl@Physik.TH-Darmstadt.de 
  10. %% 
  11. %% This file is NOT the source for feynmf, because almost all comments 
  12. %% have been stripped from it. It is NOT the preferred form of feynmf 
  13. %% for making modifications to it. 
  14. %% 
  15. %% Therefore you can NOT redistribute and/or modify THIS file. You can 
  16. %% however redistribute the complete source (feynmf.dtx and feynmf.ins) 
  17. %% and/or modify it under the terms of the GNU General Public License as 
  18. %% published by the Free Software Foundation; either version 2, or (at 
  19. %% your option) any later version. 
  20. %% 
  21. %% Feynmf is distributed in the hope that it will be useful, but 
  22. %% WITHOUT ANY WARRANTY; without even the implied warranty of 
  23. %% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 
  24. %% GNU General Public License for more details. 
  25. %% 
  26. %% You should have received a copy of the GNU General Public License 
  27. %% along with this program; if not, write to the Free Software 
  28. %% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA. 
  29. %% 
  30. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  31. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  32. %% \CheckSum{425}
  33. %% \CharacterTable
  34. %%  {Upper-case    \A\B\C\D\E\F\G\H\I\J\K\L\M\N\O\P\Q\R\S\T\U\V\W\X\Y\Z
  35. %%   Lower-case    \a\b\c\d\e\f\g\h\i\j\k\l\m\n\o\p\q\r\s\t\u\v\w\x\y\z
  36. %%   Digits        \0\1\2\3\4\5\6\7\8\9
  37. %%   Exclamation   \!     Double quote  \"     Hash (number) \#
  38. %%   Dollar        \$     Percent       \%     Ampersand     \&
  39. %%   Acute accent  \'     Left paren    \(     Right paren   \)
  40. %%   Asterisk      \*     Plus          \+     Comma         \,
  41. %%   Minus         \-     Point         \.     Solidus       \/
  42. %%   Colon         \:     Semicolon     \;     Less than     \<
  43. %%   Equals        \=     Greater than  \>     Question mark \?
  44. %%   Commercial at \@     Left bracket  \[     Backslash     \\
  45. %%   Right bracket \]     Circumflex    \^     Underscore    \_
  46. %%   Grave accent  \`     Left brace    \{     Vertical bar  \|
  47. %%   Right brace   \}     Tilde         \~}
  48. %%
  49. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  50. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  51. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  52. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  53. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  54. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  55. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  56. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  57. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  58. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  59. %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
  60. vardef parse_RCS (suffix RCS) (expr s) =
  61.   save n, c;
  62.   numeric n, RCS[];
  63.   string c;
  64.   RCS[0] := 0;
  65.   for n = 1 upto length (s):
  66.     c := substring (n-1,n) of s;
  67.     exitif ((RCS[0] > 0) and (c = " "));
  68.     if ((c = "0") or (c = "1") or (c = "2")
  69.         or (c = "3") or (c = "4") or (c = "5")
  70.         or (c = "6") or (c = "7") or (c = "8")
  71.         or (c = "9")):
  72.       if RCS[0] = 0:
  73.         RCS[0] := 1;
  74.         RCS[RCS[0]] := 0;
  75.       fi
  76.       RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c);
  77.     elseif c = ".":
  78.       RCS[0] := RCS[0] + 1;
  79.       RCS[RCS[0]] := 0;
  80.     else:
  81.     fi
  82.   endfor
  83. enddef;
  84. vardef require_RCS_revision expr s =
  85.   numeric n;
  86.   save TeX_rev, mf_rev;
  87.   parse_RCS (TeX_rev, s);
  88.   parse_RCS (mf_rev, "1.5");
  89.   for n = 1 upto min (2, TeX_rev[0], mf_rev[0]):
  90.     if TeX_rev[n] > mf_rev[n]:
  91.       errhelp
  92.         "Your version of `feynmf.sty' is higher that of your `feynmf.mf'.";
  93.       errmessage "feynmf: Metafont macros out of date";
  94.     elseif TeX_rev[n] < mf_rev[n]:
  95.       errhelp
  96.         "Your version of `feynmf.mf' is higher that of your `feynmf.sty'.";
  97.       errmessage "feynmf: LaTeX style out of date";
  98.     fi
  99.     exitif (TeX_rev[n] <> mf_rev[n]);
  100.   endfor
  101. enddef;
  102. mode_setup;
  103. thin#:=1pt#; % dimension of the lines
  104. thick#:=2thin#;
  105. arrow_width#:=3thick#; % arrows
  106. arrow_height#:=2arrow_width#;
  107. curly_len#:=3mm#;
  108. dash_len#:=3mm#; % 'photon' lines
  109. dot_len#:=2mm#; % 'photon' lines
  110. wiggly_len#:=4mm#; % 'photon' lines
  111. wiggly_slope:=60;
  112. shade_black#:=1pt#; % shading
  113. shade_white#:=2shade_black#;
  114. shade_angle:=60;
  115. define_blacker_pixels (thick, thin, shade_black, shade_white,
  116.   dash_len, dot_len, wiggly_len, curly_len,
  117.   arrow_height, arrow_width);
  118. LaTeX_unitlength := mm;
  119. vardef count (text list) =
  120.   forsuffixes $ = list: + 1 endfor
  121. enddef;
  122. vardef getopt (suffix opt) (expr s) =
  123.   numeric opt.first, opt.last, n;
  124.   string opt[], opt[]arg, c;
  125.   boolean argp, escape;
  126.   opt.first := 0;
  127.   opt.last := 0;
  128.   opt[opt.last] := "";
  129.   argp := false;
  130.   escape := false;
  131.   for n = 1 upto length (s):
  132.     c := substring (n-1,n) of s;
  133.     if not escape and (c = ","):
  134.       if substring (n,n+1) of s = ",":
  135.         escape := true;
  136.       else:
  137.         opt.last := opt.last + 1;
  138.         opt[opt.last] := "";
  139.         argp := false;
  140.       fi
  141.     elseif not argp and (c = "="):
  142.       opt[opt.last]arg := "";
  143.       argp := true;
  144.     elseif argp or (c <> " "):
  145.       if argp:
  146.         opt[opt.last]arg := opt[opt.last]arg & c;
  147.       else:
  148.         opt[opt.last] := opt[opt.last] & c;
  149.       fi
  150.       escape := false;
  151.     fi
  152.   endfor
  153. enddef;
  154. def save_picture text t =
  155.  save t; picture t; forsuffixes p=t: p:=nullpicture; endfor
  156. enddef;
  157. def begin_sketch =
  158.  begingroup save_picture currentpicture;
  159.  sketchlevel := sketchlevel+1;
  160. enddef;
  161. def end_sketch =
  162.  sketchlevel := sketchlevel-1;
  163.  sketchpad[sketchlevel] := currentpicture;
  164.  endgroup
  165. enddef;
  166. picture sketchpad[];
  167. sketchlevel := 1;
  168. vardef use_sketch text t =
  169.  addto currentpicture also (sketchpad[sketchlevel] t)
  170. enddef;
  171. vardef shade expr p_arg =
  172.  save x,y,d,p,currentpen; path p; pen currentpen;    % push pen!
  173.  pickup pencircle scaled shade_black;
  174.  p = p_arg rotated - shade_angle;  % calculate enclosing rectangle
  175.  x2' = x3' = xpart directionpoint up of p; % (rotated by |shade_angle|).
  176.  x1' = x4' = xpart directionpoint down of p;
  177.  y1' = y2' = ypart directionpoint right of p;
  178.  y3' = y4' = ypart directionpoint left of p;
  179.  forsuffixes $=1,2,3,4: z$ = z$' rotated shade_angle; endfor
  180.  d = abs(z1-z4); % height.
  181.  begin_sketch % fill rectangle with lines.
  182.   for k=shade_white/d step (shade_white+shade_black)/d
  183.     until 1 - shade_white/d:
  184.    cutdraw k[z1,z4] -- k[z2,z3];
  185.   endfor
  186.   cullit;
  187.   fill p_arg;
  188.   unfill z1--z2--z3--z4--cycle;
  189.   cullit;
  190.  end_sketch;
  191.  use_sketch;
  192. enddef;
  193. vardef arrow =
  194.  clearxy; % push 'em!
  195.  x1 - x2 = arrow_height; y2 - y3 = arrow_width;
  196.  x1 = -3x2; x2 = x3; y1 = y2 + y3 = 0; % center it!
  197.  z1--z2--z3--cycle
  198. enddef;
  199. vardef cut_circles (expr diam_a, p_arg, diam_b) =
  200.  subpath (xpart(p_arg intersectiontimes fullcircle scaled diam_a
  201.           shifted point 0 of p_arg),
  202.       xpart(p_arg intersectiontimes fullcircle scaled diam_b
  203.           shifted point infinity of p_arg))
  204.    of p_arg
  205. enddef;
  206. vardef make_blob (expr z_arg, diameter) =
  207.  save p,currentpen; path p; pen currentpen;
  208.  pickup pencircle scaled thick;
  209.  p = fullcircle scaled diameter shifted z_arg;
  210.  draw p; shade p;
  211. enddef;
  212. vardef draw_blob (expr z_arg, diameter) =
  213.  if sketched_blob_diameter <> diameter: % drawn lately?
  214.   begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work!
  215.   sketched_blob_diameter:= diameter;  % record it
  216.  fi
  217.  use_sketch shifted z_arg; % the easy way ...
  218. enddef;
  219. def force_new_blob = sketched_blob_diameter := -1; enddef;
  220. force_new_blob;                                 % initialize it.
  221. vardef put_on_path (expr o_arg, p_arg) =
  222.  fill o_arg rotated angle direction length(p_arg)/2 of p_arg
  223.         shifted point length(p_arg)/2 of p_arg;
  224.  p_arg
  225. enddef;
  226. vardef pixlen (expr p, n) =
  227.   for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor
  228. enddef;
  229. vardef segment_pixlen (expr p, n) =
  230.   for k=1 upto n: + a