* Re: [NTG-context] Feynman Diagrams
2023-04-12 20:33 ` Gavin via ntg-context
@ 2023-04-12 22:12 ` Aditya Mahajan via ntg-context
2023-04-13 2:42 ` Gavin via ntg-context
0 siblings, 1 reply; 9+ messages in thread
From: Aditya Mahajan via ntg-context @ 2023-04-12 22:12 UTC (permalink / raw)
To: Gavin via ntg-context; +Cc: Aditya Mahajan
[-- Attachment #1: Type: text/plain, Size: 3589 bytes --]
On Wed, 12 Apr 2023, Gavin via ntg-context wrote:
> Hi Aditya,
>
> > Have you tried using feynmp (the metapost macros) directly instead of the LaTeX wrapper? Can you create an example that works with metapost but fails in ConTeXt?
>
> No, I’m not sure how to do that. I looked at the manual, and it has some examples where new styles are written in MetaPost, but every diagram is drawn with the LaTeX wrapper. I looked in the source files, and maybe feynmf.dtx has everything to produce documentation for the MetaPost macros, but if so, I’m not sure how to generate that documentation.
>
> Can you point me to an example that works with metapost macros directly?
I have never used feynMP, so I am just copy-pasting an example from
https://osksn2.hep.sci.osaka-u.ac.jp/~taku/osx/feynmp/fmfsamples.pdf
\documentclass{article}
\usepackage{feynmp}
\begin{document}
\unitlength = 1mm
\begin{fmffile}{simple}
\begin{fmfgraph}(40,25)
\fmfleft{i1,i2}
\fmfright{o1,o2}
\fmf{fermion}{i1,v1,o1}
\fmf{fermion}{i2,v2,o2}
\fmf{photon}{v1,v2}
\end{fmfgraph}
\end{fmffile}
\end{document}
This creates a file simple.mp in the same directory (kind of like the old mkii way of including MP in context):
% simple.mp -- do not edit, generated automatically by test1.tex
input feynmp
require_RCS_revision "1.30";
beginchar(1, 40*2.84526pt#, 25*2.84526pt#, 0);
"feynmf: 1";
LaTeX_unitlength:=2.84526pt;
subgraph (0, 0, w, h);
vinit;
pickup pencircle scaled thin;
vleft (__i1, __i2);
vright (__o1, __o2);
vconnect ("fermion", __i1, __v1, __o1);
vconnect ("fermion", __i2, __v2, __o2);
vconnect ("photon", __v1, __v2);
vfreeze;
vdraw;
endsubgraph;
endchar;
% the end.
end.
endinput;
So, I created a context file:
\startMPinclusions
input feynmp;
require_RCS_revision "1.30";
\stopMPinclusions
\starttext
\startMPpage
beginchar(1, 40*2.84526pt#, 25*2.84526pt#, 0);
"feynmf: 1";
LaTeX_unitlength:=2.84526pt;
subgraph (0, 0, w, h);
vinit;
pickup pencircle scaled thin;
vleft (__i1, __i2);
vright (__o1, __o2);
vconnect ("fermion", __i1, __v1, __o1);
vconnect ("fermion", __i2, __v2, __o2);
vconnect ("photon", __v1, __v2);
vfreeze;
vdraw;
endsubgraph;
endchar;
\stopMPpage
\stoptext
but compiling that fails with
metapost > trace >
metapost > trace > loading metafun for lmtx, including the plain 1.004 base definitions
metapost > trace >
metafun > log >
metafun > log > error: Isolated expression
metafun > log >
metapost > trace > <error> 1
metapost > trace > <to be read again> #
metafun > log >
metafun > log > I couldn't find an '=' or ':=' after the expression that is shown above this
error message, so I guess I'll just ignore it and carry on.
metafun > log >
metapost > trace > <line 135> bp# := bp;
metapost > trace >
My guess is that it could be something to do with bp# being used as a variable, but I am not 100% sure on that.
In principle, it should be easier to adapt the feynmp.mp (attached) code to make it work with LMTX. The feynmp.sty package, simply provide a high level macro wrapper around this mp code, and it is relatively simply to do something similar in context; but the MP file isn't that different from the latex code anyways.
Aditya
[-- Attachment #2: Type: text/plain, Size: 60714 bytes --]
%%
%% This is file `feynmp.mp',
%% generated with the docstrip utility.
%%
%% The original source files were:
%%
%% feynmf.dtx (with options: `base,mp')
%%
%% Copyright (C) 1989, 1990, 1992-1995 by Thorsten.Ohl@Physik.TH-Darmstadt.de
%%
%% This file is NOT the source for feynmf, because almost all comments
%% have been stripped from it. It is NOT the preferred form of feynmf
%% for making modifications to it.
%%
%% Therefore you can NOT redistribute and/or modify THIS file. You can
%% however redistribute the complete source (feynmf.dtx and feynmf.ins)
%% and/or modify it under the terms of the GNU General Public License as
%% published by the Free Software Foundation; either version 2, or (at
%% your option) any later version.
%%
%% As a special exception, you can redistribute parts of this file for
%% the electronic distribution of scientific papers, provided that you
%% include a short note pointing to the complete source.
%%
%% Feynmf is distributed in the hope that it will be useful, but
%% WITHOUT ANY WARRANTY; without even the implied warranty of
%% MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
%% GNU General Public License for more details.
%%
%% You should have received a copy of the GNU General Public License
%% along with this program; if not, write to the Free Software
%% Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%% \CheckSum{924}
%% \CharacterTable
%% {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
%% 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
%% Digits \0\1\2\3\4\5\6\7\8\9
%% Exclamation \! Double quote \" Hash (number) \#
%% Dollar \$ Percent \% Ampersand \&
%% Acute accent \' Left paren \( Right paren \)
%% Asterisk \* Plus \+ Comma \,
%% Minus \- Point \. Solidus \/
%% Colon \: Semicolon \; Less than \<
%% Equals \= Greater than \> Question mark \?
%% Commercial at \@ Left bracket \[ Backslash \\
%% Right bracket \] Circumflex \^ Underscore \_
%% Grave accent \` Left brace \{ Vertical bar \|
%% Right brace \} Tilde \~}
%%
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
def subgraph (expr x, y, wd, ht) =
begingroup
save c, ne, nw, sw, se;
pair c, ne, nw, sw, se;
sw = (x,y);
se = sw + (wd,0);
nw = sw + (0,ht);
ne = sw + (wd,ht);
c = .5[sw,ne];
enddef;
def endsubgraph =
endgroup
enddef;
if known cmbase:
errhelp
"feynmf will only work with plain Metafont, as described in the book.";
errmessage "feynmf: CMBASE detected. Please use the PLAIN base.";
forever:
errmessage "No use in trying! You'd better eXit now ...";
errorstopmode;
endfor
fi
vardef parse_RCS (suffix RCS) (expr s) =
save n, c;
numeric n, RCS[];
string c;
RCS[0] := 0;
for n = 1 upto length (s):
c := substring (n-1,n) of s;
exitif ((RCS[0] > 0) and (c = " "));
if ((c = "0") or (c = "1") or (c = "2")
or (c = "3") or (c = "4") or (c = "5")
or (c = "6") or (c = "7") or (c = "8")
or (c = "9")):
if RCS[0] = 0:
RCS[0] := 1;
RCS[RCS[0]] := 0;
fi
RCS[RCS[0]] := 10 * RCS[RCS[0]] + scantokens (c);
elseif c = ".":
RCS[0] := RCS[0] + 1;
RCS[RCS[0]] := 0;
else:
fi
endfor
enddef;
vardef require_RCS_revision expr s =
save n, TeX_rev, mf_rev;
numeric n;
parse_RCS (TeX_rev, s);
parse_RCS (mf_rev, "$Revision: 1.30 $");
for n = 1 upto min (2, TeX_rev[0], mf_rev[0]):
if TeX_rev[n] > mf_rev[n]:
errhelp
"Your version of `feynmf.sty' is higher that of your `feynmf.mf'.";
errmessage "feynmf: Metafont macros out of date";
elseif TeX_rev[n] < mf_rev[n]:
errhelp
"Your version of `feynmf.mf' is higher that of your `feynmf.sty'.";
errmessage "feynmf: LaTeX style out of date";
fi
exitif (TeX_rev[n] <> mf_rev[n]);
endfor
enddef;
vardef cullit = \ enddef;
color foreground;
foreground = black;
vardef beginchar (expr c, wd, ht, dp) =
LaTeX_file := "";
beginfig(c);
w:=wd;
h:=ht;
enddef;
string LaTeX_file;
vardef endchar =
setbounds currentpicture to (0,0)--(w,0)--(w,h)--(0,h)--cycle;
if LaTeX_file <> "":
write EOF to LaTeX_file;
LaTeX_file := "";
fi
endfig
enddef;
bp# := bp;
cc# := cc;
cm# := cm;
dd# := dd;
in# := in;
mm# := mm;
pc# := pc;
pt# := pt;
vardef define_blacker_pixels(text t) =
forsuffixes $=t:
$:=$.#;
endfor
enddef;
picture unitpixel;
unitpixel = nullpicture;
addto unitpixel contour unitsquare;
def t_ = \ enddef;
boolean feynmfwizard;
feynmfwizard := false;
thin# := 1pt#; % dimension of the lines
thick# := 2thin#;
arrow_len# := 4mm#;
arrow_ang := 15;
curly_len# := 3mm#;
dash_len# := 3mm#; % 'photon' lines
dot_len# := 2mm#; % 'photon' lines
wiggly_len# := 4mm#; % 'photon' lines
wiggly_slope := 60;
zigzag_len# := 2mm#;
zigzag_width# := 2thick#;
decor_size# := 5mm#;
dot_size# := 2thick#;
define_blacker_pixels (thick, thin,
dash_len, dot_len, wiggly_len, curly_len,
zigzag_len, zigzag_width, arrow_len, decor_size, dot_size);
def shrink expr s =
begingroup
if shrinkables <> "":
save tmp_;
forsuffixes $ = scantokens shrinkables:
if known $.#:
tmp_ := $.#;
save $;
$.# := s * tmp_;
define_blacker_pixels ($);
else:
tmp_ := $;
save $;
$ := s * tmp_;
fi
endfor
fi
enddef;
def endshrink =
endgroup
enddef;
string shrinkables;
shrinkables := "";
vardef addto_shrinkables (text l) =
forsuffixes $ = l:
shrinkables := shrinkables & "," & str $;
endfor
enddef;
shrinkables := "thick,thin";
addto_shrinkables (dash_len, dot_len);
addto_shrinkables (wiggly_len, curly_len);
addto_shrinkables (zigzag_len, zigzag_width);
addto_shrinkables (arrow_len);
addto_shrinkables (decor_size, dot_size);
LaTeX_unitlength := mm;
vardef count (text list) =
forsuffixes $ = list: + 1 endfor
enddef;
vardef getopt (suffix opt) (expr s) =
save n, argp, escape, anchor, skip;
numeric opt.first, opt.last, n, anchor;
string opt[], opt[]arg;
boolean opt[]tainted, argp, escape, skip;
opt.first := 0;
opt.last := 0;
opt[opt.last] := "";
argp := false;
escape := false;
anchor := 0;
skip := true;
for n = 1 upto length (s):
if skip and (substring (n-1, n) of s = " "):
anchor := anchor + 1;
else:
skip := false;
if not escape and (substring (n-1, n) of s = ","):
if substring (n, n+1) of s = ",":
escape := true;
opt[opt.last]tainted := true;
else:
if argp:
opt[opt.last]arg := substring (anchor, n-1) of s;
else:
opt[opt.last] := substring (anchor, n-1) of s;
fi
anchor := n;
argp := false;
skip := true;
opt.last := opt.last + 1;
fi
elseif not argp and (substring (n-1, n) of s = "="):
opt[opt.last] := substring (anchor, n-1) of s;
anchor := n;
argp := true;
skip := true;
elseif argp or (substring (n-1, n) of s <> " "):
escape := false;
fi
fi
endfor
if argp:
opt[opt.last]arg := substring (anchor, length s) of s;
else:
opt[opt.last] := substring (anchor, length s) of s;
fi
for n = opt.first upto opt.last:
if known opt[n]tainted:
if opt[n]tainted:
opt[n]arg := untaint_string opt[n]arg;
fi
fi
endfor
enddef;
vardef untaint_string suffix s =
save n, anchor;
numeric n, anchor;
anchor := 0;
for n = 1 upto length (s) - 1:
if substring (n-1,n+1) of s = ",,":
substring (anchor, n-1) of s &
hide (anchor := n)
fi
endfor
substring (anchor, length s) of s
enddef;
vardef split_string (suffix comp) (expr s) =
save n, anchor;
numeric comp.first, comp.last, n, anchor;
string comp[];
comp.first := 0;
comp.last := 0;
comp[comp.last] := "";
anchor := 0;
for n = 1 upto length (s):
if substring (n-1,n) of s = ".":
comp[comp.last] := substring (anchor, n-1) of s;
comp.last := comp.last + 1;
anchor := n;
fi
endfor
comp[comp.last] := substring (anchor, length s) of s;
enddef;
vardef match_prefix (expr prefix, s) =
(prefix = substring (0, length prefix) of s)
enddef;
vardef match_option (expr s, option) =
save sc, optionc, n, i;
numeric sc.first, sc.last, optionc.first, optionc.last;
string sc[], optionc[];
numeric n, i;
split_string (sc, s);
split_string (optionc, option);
n := sc.last - sc.first;
if n <> (optionc.last - optionc.first):
false
else:
true
for i = 0 upto n:
and match_prefix (sc[sc.first+i],
optionc[optionc.first+i])
endfor
fi
enddef;
def save_picture text t =
save t; picture t; forsuffixes p=t: p:=nullpicture; endfor
enddef;
def begin_sketch =
begingroup save_picture currentpicture;
sketchlevel := sketchlevel+1;
enddef;
def end_sketch =
sketchlevel := sketchlevel-1;
sketchpad[sketchlevel] := currentpicture;
endgroup
enddef;
picture sketchpad[];
sketchlevel := 1;
vardef use_sketch text t =
addto currentpicture also (sketchpad[sketchlevel] t)
enddef;
vardef cdraw expr p =
draw p withcolor foreground
enddef;
vardef cfill expr p =
fill p withcolor foreground
enddef;
vardef cfilldraw expr p =
filldraw p withcolor foreground
enddef;
vardef ccutdraw expr p =
cutdraw p withcolor foreground
enddef;
vardef cdrawdot expr p =
drawdot p withcolor foreground
enddef;
vardef isdigit expr s =
save n;
(s = "0")
for n = 1 upto 9:
or (s = decimal n)
endfor
enddef;
vardef digits_index (expr s, start) =
save n, m, from, to;
for n = start upto (length s)-1:
if isdigit (substring (n,n+1) of s):
from := n;
for m = n upto length s:
if not isdigit (substring (m,m+1) of s):
to := m;
fi
exitif known to;
endfor
fi
exitif known from;
endfor
(from, if known to: to else: infinity fi)
enddef;
vardef digits_to_brackets suffix suf =
save s, idx;
string s;
pair idx;
s = str suf;
idx = (0,0);
forever:
idx := digits_index (s, xpart idx);
exitif unknown xpart idx;
s := substring (0,xpart idx) of s
& "[]" & substring (ypart idx,infinity) of s;
endfor
s
enddef;
tile_grain := 1in/300;
vardef def_tile (suffix t) (expr wd, ht) =
if not picture tlist.t:
picture tlist.scantokens (digits_to_brackets t);
fi
tlist.t := nullpicture;
tlist.t.dx := max (floor wd, 1);
tlist.t.dy := max (floor ht, 1);
enddef;
vardef use_tile (suffix t) (expr x, y, wd, ht) =
fill unitsquare xscaled wd yscaled ht shifted (x,y)
withcolor background;
if str t = "shaded":
shade_rectangle (4thin, x, y, wd, ht);
elseif str t = "hatched":
shade_rectangle (5thin, x, y, wd, ht);
shade_rectangle (-5thin, x, y, wd, ht);
else:
if (picture tlist.t):
for nx = 0 upto wd/tlist.t.dx:
for ny = 0 upto ht/tlist.t.dy:
addto currentpicture
also (tlist.t shifted
((x,y) + (nx*tlist.t.dx, ny*tlist.t.dy)) t_);
endfor
endfor
else:
errhelp "feynmf: your tiling has not been defined, "
& "check spelling and reprocess!";
errmessage "feynmf: tiling `" & str t & "' not known, "
& "replaced by `shaded'";
use_tile (shaded, x, y, wd, ht);
fi
fi
enddef;
vardef shade_rectangle (expr dd, x, y, wd, ht) =
save d, u, dx, dy, currentpen;
pen currentpen;
pickup pencircle scaled thin;
d := max (floor (abs dd), 1);
dx := max (wd, ht);
dy := max (wd, ht);
for u = 0 step d/dx until 1:
if dd > 0:
cdraw (x-d,y+u*dy-d)--(x+(1-u)*dx+d,y+dy+d);
cdraw (x+u*dx-d,y-d)--(x+dx+d,y+(1-u)*dy+d);
else:
cdraw (x-d,y+u*dy+d)--(x+u*dx+d,y-d);
cdraw (x+(1-u)*dx-d,y+dy+d)--(x+dx+d,y+(1-u)*dy-d);
fi
endfor
enddef;
def addto_tile (suffix t) =
addto tlist.t
enddef;
vardef tile_from_string (suffix t) (expr str) =
tile_grain := max (floor tile_grain, 1);
save grain, mx, x, y, n, c, pic;
string c;
picture pic;
pic := nullpicture;
grain := tile_grain;
mx := 0;
x := 0;
y := 0;
for n := 1 upto length str:
c := substring (n-1,n) of str;
if c = "/":
mx := max (mx, x);
y := y+1;
x := 0;
elseif c = "*":
addto pic also (unitpixel shifted (x,-y) t_);
x := x+1;
elseif c = ".":
x := x+1;
fi
endfor
def_tile (t, grain*mx, grain*(y+1));
addto_tile (t) also (pic shifted (0,y) scaled grain t_);
pic := nullpicture;
enddef;
tile_from_string (gray10,
" ... /"&
" .*. /"&
" ... ");
tile_from_string (gray25,
" .. /"&
" *. ");
tile_from_string (gray50,
" .* /"&
" *. ");
tile_from_string (gray75,
" ** /"&
" .* ");
tile_from_string (gray90,
" *** /"&
" *.* /"&
" *** ");
vardef make_halftone (suffix t) (expr g, wd, ht) =
def_tile (t, wd, ht);
addto tlist.t contour unitsquare
xscaled wd yscaled ht withcolor ((1-g)*foreground + g*background)
enddef;
vardef tile (suffix t) (expr p) =
save u, x, y, max_x, min_x, max_y, min_y, xx, yy;
-max_x = -max_y = min_x = min_y = infinity;
for u = 0 step 0.1 until length p:
x := xpart (point u of p);
y := ypart (point u of p);
max_x := max(max_x, x);
max_y := max(max_y, y);
min_x := min(min_x, x);
min_y := min(min_y, y);
endfor
begin_sketch
use_tile (t, min_x, min_y, max_x-min_x, max_y-min_y);
clip currentpicture to p;
end_sketch;
use_sketch;
enddef;
vardef drawtile (suffix t) (expr p) =
tile (t, p);
cdraw p
enddef;
vardef use_halftone (expr g, x, y, wd, ht) =
fill unitsquare xscaled wd yscaled ht
shifted (x,y) withcolor ((1-g)*foreground + g*background)
enddef;
vardef halftone (expr g, p) =
fill p withcolor ((1-g)*foreground + g*background)
enddef;
vardef drawhalftone (expr g, p) =
fill p withcolor ((1-g)*foreground + g*background);
cdraw p
enddef;
vardef shade expr p =
tile (shaded, p)
enddef;
vardef hatch expr p =
tile (hatched, p)
enddef;
vardef emptydraw expr p =
cullit;
unfill p;
cullit;
cdraw p;
enddef;
vardef shadedraw expr p =
cullit;
unfill p;
cullit;
shade p;
cdraw p;
enddef;
vardef hatchdraw expr p =
cullit;
unfill p;
cullit;
hatch p;
cdraw p;
enddef;
vardef marrow (expr p, frac) =
save a, t, z;
pair z;
a = angle direction frac*length(p) of p;
z = point frac*length(p) of p;
(t1,whatever) = p intersectiontimes
(halfcircle scaled 2/3arrow_len rotated (a+90) shifted z);
(t2,whatever) = p intersectiontimes
(halfcircle scaled 4/3arrow_len rotated (a-90) shifted z);
arrow_head (p, t1, t2, arrow_ang)
enddef;
vardef tarrow (expr p, frac) =
save a, t, z;
pair z;
t1 = frac*length p;
a = angle direction t1 of p;
z = point t1 of p;
(t2,whatever) = p intersectiontimes
(halfcircle scaled 2arrow_len rotated (a-90) shifted z);
arrow_head (p, t1, t2, arrow_ang)
enddef;
vardef harrow (expr p, frac) =
save a, t, z;
pair z;
t2 = frac*length p;
a = angle direction t2 of p;
z = point t2 of p;
(t1,whatever) = p intersectiontimes
(halfcircle scaled 2arrow_len rotated (a+90) shifted z);
arrow_head (p, t1, t2, arrow_ang)
enddef;
vardef arrow_head (expr p, from, to, ang) =
save tip, ap, t;
pair tip;
path ap;
t1 := from;
t2 := to;
if t1 = -1: t1 := 0; fi
if t2 = -1: t2 := infinity; fi
tip = point t2 of p;
ap = subpath (t1,t2) of p shifted -tip;
(ap rotated ang
forced_join reverse ap rotated -ang
-- cycle) shifted tip
enddef;
vardef arrow expr p =
marrow (p, .5)
enddef;
tertiarydef p forced_join q =
subpath (0, length p - 1) of p
& point (length p - 1) of p
.. controls postcontrol (length p - 1) of p
and precontrol infinity of p
.. .5[point infinity of p, point 0 of q]
.. controls postcontrol 0 of q and precontrol 1 of q
.. point 1 of q
& subpath (1, infinity) of q
enddef;
vardef cut_decors (suffix from) (expr p) (suffix to) =
subpath (if known from.decor.shape:
xpart (p intersectiontimes
(from.decor.shape scaled from.decor.size
shifted from.loc))
else:
0
fi,
if known to.decor.shape:
length p
- xpart (reverse p intersectiontimes
(to.decor.shape scaled to.decor.size
shifted to.loc))
else:
infinity
fi) of p
enddef;
vardef make_blob (expr z_arg, diameter) =
save p,currentpen; path p; pen currentpen;
pickup pencircle scaled thick;
p = fullcircle scaled diameter shifted z_arg;
shadedraw p;
enddef;
vardef draw_blob (expr z_arg, diameter) =
if sketched_blob_diameter <> diameter: % drawn lately?
begin_sketch make_blob (origin, diameter); end_sketch; % redo hard work!
sketched_blob_diameter:= diameter; % record it
fi
use_sketch shifted z_arg; % the easy way ...
enddef;
def force_new_blob = sketched_blob_diameter := -1; enddef;
force_new_blob; % initialize it.
vardef pixlen (expr p, n) =
for k=1 upto length(p): + segment_pixlen (subpath (k-1,k) of p, n) endfor
enddef;
vardef segment_pixlen (expr p, n) =
for k=1 upto n: + abs (point k/n of p - point (k-1)/n of p) endfor
enddef;
vardef wiggly expr p_arg =
save wpp;
numeric wpp;
wpp = ceiling (pixlen (p_arg, 10) / wiggly_len) / length p_arg;
for k=0 upto wpp*length(p_arg) - 1:
point k/wpp of p_arg
{direction k/wpp of p_arg rotated wiggly_slope} ..
point (k+.5)/wpp of p_arg
{direction (k+.5)/wpp of p_arg rotated - wiggly_slope} ..
endfor
if cycle p_arg: cycle else: point infinity of p_arg fi
enddef;
vardef curly expr p =
save cpp;
numeric cpp;
cpp := ceiling (pixlen (p, 10) / curly_len) / length p;
if cycle p:
for k=0 upto cpp*length(p) - 1:
point (k+.33)/cpp of p
{direction (k+.33)/cpp of p rotated 90} ..
point (k-.33)/cpp of p
{direction (k-.33)/cpp of p rotated -90} ..
endfor
cycle
else:
point 0 of p
{direction 0 of p rotated -90} ..
for k=1 upto cpp*length(p) - 1:
point (k+.33)/cpp of p
{direction (k+.33)/cpp of p rotated 90} ..
point (k-.33)/cpp of p
{direction (k-.33)/cpp of p rotated -90} ..
endfor
point infinity of p
{direction infinity of p rotated 90}
fi
enddef;
vardef zigzag expr p =
save zpp;
numeric zpp;
zpp = ceiling (pixlen (p, 10) / zigzag_len) / length p;
if not cycle p:
point 0 of p --
fi
for k = 0 upto zpp*length(p) - 1:
point (k+1/3)/zpp of p shifted
(zigzag_width
* dir angle (direction (k+1/3)/zpp of p rotated 90)) --
point (k+2/3)/zpp of p shifted
(zigzag_width
* dir angle (direction (k+2/3)/zpp of p rotated -90)) --
endfor
if cycle p:
cycle
else:
point infinity of p
fi
enddef;
save vsty_hash;
def style_def suffix s =
vsty_hash.s := 1;
expandafter quote vardef scantokens ("draw_" & str s)
enddef;
vardef vsty_exists suffix s =
known vsty_hash.s
enddef;
vardef valid_style expr s =
expandafter vsty_exists scantokens (s)
enddef;
style_def phantom expr p =
\
enddef;
style_def phantom_arrow expr p =
cfill (arrow p);
enddef;
style_def plain expr p =
cdraw p;
enddef;
style_def plain_arrow expr p =
cdraw p;
cfill (arrow p);
enddef;
style_def dbl_plain expr p =
draw_double p;
enddef;
style_def dbl_plain_arrow expr p =
draw_double_arrow p;
enddef;
style_def wiggly expr p =
cdraw (wiggly p);
enddef;
style_def dbl_wiggly expr p =
draw_double (wiggly p);
enddef;
style_def curly expr p =
cdraw (curly p);
enddef;
style_def dbl_curly expr p =
draw_double (curly p);
enddef;
style_def zigzag expr p =
cdraw (zigzag p);
enddef;
style_def dbl_zigzag expr p =
draw_double (zigzag p);
enddef;
style_def dashes expr p =
save dpp;
numeric dpp;
dpp = ceiling (pixlen (p, 10) / dash_len) / length p;
for k=0 upto dpp*length(p) - 1:
cdraw point k/dpp of p ..
point (k+.5)/dpp of p;
endfor
enddef;
style_def dbl_dashes expr p =
save dpp;
numeric dpp;
dpp = ceiling (pixlen (p, 10) / dash_len) / length p;
for k=0 upto dpp*length(p) - 1:
draw_double point k/dpp of p ..
point (k+.5)/dpp of p;
endfor
enddef;
style_def dbl_dashes_arrow expr p =
draw_dbl_dashes p;
shrink (1.5);
cfill (arrow p);
endshrink;
enddef;
style_def dashes_arrow expr p =
draw_dashes p;
cfill (arrow p);
enddef;
style_def dots expr p =
save dpp;
numeric dpp;
dpp = ceiling (pixlen (p, 10) / dot_len) / length p;
for k=0 upto dpp*length(p):
cdrawdot point k/dpp of p;
endfor
enddef;
style_def dbl_dots expr p =
save dpp;
numeric dpp;
dpp = ceiling (pixlen (p, 10) / dot_len) / length p;
begingroup
save oldpen;
pen oldpen;
oldpen := currentpen;
pickup oldpen scaled 3; % draw a thick linn
for k=0 upto dpp*length(p):
cdrawdot point k/dpp of p;
endfor
pickup oldpen;
cullit;
for k=0 upto dpp*length(p):
undrawdot point k/dpp of p;
endfor
cullit; % and remove the stuffing
endgroup;
enddef;
style_def dbl_dots_arrow expr p =
draw_dbl_dots p;
shrink (1.5);
cfill (arrow p);
endshrink;
enddef;
style_def dots_arrow expr p =
draw_dots p;
cfill (arrow p);
enddef;
style_def double expr p =
save oldpen;
pen oldpen;
oldpen := currentpen;
pickup oldpen scaled 3;
ccutdraw p;
pickup oldpen;
cullit; undraw p; cullit;
enddef;
style_def double_arrow expr p =
draw_double p;
shrink (1.5);
cfill (arrow p);
endshrink;
enddef;
style_def vanilla expr p = draw_plain p enddef;
style_def fermion expr p = draw_plain_arrow p enddef;
style_def quark expr p = draw_plain_arrow p enddef;
style_def electron expr p = draw_plain_arrow p enddef;
style_def photon expr p = draw_wiggly p enddef;
style_def boson expr p = draw_wiggly p enddef;
style_def gluon expr p = draw_curly p enddef;
style_def heavy expr p = draw_dbl_plain_arrow p enddef;
style_def ghost expr p = draw_dots_arrow p enddef;
style_def scalar expr p = draw_dashes_arrow p enddef;
vardef fermion expr path_arg =
cfill (arrow (path_arg));
path_arg
enddef;
vardef photon expr path_arg =
wiggly path_arg
enddef;
vardef gluon expr path_arg =
curly path_arg
enddef;
tracingstats:=1;
boolean vtracing;
vtracing := false; % true
def vinit =
save vhash;
numeric vlist.first, vlist.last;
vlist.first := 1;
vlist.last := 0;
pair vlist[]loc;
numeric vlist[]decor.size, vlist[]decor.ang,
vlist[]arc.first, vlist[]arc.last,
vlist[]arc[], vlist[]arc[]lsr,
vlist[]arc[]tns, vlist[]arc[]lbl.dist,
vlist[]arc[]tag, vlist[]arc[]wd, vlist[]arc[]rub,
vlist[]constr.first, vlist[]constr.last,
vlist[]constr[], lambdax[][], lambday[][];
string vlist[]name, vlist[]lbl, vlist[]decor.sty,
vlist[]arc[]sty, vlist[]arc[]lbl, vlist[]arc[]lbl.side;
numeric vlist[]lbl.ang;
path vlist[]decor.shape;
color vlist[]fore, vlist[]back,
vlist[]arc[]fore, vlist[]arc[]back;
numeric plist.first, plist.last, plist[]cnt, plist[]vtx[],
plist[]pull, plist[]lbl.ang, plist[]lbl.dist;
string plist[]lbl, plist[]sty, plist[]cona, plist[]conb;
plist.first := 1;
plist.last := 0;
numeric vlist[]poly.first, vlist[]poly.last,
vlist[]poly[], vlist[]poly[]idx;
pair lambdap[][];
color plist[]fore, plist[]back;
enddef;
def vertices =
vlist.first upto vlist.last
enddef;
def varcs (text i) =
vlist[i]arc.first upto vlist[i]arc.last
enddef;
def vconstr (text i) =
vlist[i]constr.first upto vlist[i]constr.last
enddef;
def polygons =
plist.first upto plist.last
enddef;
def vpoly (text i) =
vlist[i]poly.first upto vlist[i]poly.last
enddef;
vardef venter suffix v =
if not vexists v:
vlist.last := vlist.last + 1;
vhash.v := vlist.last;
vlist[vhash.v]name := str v;
vlist[vhash.v]loc := (whatever,whatever);
vlist[vhash.v]arc.first := 1;
vlist[vhash.v]arc.last := 0;
vlist[vhash.v]constr.first := 1;
vlist[vhash.v]constr.last := 0;
vlist[vhash.v]lbl := "";
vlist[vhash.v]lbl.ang := whatever;
vlist[vhash.v]lbl.dist := 3thick;
vlist[vhash.v]fore := (whatever, whatever, whatever);
vlist[vhash.v]back := (whatever, whatever, whatever);
vlist[vhash.v]poly.first := 1;
vlist[vhash.v]poly.last := 0;
fi
enddef;
vardef vexists suffix v =
if known vhash.v: true else: false fi
enddef;
vardef vlookup suffix v =
if vexists v: vhash.v else: 0 fi
enddef;
vardef vloc suffix v =
vlist[vlookup v]loc
enddef;
vardef vconnect (expr linesty) (text vl) =
save from, nfrom, nto, nopt, sty;
numeric from, nfrom, nto, nopt;
string sty;
getopt (opt, linesty);
sty := opt[opt.first];
if known opt[opt.first]arg:
message "feynmf: line styles don't take arguments. "
& "Argument `" & opt[opt.first]arg & "' ignored.";
fi
opt.first := opt.first + 1;
forsuffixes to = vl:
venter to;
nto := vlookup to;
if known nfrom:
vlist[nfrom]arc.last := vlist[nfrom]arc.last + 1;
vlist[nfrom]arc[vlist[nfrom]arc.last] := nto;
vlist[nfrom]arc[vlist[nfrom]arc.last]tns := 1;
if nfrom <> nto:
vlist[nto]arc.last := vlist[nto]arc.last + 1;
vlist[nto]arc[vlist[nto]arc.last] := nfrom;
vlist[nto]arc[vlist[nto]arc.last]tns := 1;
fi
vlist[nfrom]arc[vlist[nfrom]arc.last]lbl := "";
vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side := "";
vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist := 3thick;
for nopt = opt.first upto opt.last:
if match_option (opt[nopt], "tension"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
vlist[nfrom]arc[vlist[nfrom]arc.last]tns);
get_argument (opt[nopt], scantokens (opt[nopt]arg),
vlist[nto]arc[vlist[nto]arc.last]tns);
elseif match_option (opt[nopt], "left"):
if known opt[nopt]arg:
vlist[nfrom]arc[vlist[nfrom]arc.last]lsr
:= - scantokens (opt[nopt]arg);
else:
vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := -1;
fi
elseif match_option (opt[nopt], "straight"):
vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 0;
ignore_argument (opt[nopt], opt[nopt]arg);
elseif match_option (opt[nopt], "right"):
if known opt[nopt]arg:
vlist[nfrom]arc[vlist[nfrom]arc.last]lsr
:= scantokens (opt[nopt]arg);
else:
vlist[nfrom]arc[vlist[nfrom]arc.last]lsr := 1;
fi
elseif match_option (opt[nopt], "label"):
get_argument (opt[nopt], opt[nopt]arg,
vlist[nfrom]arc[vlist[nfrom]arc.last]lbl);
elseif match_option (opt[nopt], "label.side"):
get_argument (opt[nopt], opt[nopt]arg,
vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.side);
elseif match_option (opt[nopt], "label.dist"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
vlist[nfrom]arc[vlist[nfrom]arc.last]lbl.dist);
elseif match_option (opt[nopt], "tag"):
if known opt[nopt]arg:
vlist[nfrom]arc[vlist[nfrom]arc.last]tag
:= scantokens (opt[nopt]arg);
else:
vlist[nfrom]arc[vlist[nfrom]arc.last]tag := 0;
fi
elseif match_option (opt[nopt], "width"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
vlist[nfrom]arc[vlist[nfrom]arc.last]wd);
elseif match_option (opt[nopt], "foreground"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
vlist[nfrom]arc[vlist[nfrom]arc.last]fore);
elseif match_option (opt[nopt], "background"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
vlist[nfrom]arc[vlist[nfrom]arc.last]back);
elseif match_option (opt[nopt], "rubout"):
if known opt[nopt]arg:
vlist[nfrom]arc[vlist[nfrom]arc.last]rub
:= scantokens (opt[nopt]arg);
else:
vlist[nfrom]arc[vlist[nfrom]arc.last]rub := 2;
fi
else:
ignore_option (opt[nopt], opt[nopt]arg);
fi
endfor
handle_line_style (vlist[nfrom]arc[vlist[nfrom]arc.last]sty, sty);
vlist[nto]arc[vlist[nto]arc.last]lsr
:= vlist[nfrom]arc[vlist[nfrom]arc.last]lsr;
fi
nfrom := nto;
endfor
enddef;
vardef handle_line_style (suffix sty) (expr name) =
if valid_style name:
sty := name;
else:
errhelp "feynmf: your linestyle is not recognizable, "
& "check spelling and reprocess!";
errmessage "feynmf: line style `" & name & "' not known, "
& "replaced by `vanilla'";
sty := "vanilla";
fi
enddef;
vardef get_argument (expr opt, arg) (suffix variable) =
if known arg:
variable := arg;
else:
message "feynmf: option `" & opt & "' needs an argument. Ignored.";
fi
enddef;
vardef ignore_argument (expr opt, arg) =
if known arg:
message "feynmf: option `" & opt & "' doesn't take an argument. "
& "Argument `" & arg & "' ignored.";
fi
enddef;
vardef ignore_option (expr opt, arg)=
if known arg:
message "feynmf: ignoring option " & opt & "=" & arg & ".";
else:
message "feynmf: ignoring option " & opt & ".";
fi
enddef;
vardef vconnectn (expr linesty) (suffix v) (expr n) =
vconnect (linesty, vmklist (v, n));
enddef;
vardef vpath@# (suffix from, to) =
save nfrom, nto, origin, index, unknown_path;
numeric nfrom, nto, origin, index;
path unknown_path;
if (known vloc from) and (known vloc to):
nfrom := vlookup from;
nto := vlookup to;
vmatch_path (nfrom, nto, maybe_empty@#);
if (unknown origin) or (unknown index):
vmatch_path (nto, nfrom, maybe_empty@#);
fi
fi
if (known origin) and (known index):
vbuild_cut_arc (origin, index)
else:
unknown_path
fi
enddef;
vardef maybe_empty@# =
save _prefix;
_prefix=137;
if known _prefix@#:
whatever
else:
@#
fi
enddef;
vardef vmatch_path (expr nfrom, nto, t) =
save i;
for i = varcs (nfrom):
if (vlist[nfrom]arc[i] = nto) and (known vlist[nfrom]arc[i]sty):
if unknown t:
origin := nfrom;
index := i;
else:
if known vlist[nfrom]arc[i]tag:
if vlist[nfrom]arc[i]tag = t:
origin := nfrom;
index := i;
fi
fi
fi
fi
endfor
enddef;
vardef vcyclen (expr sty) (suffix v) (expr n) =
for $ = 1 upto n - 1:
vconnect (sty, v[$], v[$+1]);
endfor
vconnect (sty, v[n], v[1]);
enddef;
vardef vrcyclen (expr sty) (suffix v) (expr n) =
vconnect (sty, v[1], v[n]);
for $ = n downto 2:
vconnect (sty, v[$], v[$-1]);
endfor
enddef;
vardef vforce (expr z) (suffix v) =
venter v;
vlist[vlookup v]loc := z;
enddef;
vardef vshift (expr z) (text vl) =
forsuffixes $=vl:
if vexists $:
vlist[vlookup $]loc := vlist[vlookup $]loc + z;
fi
endfor
enddef;
vardef vconstraint (expr z) (text vl) =
save nfrom, nto;
numeric nfrom, nto;
forsuffixes to = vl:
venter to;
nto := vlookup to;
if known nfrom:
vlist[nfrom]constr.last := vlist[nfrom]constr.last + 1;
vlist[nto]constr.last := vlist[nto]constr.last + 1;
vlist[nfrom]constr[vlist[nfrom]constr.last] := nto;
vlist[nto]constr[vlist[nto]constr.last] := nfrom;
vlist[nto]loc = vlist[nfrom]loc + z;
fi
nfrom := nto;
endfor
enddef;
vardef vpolygon (expr psty) (suffix v) (text vl) =
save nopt, csty, nfrom, nfrom_, nto, i, n, j;
numeric nopt, nfrom, nfrom_, nto, i, n, j;
string csty;
n := count (vl) + 1;
plist.last := plist.last + 1;
plist[plist.last]cnt := n;
plist[plist.last]lbl := "";
plist[plist.last]lbl.ang := whatever;
plist[plist.last]lbl.dist := 0;
csty := "phantom";
getopt (opt, psty);
for nopt = opt.first upto opt.last:
if match_option (opt[nopt], "filled"):
get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]sty);
elseif match_option (opt[nopt], "tension"):
if known opt[nopt]arg:
csty := csty & ",tension=" & opt[nopt]arg;
else:
message "feynmf: option `tension' needs an argument. Ignored.";
fi
elseif match_option (opt[nopt], "label"):
get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]lbl);
elseif match_option (opt[nopt], "label.angle"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
plist[plist.last]lbl.ang);
elseif match_option (opt[nopt], "label.dist"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
plist[plist.last]lbl.dist);
elseif match_option (opt[nopt], "pull"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
plist[plist.last]pull);
elseif match_option (opt[nopt], "cona"):
get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]cona);
elseif match_option (opt[nopt], "conb"):
get_argument (opt[nopt], opt[nopt]arg, plist[plist.last]conb);
elseif match_option (opt[nopt], "smooth"):
plist[plist.last]cona := "..";
plist[plist.last]conb := "..";
ignore_argument (opt[nopt], opt[nopt]arg);
elseif match_option (opt[nopt], "foreground"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
plist[plist.last]fore);
elseif match_option (opt[nopt], "background"):
get_argument (opt[nopt], scantokens (opt[nopt]arg),
plist[plist.last]back);
elseif match_option (opt[nopt], "phantom"):
plist[plist.last]sty := "phantom";
elseif match_option (opt[nopt], "empty"):
plist[plist.last]sty := "empty";
elseif match_option (opt[nopt], "full"):
plist[plist.last]sty := "full";
elseif match_option (opt[nopt], "hatched"):
plist[plist.last]sty := "hatched";
elseif match_option (opt[nopt], "shaded"):
plist[plist.last]sty := "shaded";
else:
ignore_option (opt[nopt], opt[nopt]arg);
fi
endfor
canonicalize_filling plist[plist.last]sty;
vconnect (csty, v, vl, v);
i := 1;
forsuffixes to = v, vl, v:
nto := vlookup to;
if known nfrom:
if known nfrom_:
vlist[nto]loc = vlist[nfrom]loc
+ (vlist[nfrom]loc - vlist[nfrom_]loc) rotated (360/n);
fi
vlist[nto]poly.last := vlist[nto]poly.last + 1;
vlist[nto]poly[vlist[nto]poly.last] := plist.last;
vlist[nto]poly[vlist[nto]poly.last]idx := i;
plist[plist.last]vtx[i] := nto;
i := i + 1;
nfrom_ := nfrom;
fi
nfrom := nto;
endfor
enddef;
vardef canonicalize_filling suffix f =
if known f:
if is_a_number (f):
if scantokens f <= 1:
f :=
if scantokens f = 1:
"full"
elseif scantokens f > 0:
"shaded"
elseif scantokens f = 0:
"empty"
else:
"hatched"
fi;
fi
fi
fi
enddef;
vardef vpolygonn (expr sty) (suffix v) (expr n) =
vpolygon (sty, v[1], for $=2 upto n-1: v[$], endfor v[n]);
enddef;
vardef vrpolygonn (expr sty) (suffix v) (expr n) =
vpolygon (sty, v[n], for $=n-1 downto 2: v[$], endfor v[1]);
enddef;
vardef vlabel (expr s) (suffix v) =
venter v;
vlist[vlookup v]lbl := s;
enddef;
vardef vvertex (expr vtxsty) (text vl) =
save nopt, sty, arg;
numeric nopt, arg;
string sty;
getopt (opt, vtxsty);
forsuffixes v = vl:
venter v;
n := vlookup v;
for nopt = opt.first upto opt.last:
handle_vertex_option (vlist[n], opt[nopt], opt[nopt]arg);
endfor
endfor
enddef;
vardef handle_vertex_option (suffix v) (expr opt, arg) =
if match_option (opt, "label"):
get_argument (opt, arg, v.lbl);
elseif match_option (opt, "label.angle"):
get_argument (opt, scantokens (arg), v.lbl.ang);
elseif match_option (opt, "label.dist"):
get_argument (opt, scantokens (arg), v.lbl.dist);
elseif match_option (opt, "decoration.shape"):
if known arg:
make_decor_shape (v.decor.shape, arg);
else:
message "feynmf: option `decor.shape' needs an argument. Ignored.";
fi
elseif match_option (opt, "decoration.filled"):
get_argument (opt, arg, v.decor.sty);
canonicalize_filling v.decor.sty;
elseif match_option (opt, "decoration.size"):
get_argument (opt, scantokens (arg), v.decor.size);
elseif match_option (opt, "decoration.angle"):
get_argument (opt, scantokens (arg), v.decor.ang);
elseif match_option (opt, "foreground"):
get_argument (opt, scantokens (arg), v.fore);
elseif match_option (opt, "background"):
get_argument (opt, scantokens (arg), v.back);
else:
ignore_option (opt, arg);
fi
enddef;
vardef make_decor_shape (suffix p) (expr n) =
if match_prefix (n, "circle"): p := fullcircle;
elseif match_prefix (n, "square"):
p := unitsquare shifted -(.5,.5);
elseif match_prefix (n, "cross"): p := polycross 4;
elseif match_prefix (n, "triangle"): p := polygon 3;
elseif match_prefix (n, "triagon"): p := polygon 3;
elseif match_prefix (n, "diamond"): p := polygon 4;
elseif match_prefix (n, "tetragon"): p := polygon 4;
elseif match_prefix (n, "pentagon"): p := polygon 5;
elseif match_prefix (n, "hexagon"): p := polygon 6;
elseif match_prefix (n, "triagram"): p := polygram 3;
elseif match_prefix (n, "tetragram"): p := polygram 4;
elseif match_prefix (n, "pentagram"): p := polygram 5;
elseif match_prefix (n, "hexagram"): p := polygram 6;
elseif match_prefix (n, "triacross"): p := polycross 3;
elseif match_prefix (n, "tetracross"): p := polycross 4;
elseif match_prefix (n, "pentacross"): p := polycross 5;
elseif match_prefix (n, "hexacross"): p := polycross 6;
else:
if feynmfwizard:
p := scantokens(n);
else:
message "feynmf: invalid argument `" & n
& "' to option `decor.shape'. Ignored.";
fi
fi
enddef;
vardef is_a_number expr s =
save n;
if known s:
(true
for n = 1 upto length s:
and ((substring (n-1,n) of s = ".")
or (substring (n-1,n) of s = "-")
or isdigit substring (n-1,n) of s)
endfor)
else:
false
fi
enddef;
vardef vvertexn (expr vtxsty) (suffix v) (expr n) =
vvertex (vtxsty, vmklist (v, n));
enddef;
vardef vblob (expr bd) (text vl)=
forsuffixes $=vl:
if not vexists $: venter $; fi
vlist[vlookup $]decor.shape := fullcircle;
vlist[vlookup $]decor.size := bd;
vlist[vlookup $]decor.sty := "shaded";
endfor
enddef;
vardef vdot (text vl)=
forsuffixes $=vl:
if not vexists $: venter $; fi
vlist[vlookup $]decor.shape := fullcircle;
vlist[vlookup $]decor.size := dot_size;
vlist[vlookup $]decor.sty := "full";
endfor
enddef;
vardef vdotn (suffix v) (expr n) =
vdot (vmklist (v, n));
enddef;
vardef vblobn (suffix v) (expr n) =
vblob (vmklist (v, n));
enddef;
vardef curved_left_gallery = .9[se,sw] .. .5[sw,nw] .. .1[nw,ne] enddef;
vardef curved_right_gallery = .9[sw,se] .. .5[se,ne] .. .1[ne,nw] enddef;
vardef curved_bottom_gallery = .9[nw,sw] .. .5[sw,se] .. .1[se,ne] enddef;
vardef curved_top_gallery = .9[sw,nw] .. .5[nw,ne] .. .1[ne,se] enddef;
vardef curved_surround_gallery =
superellipse (.5[se,ne], .5[ne,nw], .5[nw,sw], .5[sw,se], .75)
enddef;
vardef straight_left_gallery = sw -- nw enddef;
vardef straight_right_gallery = se -- ne enddef;
vardef straight_bottom_gallery = sw -- se enddef;
vardef straight_top_gallery = nw -- ne enddef;
vardef straight_surround_gallery =
.5[se,ne] -- ne -- .5[ne,nw] -- nw
-- .5[nw,sw] -- sw -- .5[sw,se] -- se -- cycle
enddef;
vardef curved_galleries =
vardef left_gallery = curved_left_gallery enddef;
vardef right_gallery = curved_right_gallery enddef;
vardef bottom_gallery = curved_bottom_gallery enddef;
vardef top_gallery = curved_top_gallery enddef;
vardef surround_gallery = curved_surround_gallery enddef;
enddef;
vardef straight_galleries =
vardef left_gallery = straight_left_gallery enddef;
vardef right_gallery = straight_right_gallery enddef;
vardef bottom_gallery = straight_bottom_gallery enddef;
vardef top_gallery = straight_top_gallery enddef;
vardef surround_gallery = straight_surround_gallery enddef;
enddef;
vardef vleft (text vl) = vdistribute (left_gallery, vl) enddef;
vardef vright (text vl) = vdistribute (right_gallery, vl) enddef;
vardef vbottom (text vl) = vdistribute (bottom_gallery, vl) enddef;
vardef vtop (text vl) = vdistribute (top_gallery, vl) enddef;
vardef vsurround (text vl) = vdistribute (surround_gallery, vl) enddef;
curved_galleries;
vardef vdistribute (expr p) (text vl) =
save numv, len, off;
numeric numv, len, off;
numv = count (vl);
if cycle p: numv := numv + 1; fi
len := length (p);
if numv = 1:
vforce (point len/2 of p, vl);
else:
off := 0;
forsuffixes $ = vl:
vforce (point off of p, $);
off := off + len/(numv-1);
endfor
fi
enddef;
def vmklist (suffix v) (expr n) =
for $ = 1 upto n-1: v[$], endfor v[n]
enddef;
vardef vleftn (suffix v) (expr n) =
vleft (vmklist (v, n));
enddef;
vardef vrightn (suffix v) (expr n) =
vright (vmklist (v, n));
enddef;
vardef vbottomn (suffix v) (expr n) =
vbottom (vmklist (v, n));
enddef;
vardef vtopn (suffix v) (expr n) =
vtop (vmklist (v, n));
enddef;
vardef vsurroundn (suffix v) (expr n) =
vsurround (vmklist (v, n));
enddef;
vardef vfreeze =
for i = vertices:
if unknown vlist[i]loc:
origin = origin
for j = varcs (i):
+ vlist[i]arc[j]tns * (vlist[i]loc - vlist[vlist[i]arc[j]]loc)
endfor
for j = vconstr (i):
if i < vlist[i]constr[j]:
+ lambda (i, vlist[i]constr[j])
elseif i > vlist[i]constr[j]:
- lambda (vlist[i]constr[j], i)
fi
endfor
for j = vpoly (i):
+ lambdapoly (vlist[i]poly[j], plist[vlist[i]poly[j]]cnt,
vlist[i]poly[j]idx)
endfor;
fi
endfor
if vtracing: vdump; fi
enddef;
vardef lambda (expr i, j) =
(if known (xpart(vlist[i]loc - vlist[j]loc)):
lambdax[i][j]
else:
0
fi,
if known (ypart(vlist[i]loc - vlist[j]loc)):
lambday[i][j]
else:
0
fi)
enddef;
vardef lambdapoly (expr p, n, i) =
origin
if i = 1:
+ lambdap[p][2] rotated (-360/n)
elseif i = 2:
- lambdap[p][1]
fi
if i = n - 1:
- lambdap[p][n] rotated (-360/n)
elseif i = n:
+ lambdap[p][n-1]
fi
if (i > 1) and (i < n):
+ lambdap[p][i-1] + lambdap[p][i+1] rotated (-360/n)
- lambdap[p][i] - lambdap[p][i] rotated (-360/n)
fi
enddef;
vardef idraw (expr linesty, p) =
save nopt, sty, lbl, wd, rub;
numeric nopt, lbl.dist, wd, rub;
save fore, back;
color fore, back;
string sty, lbl, lbl.side;
getopt (opt, linesty);
sty := opt[opt.first];
if known opt[opt.first]arg:
message "feynmf: line styles don't take arguments. "
& "Argument `" & opt[opt.first]arg & "' ignored.";
fi
opt.first := opt.first + 1;
lbl := "";
lbl.side := "";
lbl.dist := 3thick;
for nopt = opt.first upto opt.last:
if match_option (opt[nopt], "label"):
get_argument (opt[nopt], opt[nopt]arg, lbl);
elseif match_option (opt[nopt], "label.side"):
get_argument (opt[nopt], opt[nopt]arg, lbl.side);
elseif match_option (opt[nopt], "label.dist"):
get_argument (opt[nopt], scantokens (opt[nopt]arg), lbl.dist);
elseif match_option (opt[nopt], "width"):
get_argument (opt[nopt], scantokens (opt[nopt]arg), wd);
elseif match_option (opt[nopt], "foreground"):
get_argument (opt[nopt], scantokens (opt[nopt]arg), fore);
elseif match_option (opt[nopt], "background"):
get_argument (opt[nopt], scantokens (opt[nopt]arg), back);
elseif match_option (opt[nopt], "rubout"):
if known opt[nopt]arg:
rub := scantokens (opt[nopt]arg);
else:
rub := 2;
fi
else:
ignore_option (opt[nopt], opt[nopt]arg);
fi
endfor
handle_line_style (sty, sty);
begingroup
if known fore:
save foreground;
color foreground;
foreground = fore;
fi
if known back:
save background;
color background;
foreground = back;
fi
vdraw_arc_rubout (rub, sty, wd, p, lbl);
endgroup;
enddef;
vardef ivertex (expr vtxsty, pos) =
save nopt, v;
numeric nopt, v.lbl.ang, v.lbl.dist,
v.decor.size, v.decor.ang;
pair v.loc;
string v.lbl, v.decor.sty;
path v.decor.shape;
v.loc := pos;
v.lbl := "";
v.lbl.ang := whatever;
v.lbl.dist := 3thick;
v.decor.size := decor_size;
getopt (opt, vtxsty);
for nopt = opt.first upto opt.last:
handle_vertex_option (v, opt[nopt], opt[nopt]arg);
endfor
vdraw_label (v.loc, v.lbl);
vdraw_vertex v;
enddef;
vardef vdraw =
if not feynmfwizard:
vcheck_typos;
fi
for i = vertices:
if not known vlist[i]loc:
errhelp "Your graph specification was not complete (probably a "
& "lone vertex). Check logic and reprocess!";
errmessage "feynmf: vertex `" & vlist[i]name & "' not determined, "
& "replaced by `(0,0)'.";
vlist[i]loc := origin;
fi
if unknown vlist[i]decor.size:
vlist[i]decor.size = decor_size;
fi
endfor
for i = vertices:
for j = varcs (i):
if known vlist[i]arc[j]sty:
if vlist[i]arc[j]sty <> "":
if unknown vlist[i]arc[j]rub:
begingroup
if known vlist[i]arc[j]fore:
save foreground; color foreground;
foreground = vlist[i]arc[j]fore;
fi
if known vlist[i]arc[j]back:
save background; color background;
background = vlist[i]arc[j]back;
fi
vdraw_arc (vlist[i]arc[j]sty, vlist[i]arc[j]wd,
vbuild_cut_arc (i, j), vlist[i]arc[j]lbl);
vlist[i]arc[j]sty := "";
endgroup;
fi
fi
fi
endfor;
endfor
for i = polygons:
vdraw_label (pcenter plist[i], plist[i]lbl);
vdraw_polygon plist[i];
endfor
for i = vertices:
vdraw_label (vlist[i]loc, vlist[i]lbl);
vdraw_vertex vlist[i];
endfor
for i = vertices:
for j = varcs (i):
if known vlist[i]arc[j]sty:
if vlist[i]arc[j]sty <> "":
if known vlist[i]arc[j]rub:
begingroup
if known vlist[i]arc[j]fore:
save foreground; color foreground;
foreground = vlist[i]arc[j]fore;
fi
if known vlist[i]arc[j]back:
save background; color background;
background = vlist[i]arc[j]back;
fi
vdraw_arc_rubout (vlist[i]arc[j]rub,
vlist[i]arc[j]sty,
vlist[i]arc[j]wd,
vbuild_cut_arc (i, j),
vlist[i]arc[j]lbl);
vlist[i]arc[j]sty := "";
endgroup;
fi
fi
fi
endfor;
endfor
enddef;
vardef vcheck_typos =
save j, err;
boolean wrn;
wrn := false;
for i = vertices:
save connections;
connections = vlist[i]arc.last - vlist[i]arc.first + 1;
if connections < 1:
if unknown vlist[i]loc:
message "feynmf: warning: disconnected and unspecified vertex `"
& substring (2,infinity) of vlist[i]name
& "'.";
wrn := true;
fi
elseif connections = 1:
j := vlist[i]arc[vlist[i]arc.last];
if j < i:
if vlist[i]loc = vlist[j]loc:
message "feynmf: warning: dangling vertex `"
& substring (2,infinity) of vlist[i]name
& "' colliding with `"
& substring (2,infinity) of vlist[j]name
& "'.";
wrn := true;
fi
fi
fi
endfor
if wrn:
message "feynmf: Have you seen the warning messages above?";
message " They are usually caused by misspelling a vertex'";
message " name and can trigger errors further below!";
message " Fix the typos and run LaTeX and Metafont again.";
fi
enddef;
vardef vbuild_arc (expr lsr, from, to) =
if unknown lsr:
from -- to
else:
if lsr = 0:
from -- to
else:
from
.. (1-lsr)/2 *(to rotatedabout (.5[from,to], 90))
+ (1+lsr)/2 * (to rotatedabout (.5[from,to], -90))
.. to
fi
fi
enddef;
vardef vbuild_cut_arc (expr origin, index) =
cut_decors (vlist[origin],
if vlist[origin]arc[index] <> origin:
vbuild_arc (vlist[origin]arc[index]lsr,
vlist[origin]loc,
vlist[vlist[origin]arc[index]]loc)
else:
vbuild_tadpole (origin, index)
fi,
vlist[vlist[origin]arc[index]])
enddef;
vardef vbuild_tadpole (expr origin, index) =
save j, n, nn, nnn, aidx, aang, agap, bgap, ngap, distsum;
n := 0;
distsum := 0;
for j = varcs (origin):
if vlist[origin]arc[j] <> origin:
ang := angle direction 0 of
vbuild_arc (vlist[origin]arc[j]lsr,
vlist[origin]loc,
vlist[vlist[origin]arc[j]]loc);
n := n + 1;
distsum := distsum
+ abs (vlist[vlist[origin]arc[j]]loc - vlist[origin]loc);
aang[n] := 360;
for nn = 1 upto n:
if ang < aang[nn]:
for nnn = n - 1 downto nn:
aang[nnn+1] := aang[nnn];
aidx[nnn+1] := aidx[nnn];
endfor
aang[nn] := ang;
aidx[nn] := n;
fi
exitif known aidx[n];
endfor
fi
endfor
aidx[n+1] := aidx[1];
aang[n+1] := aang[1] + 360;
for nn = 1 upto n:
agap[nn] = aang[nn+1] - aang[nn];
endfor
if known vlist[origin]arc[index]lsr:
ngap := n;
for nn = 1 upto n:
if (aang[nn] < vlist[origin]arc[index]lsr)
and (vlist[origin]arc[index]lsr < aang[nn+1]):
ngap := nn;
fi
endfor
else:
bgap := 0;
for nn = 1 upto n:
if agap[nn] > bgap:
bgap := agap[nn];
ngap := nn;
fi
endfor
fi
if vtracing: adump (n + 1); fi
vlist[origin]loc{dir(aang[ngap]+agap[ngap]/4)}
... vlist[origin]loc + 2/3 * distsum/n
/ vlist[origin]arc[index]tns
* dir(aang[ngap]+agap[ngap]/2)
... {-dir(aang[ngap+1]-agap[ngap]/4)}vlist[origin]loc
enddef;
vardef adump expr n =
save i;
for i = 1 upto n:
message "aidx[" & decimal_ (i) & "]=" & decimal_ (aidx[i])
& ", aang[" & decimal_ (i) & "]=" & decimal_ (aang[i])
& ", agap[" & decimal_ (i) & "]=" & decimal_ (agap[i]);
endfor
enddef;
vardef vdraw_arc (expr sty, wd, arc) (suffix lbl) =
if known wd:
save currentpen;
pen currentpen;
pickup pencircle scaled wd;
fi
scantokens ("draw_" & sty) (arc);
vdraw_arc_label (arc, lbl);
enddef;
let plain_draw = draw;
vardef vdraw_arc_rubout (expr rub, sty, wd, arc) (suffix lbl) =
if known rub:
begingroup
def draw expr p =
save oldpen; pen oldpen;
oldpen := currentpen;
save currentpen; pen currentpen;
pickup oldpen scaled rub;
erase plain_draw (subpath (.1,.9)*length(p) of p)
enddef;
vdraw_arc (sty, wd, arc, lbl);
let draw = plain_draw;
endgroup;
fi
vdraw_arc (sty, wd, arc, lbl);
enddef;
vardef vbuild_polygon suffix p =
if known p.pull:
save c; pair c;
c := pcenter p;
for i = 1 upto (p.cnt - 1):
vbuild_polygon_section (p, i, i+1)
endfor
vbuild_polygon_section (p, p.cnt, 1)
else:
for i = 1 upto p.cnt:
vlist[p.vtx[i]]loc
if known p.cona: scantokens (p.cona) else: -- fi
endfor
fi
cycle
enddef;
def vbuild_polygon_section (suffix p) (expr from, to) =
vlist[p.vtx[from]]loc
if known p.cona: scantokens (p.cona) else: -- fi
p.pull[c,.5[vlist[p.vtx[from]]loc,vlist[p.vtx[to]]loc]]
if known p.conb: scantokens (p.conb) else: -- fi
enddef;
vardef pcenter suffix p =
(origin for i = 1 upto p.cnt:
+ vlist[p.vtx[i]]loc
endfor) / p.cnt
enddef;
vardef vdraw_arc_label (expr arc) (suffix lbl) =
if lbl <> "":
save _a, _z, _zz, _r;
numeric _a;
pair _z, _zz, _r;
_z := point .5 length (arc) of arc;
if lbl.dist = 0:
LaTeX_text (_z, whatever, lbl);
else:
_r := direction .5 length (arc) of arc rotated - 90;
if lbl.side = "left":
_a := angle (-_r);
elseif lbl.side = "right":
_a := angle (_r);
else:
_zz = _z - .5[point 0 of arc, point infinity of arc];
if ((_zz if length (_zz) > 0: / length (_zz) fi)
dotprod _r) >= 0:
_a := angle (_r);
else:
_a := angle (-_r);
fi
fi
LaTeX_text (_z + lbl.dist * dir _a, _a, lbl);
fi
fi
enddef;
vardef vdraw_label (expr loc) (suffix lbl) =
if lbl <> "":
save a;
numeric a;
if lbl.dist = 0:
LaTeX_text (loc, whatever, lbl);
else:
if unknown lbl.ang:
if loc = (.5w,.5h):
a := 0;
else:
a := angle (loc - (.5w,.5h));
fi
else:
a := lbl.ang;
fi
LaTeX_text (loc + lbl.dist * dir a, a, lbl);
fi
fi
enddef;
vardef vdraw_vertex suffix v =
if known v.decor.shape:
if known v.fore:
save foreground;
color foreground;
foreground = v.fore;
fi
if known v.back:
save background;
color background;
background = v.back;
fi
if known v.decor.sty:
if v.decor.sty = "empty":
emptydraw (
elseif v.decor.sty = "full":
cfilldraw (
elseif is_a_number v.decor.sty:
drawhalftone (1 - scantokens v.decor.sty / 100,
else:
drawtile (scantokens v.decor.sty,
fi
else:
cfilldraw (
fi
v.decor.shape
if known v.decor.ang: rotated v.decor.ang fi
scaled v.decor.size shifted v.loc);
fi
enddef;
vardef polygon expr n =
if n > 2:
for i = 1 upto n:
(.5up rotated (360i/n)) --
endfor
cycle
else:
fullcircle
fi
enddef;
vardef polygram expr n =
if n > 2:
for i = 1 upto n:
(.5up rotated (360i/n)) --
(.2up rotated (360(i+.5)/n)) --
endfor
cycle
else:
fullcircle
fi
enddef;
vardef polycross expr n =
save i;
for i = 1 upto n:
origin -- .5 dir (360(i-.5)/n) --
endfor
cycle
enddef;
vardef vdraw_polygon suffix p =
if known p.fore:
save foreground;
color foreground;
foreground = p.fore;
fi
if known p.back:
save background;
color background;
background = p.back;
fi
if known p.sty:
if p.sty = "phantom":
elseif p.sty = "empty":
emptydraw (vbuild_polygon p);
elseif p.sty = "full":
cfilldraw (vbuild_polygon p);
elseif is_a_number p.sty:
drawhalftone (1 - scantokens p.sty / 100, vbuild_polygon p);
else:
drawtile (scantokens p.sty, vbuild_polygon p);
fi
else:
cdraw (vbuild_polygon p);
fi
enddef;
vardef LaTeX expr text =
if LaTeX_file = "":
LaTeX_file := jobname & ".t" & decimal charcode;
write ("% " & LaTeX_file & " -- generated from " & jobname & ".mp")
to LaTeX_file;
fi
write (text & "%") to LaTeX_file
enddef;
vardef LaTeX_text (expr z, a, txt) =
LaTeX "\fmfL(" & (decimal (xpart z/LaTeX_unitlength)) & ","
& (decimal (ypart z/LaTeX_unitlength)) & ","
& (voctant a) & "){" & txt & "}";
enddef;
vardef voctant expr a =
if known a:
voctant_list[floor (a/45 + .5)]
else:
"c"
fi
enddef;
string voctant_list[];
voctant_list[-4] := "r";
voctant_list[-3] := "rt";
voctant_list[-2] := "t";
voctant_list[-1] := "lt";
voctant_list[0] := "l";
voctant_list[1] := "lb";
voctant_list[2] := "b";
voctant_list[3] := "rb";
voctant_list[4] := "r";
vardef vdump =
message ">>>>> Vertices and arcs for diagram #" & decimal charcode
& " of " & jobname & ".mf:";
for i = vertices:
message "> " & vlist[i]name & "=" & decimal_pair (vlist[i]loc)
& ": #lines="
& decimal (vlist[i]arc.last - vlist[i]arc.first + 1)
if vlist[i]lbl <> "":
& ", lbl=" & vlist[i]lbl
& ", l.angle=" & decimal_ (vlist[i]lbl.ang)
& ", l.dist=" & decimal_ (vlist[i]lbl.dist)
fi
& ".";
endfor
for i = vertices:
for j = varcs (i):
if known vlist[i]arc[j]sty:
message "> " & vlist[i]name & "*" & vlist[vlist[i]arc[j]]name
& ": " & vlist[i]arc[j]sty
& ", tns=" & decimal_ (vlist[i]arc[j]tns)
& ", lsr=" & decimal_ (vlist[i]arc[j]lsr)
& ", wd=" & decimal_ (vlist[i]arc[j]wd)
& ", rub=" & decimal_ (vlist[i]arc[j]rub)
if vlist[i]arc[j]lbl <> "":
& ", lbl=" & vlist[i]arc[j]lbl
& ", l.side=" & vlist[i]arc[j]lbl.side
& ", l.dist=" & decimal_ (vlist[i]arc[j]lbl.dist)
fi
& ".";
fi
endfor
for j = vconstr (i):
if i < vlist[i]constr[j]:
save z;
pair z;
z = vlist[vlist[i]constr[j]]loc - vlist[i]loc;
message "> " & vlist[i]name & "&"
& vlist[vlist[i]constr[j]]name
& ": " & decimal_pair (z);
fi
endfor;
endfor
enddef;
vardef decimal_ (text n) =
if known n: decimal n else: "?" fi
enddef;
vardef decimal_pair (text z) =
"(" & decimal_ (xpart z) & "," & decimal_ (ypart z) & ")"
enddef;
def show_diagram_ expr frame =
if (screen_cols < w + 2 xpart frame) or (screen_rows < h + 2 ypart frame):
screen_cols := w + 2 xpart frame;
screen_rows := h + 2 ypart frame;
openwindow currentwindow
from origin to (screen_rows, screen_cols)
at (- xpart frame, h + ypart frame);
fi
showit_;
if showstopping > 0:
stop "This is diagram #" & decimal charcode
& ". Hit return to continue...";
fi
enddef;
def show_diagram =
def show_diagram =
display blankpicture inwindow currentwindow;
show_diagram_
enddef;
show_diagram_
enddef;
def show_all_diagrams expr frame =
def showit = show_diagram frame enddef;
displaying:=1;
enddef;
endinput;
\endinput
%%
%% End of file `feynmp.mp'.
[-- Attachment #3: Type: text/plain, Size: 496 bytes --]
___________________________________________________________________________________
If your question is of interest to others as well, please add an entry to the Wiki!
maillist : ntg-context@ntg.nl / https://www.ntg.nl/mailman/listinfo/ntg-context
webpage : https://www.pragma-ade.nl / http://context.aanhet.net
archive : https://bitbucket.org/phg/context-mirror/commits/
wiki : https://contextgarden.net
___________________________________________________________________________________
^ permalink raw reply [flat|nested] 9+ messages in thread