%   This is the metafont for the feynfont font, release 0.3.3, 2009 October 8
%
%   Copyright 1991, 1994, 2001, 2002, 2005, 2008, Norman Gray.
%   See the file LICENCE for licence details.
%
%   Mercurial revision 204fc9a2e560, 2009-10-08 12:56 +0100
%
%
%
%   When I look at the property list of the generated TFM (using
%   tftopl) it starts with `(FAMILY CMR)': but this isn't in the cmr
%   family.  I can't find anything in cmbase.mf which would cause
%   this.  Perhaps I need to read the Metafont Book more closely.


mode_setup; font_setup;

% a# is the position of the characters above the baseline.
a# := on_math_axis * math_axis#; % math_axis is defined by cmr

% Feyn macros
input feynmac;

define_pixels (module,bigarrow,littlearrow,blobr,a);
define_blacker_pixels (linewidth,thinlinewidth);

pickup pencircle scaled linewidth;
diagram_pen := savepen;

% general definitions
phangle := 75;


%   All the character positions between 0 and hex"7F"
%   have characters in them.  Not all of these characters are ones
%   which should appear on paper; some (such as `s' or `l') only
%   appear in ligatures, and others shouldn't appear at all.  If,
%   however, there are no characters in these positions, some DVI
%   readers (including TFtoPL and OzTeX for example) complain about a
%   `bad TFM file'.  These locations are therefore occupied by the
%   character generated by the errorchar macro, which is 0pt wide, and
%   1module# high.  This character doesn't generate any real error,
%   but the glyph will be manifestly peculiar on paper.
%
%   Add code to extra_beginchar so that we keep a record of all the
%   characters that we generate, so that we can generate an errochar
%   character for each of the codepoints that we've skipped.  `charcode'
%   is defined in the expansion of beginchar()

numeric donechar[];
string  donecharerror;
donecharerror := "Duplicate character";
extra_beginchar := extra_beginchar & "if known donechar[charcode]: errmessage donecharerror; fi donechar[charcode] := 1;";

path charpath;  
  
%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%   Digits 0x30--0x39.  Obtain these from the cmr source file: romand.mf.
input romand;

%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
%   Fermions

def path_fermion (expr scale_sharp, ang) =
  begingroup
    save scale;
    scale := hround(scale_sharp*hppp);
    if ang > 0:                 % slopes upward
      (0,a) .. (scale*(cosd ang), scale*(abs sind ang)+a)
    else :
      (0,scale*(abs sind ang)+a) .. (scale*(cosd ang), a)
    fi
  endgroup
enddef;

