qqs:=ceiling(qqs#*hppp); % the way rule widths are calculated
define_pixels(qqh,qqw,arrowlen,arrowht,arrowcurve);

def line (expr delx, dely) =
numeric qht,qwd,absdely;

if dely > 0:
      if delx > dely: qwd# := qqw#; qht# := dely*qqw#/delx;
              else: qht# := qqw#; qwd# := delx*qqw#/dely;    fi;
      beginchar( 8(delx-1)+(dely-1),qwd#,qht#,0pt#);
      x0=0; y0=0;
      x1=w; y1=h;
  else:
      absdely=-dely;
      if delx > absdely: qwd# := qqw#; qht# := absdely*qqw#/delx;
              else: qht# := qqw#; qwd# := delx*qqw#/absdely;    fi;
      beginchar(64+8(delx-1)+(absdely-1),qwd#,qht#,0pt#);
      x0=0; y0=h;
      x1=w; y1=0;
fi;
pickup pencircle scaled qqs;
draw z0..z1
enddef;

def larrow (expr char, delx, dely) =
numeric rxa,rxb,rxc,rxd,rxe,rya,ryb,ryc,ryd,rye;
numeric qht,qwd,absdely;
if dely > 0:
      if delx > dely: qwd# := qqw#; qht# := dely*qqw#/delx;
              else: qht# := qqw#; qwd# := delx*qqw#/dely;    fi;
   % fixed by DEK on 24 Jan 89; previous code buggy but caused no harm
  else:
      absdely=-dely;
      if delx > absdely: qwd# := qqw#; qht# := absdely*qqw#/delx;
              else: qht# := qqw#; qwd# := delx*qqw#/absdely;    fi;
fi;

beginchar(char,qwd#,qht#,0pt#);
if dely > 0: y0=0; else: y0=h; fi;

x0=0;
rxa=arrowlen; rya=0;
rxb=arrowlen; ryb=arrowht;
rxc=arrowlen; ryc=-arrowht;
rxd=.5rxa; ryd=.5ryb-arrowcurve;
rxe=rxd; rye=-ryd;

numeric rlen;
rlen = sqrt(delx*delx + dely*dely);

x1=(rxa*delx - rya*dely)/rlen;
y1=(rxa*dely+rya*delx)/rlen + y0;

%x2=rxb; y2=ryb;
x2=(rxb*delx - ryb*dely)/rlen;
y2=(rxb*dely+ryb*delx)/rlen + y0;

%x3=rxc; y3=ryc;
x3=(rxc*delx - ryc*dely)/rlen;
y3=(rxc*dely+ryc*delx)/rlen + y0;

%x4=rxd; y4=ryd;
x4=(rxd*delx - ryd*dely)/rlen;
y4=(rxd*dely+ryd*delx)/rlen + y0;

%x5=rxe; y5=rye;
x5=(rxe*delx - rye*dely)/rlen;
y5=(rxe*dely+rye*delx)/rlen + y0;

fill z0..z5..z3--z1--z2..z4..z0--cycle
enddef;

def rarrow (expr char, delx, dely) =

numeric rxa,rxb,rxc,rxd,rxe,rya,ryb,ryc,ryd,rye;
numeric qht,qwd,absdely;
if dely > 0:
      if delx > dely: qwd# := qqw#; qht# := dely*qqw#/delx;
              else: qht# := qqw#; qwd# := delx*qqw#/dely;    fi;
  else:
      absdely=-dely;
      if delx > absdely: qwd# := qqw#; qht# := absdely*qqw#/delx;
              else: qht# := qqw#; qwd# := delx*qqw#/absdely;    fi;
fi;

beginchar(char,qwd#,qht#,0pt#);

if dely > 0: y0=h; else: y0=0; fi;

x0=w;
rxa=-arrowlen; rya=0;
rxb=rxa; ryb=arrowht;
rxc=rxa; ryc=-arrowht;
rxd=.5rxa; ryd=.5ryb-arrowcurve;
rxe=rxd; rye=-ryd;

numeric rlen;
rlen = sqrt(delx*delx + dely*dely);

%x1= rxa;y1=rya;   %%%% replace the following by rotations
x1=(rxa*delx - rya*dely)/rlen + x0;
y1=(rxa*dely+rya*delx)/rlen + y0;

%x2=rxb; y2=ryb;
x2=(rxb*delx - ryb*dely)/rlen + x0;
y2=(rxb*dely+ryb*delx)/rlen + y0;

%x3=rxc; y3=ryc;
x3=(rxc*delx - ryc*dely)/rlen + x0;
y3=(rxc*dely+ryc*delx)/rlen + y0;

%x4=rxd; y4=ryd;
x4=(rxd*delx - ryd*dely)/rlen + x0;
y4=(rxd*dely+ryd*delx)/rlen + y0;

%x5=rxe; y5=rye;
x5=(rxe*delx - rye*dely)/rlen + x0;
y5=(rxe*dely+rye*delx)/rlen + y0;

fill z0..z5..z3--z1--z2..z4..z0--cycle
enddef;

% character code rules, for
%    line(x,y):
%         0 < x,y <= 6     :  8*(x-1) +  (y-1)
%
%    larrow(x,y):
%         0 < x,y <= 4     : 8*(2x-1) + (2y-1)
%         y=0              : '33
%    rarrow(x,y):
%         0 < x,y < 3      : 8*(3x-1) + (3y-1)
%         0 < x <= 4, y=3  : 8*(2x-1) +      6
%         0 < x < 4, y = 4 :   8*(2x) +      7
%         x=3, 0 < y <=4   :      8*6 + (2y-1)
%         x = 4, 0 < y < 4 :      8*7 +     2y
%         y=0              : 55
%
%   for y < 0: value is 64 + value for (x, |y|)
%
%   up arrow: '66   down arrow: '77

fontdimen 1: 0,0,0,0,0,0,0,qqs#; % line thickness in points
let cmchar=\; % cmchar should precede each character, for testing purposes


font_coding_scheme:= "LaTeX line";

cmchar "Character '00";
line(1,1);
endchar;

cmchar "Character '11";
larrow(9,1,1);
endchar;

cmchar "Character '22";
rarrow(18,1,1);
endchar;

cmchar "Character '01";
line(1,2);
endchar;

cmchar "Character '13";
larrow(11,1,2);
endchar;

cmchar "Character '25";
rarrow(21,1,2);
endchar;

cmchar "Character '02";
line(1,3);
endchar;

cmchar "Character '15";
larrow(13,1,3);
endchar;

cmchar "Character '16";
rarrow(14,1,3);
endchar;

cmchar "Character '03";
line(1,4);
endchar;

cmchar "Character '17";
larrow(15,1,4);
endchar;

cmchar "Character '27";
rarrow(23,1,4);
endchar;

cmchar "Character '04";
line(1,5);
endchar;

cmchar "Character '05";
line(1,6);
endchar;

cmchar "Character '10";
line(2,1);
endchar;

cmchar "Character '31";
larrow(25,2,1);
endchar;

cmchar "Character '52";
rarrow(42,2,1);
endchar;

cmchar "Character '12";
line(2,3);
endchar;

cmchar "Character '35";
larrow(29,2,3);
endchar;

cmchar "Character '36";
rarrow(30,2,3);
endchar;

cmchar "Character '14";
line(2,5);
endchar;

cmchar "Character '20";
line(3,1);
endchar;

cmchar "Character '51";
larrow(41,3,1);
endchar;

cmchar "Character '61";
rarrow(49,3,1);
endchar;

cmchar "Character '21";
line(3,2);
endchar;

cmchar "Character '53";
larrow(43,3,2);
endchar;

cmchar "Character '63";
rarrow(51,3,2);
endchar;

cmchar "Character '23";
line(3,4);
endchar;

cmchar "Character '57";
larrow(47,3,4);
endchar;

cmchar "Character '67";
rarrow(55,3,4);
endchar;

cmchar "Character '24";
line(3,5);
endchar;

cmchar "Character '30";
line(4,1);
endchar;

cmchar "Character '71";
larrow(57,4,1);
endchar;

cmchar "Character '72";
rarrow(58,4,1);
endchar;

cmchar "Character '32";
line(4,3);
endchar;

cmchar "Character '75";
larrow(61,4,3);
endchar;

cmchar "Character '76";
rarrow(62,4,3);
endchar;

cmchar "Character '34";
line(4,5);
endchar;

cmchar "Character '40";
line(5,1);
endchar;

cmchar "Character '41";
line(5,2);
endchar;

cmchar "Character '42";
line(5,3);
endchar;

cmchar "Character '43";
line(5,4);
endchar;

cmchar "Character '45";
line(5,6);
endchar;

cmchar "Character '50";
line(6,1);
endchar;

cmchar "Character '54";
line(6,5);
endchar;

cmchar "Character '100";
line(1,-1);
endchar;

cmchar "Character '111";
larrow(73,1,-1);
endchar;

cmchar "Character '122";
rarrow(82,1,-1);
endchar;

cmchar "Character '101";
line(1,-2);
endchar;

cmchar "Character '113";
larrow(75,1,-2);
endchar;

cmchar "Character '125";
rarrow(85,1,-2);
endchar;

cmchar "Character '102";
line(1,-3);
endchar;

cmchar "Character '115";
larrow(77,1,-3);
endchar;

cmchar "Character '116";
rarrow(78,1,-3);
endchar;

cmchar "Character '103";
line(1,-4);
endchar;

cmchar "Character '117";
larrow(79,1,-4);
endchar;

cmchar "Character '127";
rarrow(87,1,-4);
endchar;

cmchar "Character '104";
line(1,-5);
endchar;

cmchar "Character '105";
line(1,-6);
endchar;

cmchar "Character '110";
line(2,-1);
endchar;

cmchar "Character '131";
larrow(89,2,-1);
endchar;

cmchar "Character '152";
rarrow(106,2,-1);
endchar;

cmchar "Character '112";
line(2,-3);
endchar;

cmchar "Character '135";
larrow(93,2,-3);
endchar;

cmchar "Character '136";
rarrow(94,2,-3);
endchar;

cmchar "Character '114";
line(2,-5);
endchar;

cmchar "Character '120";
line(3,-1);
endchar;

cmchar "Character '151";
larrow(105,3,-1);
endchar;

cmchar "Character '161";
rarrow(113,3,-1);
endchar;

cmchar "Character '121";
line(3,-2);
endchar;

cmchar "Character '153";
larrow(107,3,-2);
endchar;

cmchar "Character '163";
rarrow(115,3,-2);
endchar;

cmchar "Character '123";
line(3,-4);
endchar;

cmchar "Character '157";
larrow(111,3,-4);
endchar;

cmchar "Character '167";
rarrow(119,3,-4);
endchar;

cmchar "Character '124";
line(3,-5);
endchar;

cmchar "Character '130";
line(4,-1);
endchar;

cmchar "Character '171";
larrow(121,4,-1);
endchar;

cmchar "Character '172";
rarrow(122,4,-1);
endchar;

cmchar "Character '132";
line(4,-3);
endchar;

cmchar "Character '175";
larrow(125,4,-3);
endchar;

cmchar "Character '176";
rarrow(126,4,-3);
endchar;

cmchar "Character '134";
line(4,-5);
endchar;

cmchar "Character '140";
line(5,-1);
endchar;

cmchar "Character '141";
line(5,-2);
endchar;

cmchar "Character '142";
line(5,-3);
endchar;

cmchar "Character '143";
line(5,-4);
endchar;

cmchar "Character '145";
line(5,-6);
endchar;

cmchar "Character '150";
line(6,-1);
endchar;

cmchar "Character '154";
line(6,-5);
endchar;

%%%Horizontal arrows:


cmchar "Character '33";
larrow(27,1,0);
endchar;

cmchar "Character '55";  %right arrow
beginchar(45,qqw#,qqw#,0pt#);
x0=w; y0=0;
x1=x0-arrowlen; y1=0;
x2=x1; y2=arrowht;
x3=x1; y3=-y2;
x4=.5[x0,x1]; y4=.5y2-arrowcurve;
x5=x4; y5=-y4;
fill z0..z4..z2--z1--z3..z5..z0--cycle;
endchar;

%%%vertical arrows


cmchar "Character '66";  %up arrow
beginchar(54,qqw#,qqw#,0pt#);
x0=0; y0=w;
y1=y0-arrowlen; x1=0;
y2=y1; x2=arrowht;
y3=y1; x3=-x2;
y4=.5[y0,y1]; x4=.5x2-arrowcurve;
y5=y4; x5=-x4;
fill z0..z4..z2--z1--z3..z5..z0--cycle;
endchar;


cmchar "Character '77"; %down arrow
beginchar(63,qqw#,qqw#,0pt#);
x0=0; y0=0;
y1=arrowlen; x1=0;
y2=y1; x2=arrowht;
y3=y1; x3=-x2;
y4=.5y1; x4=.5x2-arrowcurve;
y5=y4; x5=-x4;
fill z0..z4..z2--z1--z3..z5..z0--cycle;
endchar;

bye