threechars ("f", "fermion",
  path_fermion(2module#, 0), 0.5, 2module#, 0, 0,
  (0,0.1module), "top");

beginchar ("k", module#, 0, 0);
  "short fermion";
  pen;
  draw path_fermion(module#, 0);
endchar;


%   The following characters are in boxes the same vertical size as the black
%   bit of the character, but they project out of the top by an amount equal to
%   the height of the math axis, and are that same height clear of the bottom
%   of the box.
%
%%%% -90 <= ang <= +90, or all hell will break loose

threechars ("e", "upward fermion",
  path_fermion(2module#, 45), 0.5,
    2module#*(cosd 45), 2module#*(abs sind 45), 0,
    0, "ulft");

threechars ("d", "downward fermion",
  path_fermion(2module#, -45), 0.5,
    2module#*(cosd -45), 2module#*(abs sind -45), 0,
    0, "urt");

threechars ("b", "vertically upward fermion",
  path_fermion(2module#, 90), 0.5,
    2module#*(cosd 90), 2module#*(abs sind 90), 0,
    0, "urt");

charpath := path_fermion(2module#, 0);
beginchar("m", 2module#, 0, 0); "massive fermion";
  pen;
  draw charpath shifted (0,linewidth);
  draw charpath shifted (0,-linewidth);
  annotate_at(point 0.5 of charpath shifted (0,linewidth), "top");
endchar;

beginchar("M", 2module#, 0, 0); "r-arrowed massive fermion";
  pen;
  draw charpath shifted (0,linewidth);
  draw charpath shifted (0,-linewidth);
  drawarrow (bigarrow, point 0.5 of charpath, 0);
  annotate_at(point 0.5 of charpath shifted (0,linewidth), "top");
endchar;

beginchar(byte"m"-hex"60", 2module#, 0, 0); "l-arrowed massive fermion";
  pen;
  draw charpath shifted (0,linewidth);
  draw charpath shifted (0,-linewidth);
  drawarrow (bigarrow, point 0.5 of charpath, 180);
  annotate_at(point 0.5 of charpath shifted (0,linewidth), "top");
endchar;

charpath := path_fermion(module#, 0);
beginchar(hex"0B", module#, 0, 0); "short massive fermion";
  pen;
  draw charpath shifted (0,linewidth);
  draw charpath shifted (0,-linewidth);
  %drawarrow (littlearrow, point 0.5 of charpath, 0);
  annotate_at(point 0.5 of charpath shifted (0,linewidth), "top");
endchar;

begingroup
  clearxy;
  save width;
  width# := 4module#;
  define_pixels(width);
  x2-x0 = 2(x1-x0) = width;
  x1 = 0;
  y0 = y2 = 0;
  y1 = 1.6module;
  %charpath := z0{dir 60} .. {dir -60}z2;
  charpath := z0 .. z1 .. z2;

  threechars("l", "fermion loop",
    charpath shifted (0,a), 1,
    0, module#+a#, 0,
    0, "top");
  threechars("n", "fermion loop, inverted",
    charpath yscaled -1 shifted (0,a), 1,
    0, module#+a#, 0,
    0, "bot");
  threechars("o", "fermion loop, small",
    charpath scaled 0.66667 shifted (0,0.66667a), 1,
    0, module#+a#, 0,
    0, "top");
  threechars("w", "fermion loop, small, inverted",
    charpath xscaled 0.66667 yscaled -0.66667 shifted(0,0.66667a), 1,
    0, module#+a#, 0,
    0, "bot");
endgroup;


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Gauge bosons
%

def path_boson (expr scale_sharp, ang, taper) =
  begingroup
    save scale;
    clearxy;
    scale := hround(scale_sharp*hppp);
    x1 = 0; x5 = scale*(cosd ang);
    if ang > 0 :                % slopes upward
      y1 = a;
      y5 = scale*(abs sind ang) + a;
    else :
      y1 = scale*(abs sind ang) + a;
      y5 = a;
    fi
    z2-z1 = z3-z2 = z4-z3 = z5-z4;
    def ::(expr b) = {dir (ang+b)} looselink {dir (ang-b)} enddef;

    z1 ::(phangle) z2 ::(-phangle) z3 ::(phangle) z4
    if taper <> 0 :
      {dir (ang-phangle)} .. tension 1 and 0.8 .. {dir (ang+phangle/2)}
    else :
      ::(-phangle)
    fi
    z5
  endgroup
enddef;

threechars ("g", "gluon",
  path_boson(2module#, 0, 0), 2,
  2module#, 0, 0,
  (0, 0.2module), "top");
threechars ("u", "upward gluon",
  path_boson(2module#, 45, 0), 2,
  2module#*(cosd 45), 2module#*(abs sind 45), 0,
  0, "ulft");
threechars ("v", "downward gluon",
  path_boson(2module#, -45, 0), 2,
  2module#*(cosd -45), 2module#*(abs sind -45), 0,
  0, "urt");
threechars (oct"175",
  "vertical gluon",
  path_boson(2module#, 90, 1), 2,
  0, 2module#, 0,
  0, "urt");


% plus or minus phangle, depending on whether n is odd or even
def pm_angle(expr n) =
  if odd n: -1 else: 1 fi*phangle
enddef;

% a gluon quarter loop:
%   wid:    radius of loop in modules
%   nopts:  number of points
%   inv:    if 1, the loop goes from the axis to the top;
%           if 0, from the top down to the axis
%   negang: if 1, negate the photon angle (so it wiggles oppositely);
%           if 0, don't
%   taper:  if 1, the line tapers as it approaches the axis
def path_quadloop (expr wid, nopts, inv, negang, taper) =
  begingroup
    save halfwidth, myangle;
    clearxy;
    halfwidth# := wid*module#;
    define_pixels(halfwidth);
    myangle = if negang <> 0: -phangle else: phangle fi;
    z0 = (halfwidth, 0);
    for x = 1 upto nopts:
      z[x] = z0 rotated (x*90/nopts);
    endfor
    if inv = 0:
      def ::(expr p,ang) = p{p rotated(-90-ang)} looselink enddef;
      for x=nopts downto 2:
        ::(z[x], pm_angle(x+negang))
      endfor
      if taper <> 0:
        z[1]{z[1] rotated(-90+myangle)} .. tension 1 and 0.8 .. {dir -(90+myangle/2)}
      else:
        ::(z[1], pm_angle(1+negang))
      fi
      z0
    else:
      def ::(expr p,ang) = looselink {p rotated (90+ang)}p enddef;
      if taper <> 0:
        z0 {dir (90+myangle/2)} .. tension 0.8 and 1 .. z[1]{z[1] rotated(90-myangle)}
      else:
        z0{dir (90+myangle)}
        ::(z[1], pm_angle(1+negang))
      fi
      for x=1 upto nopts:
        ::(z[x], pm_angle(x+negang))
      endfor
    fi
  endgroup
enddef;


threechars ("q", "gluon, quadrant 1",
  path_quadloop(2, 6, 1, 0, 1) xscaled -1 shifted (0,a), 4,
    0, 2module#+a#, 0,
    0, "ulft");
threechars ("r", "gluon, quadrant 2",
  path_quadloop(2, 6, 0, 0, 1) shifted (0,a), 3,
    0, 2module#+a#, 0,
    0, "urt");
threechars ("s", "gluon, quadrant 3",
  path_quadloop(2, 6, 0, 1, 1) yscaled -1 shifted (0,a), 3,
    0, a#, a#-2module#,
    0, "lrt");
threechars ("t", "gluon, quadrant 4",
  path_quadloop(2, 6, 1, 1, 1) scaled -1 shifted (0,a), 4,
    0, a#, a#-2module#,
    0, "llft");
% The two loops following have the annotation off-centre, to keep
% it clear of the wiggles.  Would it look better being "top" and "bot"
% again, but with a non-zero offset in the second-last argument?
threechars ("y",  "gluon half loop",
  ((path_quadloop(2, 6, 1, 0, 0) xscaled -1)
    .. path_quadloop(2, 6, 0, 0, 0)) shifted (0,a), 7,
  0, 2module#+a#, 0,
  0, "urt");
threechars ("z",  "gluon half loop, inverted",
  ((path_quadloop(2, 6, 1, 1, 0) scaled -1)
    .. (path_quadloop(2, 6, 0, 1, 0) yscaled -1)) shifted (0,a), 7,
  0, a#, a#-2module#,
  0, "llft");

% Small and large boson half loops are at positions which are not characters.
% That's OK -- they can still be accessed by ligatures.
% 7b='{', 7c='|'
threechars (hex"7B", "large gluon half loop",
  ((path_quadloop(2.66667, 8, 1, 0, 0) xscaled -1)
    .. path_quadloop(2.66667, 8, 0, 0, 0)) shifted (0,a), 9,
  0, 2.66667module#+a#, 0,
  0, "urt");
threechars (hex"7C", "small gluon half loop",
  ((path_quadloop(1.3333, 4, 1, 0, 0) xscaled -1)
    .. path_quadloop(1.3333, 4, 0, 0, 0)) shifted (0,a), 6,
  0, 1.3333module#+a#, 0,
  0, "llft");
  


def draw_ghost(expr a, b, apos) =
  begingroup
    clearxy;
    %z1 = (0,a); z10 = (2module,a);
    z1 = a;  z10 = b;
    z4-z3 = 2(z2-z1);
    z4-z3 = z6-z5 = z8-z7;
    z2-z1 = z3-z2 = z5-z4 = z7-z6 = z9-z8 = z10-z9;
    pen;
    draw z1..z2; draw z3..z4; draw z5..z6; draw z7..z8; draw z9..z10;
    annotate_at(0.5[z5,z6], apos);
  endgroup
enddef;

beginchar ("h", 2module#, 0, 0); "ghost";
  pen;
  draw_ghost((0,a), (w,a), "top");
endchar;
beginchar (byte "h"-hex"20", 2module#, 0, 0); "r-arrowed ghost";
  pen;
  draw_ghost((0,a), (w,a), "top");
  drawarrow (littlearrow, .5[(0,a), (w,a)], 0);
endchar;
beginchar (byte "h"-hex"60", 2module#, 0, 0); "l-arrowed ghost";
  pen;
  draw_ghost((0,a), (w,a), "top");
  drawarrow (littlearrow, .5[(0,a), (w,a)], 180);
endchar;
beginchar ("i", 2module#*(cosd 45), 2module#*(sind 45), 0); "upward ghost";
  pen;
  draw_ghost((0,a), (w,h+a), "ulft");
endchar;
beginchar (byte"i"-hex"20", 2module#*(cosd 45), 2module#*(sind 45), 0);
  "r-arrowed upward ghost";
  pen;
  draw_ghost((0,a), (w,h+a), "ulft");
  drawarrow (littlearrow, .5[(0,a), (w,h+a)], 45);
endchar;
beginchar (byte"i"-hex"60", 2module#*(cosd 45), 2module#*(sind 45), 0);
  "l-arrowed upward ghost";
  pen;
  draw_ghost((0,a), (w,h+a), "ulft");
  drawarrow (littlearrow, .5[(0,a), (w,h+a)], 45+180);
endchar;
beginchar ("j", 2module#*(cosd 45), 2module#*(sind 45), 0);
  "downward ghost";
  pen;
  draw_ghost((0,h+a), (w,a), "urt");
endchar;
beginchar (byte"j"-hex"20", 2module#*(cosd 45), 2module#*(sind 45), 0);
  "r-arrowed downward ghost";
  pen;
  draw_ghost((0,h+a), (w,a), "urt");
  drawarrow (littlearrow, .5[(0,a), (w,h+a)], -45);
endchar;
beginchar (byte"j"-hex"60", 2module#*(cosd 45), 2module#*(sind 45), 0);
  "l-arrowed downward ghost";
  pen;
  draw_ghost((0,h+a), (w,a), "urt");
  drawarrow (littlearrow, .5[(0,a), (w,h+a)], -45+180);
endchar;

beginchar ("K", module#, 0, 0);			"short ghost";
  pen;
  z1 = (0,a);  z6 = (w,a);
  z4-z3 = 2(z2-z1);
  z2-z1 = z3-z2 = 1/2(z4-z3) = z5-z4 = z6-z5;
  draw z1..z2; draw z3..z4; draw z5..z6;
  annotate_at(0.5[z3,z4], "top")
endchar;


beginchar (hex"60", 2module#, 0, 0);
  "spacer";
endchar;

beginchar (hex"40", module#, 0, 0);
  "short spacer";
endchar;

beginchar ("c", 2blobr#, blobr# + a#, blobr#);	"complete vertex";
  pen;
  draw (0,a) .. (w,a) .. cycle;
  annotate_at((w/2,w/2+a), "top");
endchar;

%beginchar ("d", module#/2, 0, 0);		"weeny fermion";
%  pen;
%  draw (0,a)..(w,a);
%endchar;
%
%beginchar ("k", module#/2, 0, 0);		"weeny massive fermion";
%  pen;
%  y1 - a = y2 - a = a - y3 = a - y4 = module#/3.5;
%  x1 = x3 = 0;
%  x2 = x4 = w;
%  draw z1--z2;
%  draw z3--z4;
%endchar;
%
%beginchar ("l", module#, 0, 0);			"short massive fermion";
%  pen;
%  y1 - a = y2 - a = a - y3 = a - y4 = module#/3.5;
%  x1 = x3 = 0;
%  x2 = x4 = w;
%  draw z1--z2;
%  draw z3--z4;
%endchar;

%beginchar ("n", 4module#, 2module#-a#, 2module#-a#);
%  pen;						"fermion loop";
%  z0 = (0,a); z1 = (w,a);
%  draw z0{dir  phangle} ..tension 1.15.. {dir -phangle}z1;
%  draw z0{dir -phangle} ..tension 1.15.. {dir  phangle}z1;
%endchar;


%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
%
% Other symbols

garrow("a", 0, 1);

beginchar ("p", 2blobr#, blobr# + a#, blobr# - a#);
  pen;						"proper vertex";
  picture p[];
  pair t[];
  fill (-blobr, 0) .. (blobr, 0) .. cycle;
  p1 := currentpicture; clearit;
  draw (-blobr, 0) .. (blobr, 0) .. cycle;
  p2 := currentpicture; clearit;
  t1 = 5/6[origin, (0,blobr)] shifted (-blobr, 0);
  t7 = 5/6[origin, (0,blobr)] shifted (+blobr, 0);
  forsuffixes s = 2,3,4,5,6 :
    t[s]   = t[s-1] shifted (0, -blobr/3);
    t[s+6] = t[s+5] shifted (0, -blobr/3);
  endfor
  forsuffixes s = 1,2,3,4,5,6,7,8,9,10,11,12 :
    z[s] = t[s] rotated 45;
  endfor
  forsuffixes s = 1,2,3,4,5,6 :
    draw z[s] -- z[s+6]; 
  endfor
  addto currentpicture also p1;
  cull currentpicture keeping (2,2);  % & the two pictures
  addto currentpicture also p2;
  currentpicture := currentpicture shifted (blobr,a);
  labels (range 1 thru 12);
  annotate_at((blobr,blobr+a), "top");
endchar;

beginchar ("P", 2blobr#, blobr#+a#, blobr#-a#); % see complete vertex "c"
  pen;                                         "proper vertex 2";
  fill (0,a) .. (w,a) .. cycle;% withcolor black;
  annotate_at((w/2,w/2+a), "top");
endchar;

beginchar ("x", 0, a#, -a#); "counterterm";
  pen;
  -x1 = -x2 = x3 = x4;
  y1 = -y2 = y3 = -y4;
  z3 = (2blobr/3, 0) rotated 45;
  draw z1 .. z4;
  draw z2 .. z3;
  currentpicture := currentpicture shifted (0,a);
  annotate_at(0.5[z1,z3] shifted (0,a), "top");
endchar;

beginchar (hex"7F", module#, a#, 0);		"space block";
  pen;
  draw origin--(w,h);
  draw (0,h)--(w,0);
  % nothing
endchar;


% Now generate an errorchar() in each of the code positions we've skipped
for n = 0 upto hex"7F":
  if not known(donechar[n]):
    beginchar (n, 0, module#, 0); errorchar(h); endchar;
  fi
endfor


%   Construct the ligature tables.
ligtable "f" :	% fermion
"A" =: "F",	% right-arrowed
"V" =: hex"06",	% left-arrowed
"u" =: "e",	% upward
"d" =: "d",	% downward
"v" =: "b",	% vertical
"s" =: "k",	% short
"l" =: "l",     % loop
"0" =: hex"60";	% spacer
  
ligtable "e" :	% downward fermion, fd
"A" =: "E",	% arrowed
"V" =: hex"05";
  
ligtable "d" :	% upward fermion, fu
"A" =: "D",
"V" =: hex"04";
  
ligtable "b" :	% vertical fermion, fv
"A" =: "B",
"V" =: hex"02";

ligtable "k" :	% short fermion
"0" =: hex"40";	% short spacer

ligtable "l" :  % fermion loop
"u" =: "n",     % upside down
"S" =: "o",     % small
"A" =: "L",
"V" =: hex"0C";

ligtable "g" :	% gluon
"A" =: "G",
"V" =: hex"07",
"u" =: "u",
"d" =: "v",
"v" =: oct"175",
"l" =: "y",	% gluon half-loop
"1" =: "q",	% gluon quarter-loop, 1st quadrant (upper-left)
"2" =: "r",	% 2nd
"3" =: "s",	% 3rd
"4" =: "t";	% 4th

ligtable "m" :	% massive fermion
"A" =: "M",
"V" =: hex"0D",
"s" =: hex"0B";

ligtable "n" :  % inverted fermion
"A" =: "N",
"V" =: hex"0E";

ligtable "o" :  % fermion loop small
"u" =: "w",     % upside down
"A" =: "O",
"V" =: hex"0F";

ligtable "q" :	% gluon, 1st quadrant
"A" =: "Q",
"V" =: hex"11";

ligtable "r" :	% gluon, 2nd quadrant
"A" =: "R",
"V" =: hex"12";

ligtable "s" :	% gluon, 3rd quadrant
"A" =: "S",
"V" =: hex"13";

ligtable "t" :	% gluon, 4th quadrant
"A" =: "T",
"V" =: hex"14";

ligtable "u" :	% upward gluon
"A" =: "U",
"V" =: hex"15";

ligtable "v" :	% downward gluon
"A" =: "V",
"V" =: hex"16";

ligtable "w" : % fermion loop, small, upside-down
"A" =: "W",
"V" =: oct"027";

ligtable oct"175" :	% vertical gluon
"A" =: oct"135",
"V" =: oct"035";

ligtable "y" :	% gluon half-loop
"A" =: "Y",
"V" =: hex"19",
"B" =: hex"7B", % large
"S" =: hex"7C", % small
"u" =: "z";	% ...upside down

ligtable hex"7B" : % large gluon half loop
"A" =: hex"5B",
"V" =: hex"1B";

ligtable hex"7C" : % small gluon half loop
"A" =: hex"5C",
"V" =: hex"1C";

ligtable "z" :	% upside-down gluon loop
"A" =: "Z",
"V" =: hex"1A";

ligtable "h" :	% ghost
"A" =: "H",
"V" =: hex"08",
"u" =: "i",	% upward
"d" =: "j",	% downward
"s" =: "K";	% short

ligtable "i" :	% upward ghost
"A" =: "I",
"V" =: hex"09";

ligtable "j" :	% downward ghost
"A" =: "J",
"V" =: hex"0A";