uses Graph,Crt,Drivers;
const xView=50;
var gd,gm:integer; E:TEvent; mouseX,mouseY,prevX,prevY,x0,y0:longint;
    c:char;
    n:integer; vX,vY:array[1..1000] of integer;
    m:integer; eV1,eV2:array[1..1000] of integer;
    d:integer; aV:array[1..1000] of integer;
    status,eStatus,v,w:integer;

function LSqrt(n:longint):longint;
  var v,m:longint;
  begin
  v:=65536;
  if v > n then begin v:=v shr 8; m:=23 end
           else begin v:=v shl 8; m:=5793 end;
  if v > n then begin v:=v shr 4; m:=m shr 2 end
           else begin v:=v shl 4; m:=m shl 2 end;
  if v > n then begin v:=v shr 2; m:=m shr 1 end
	   else begin v:=v shl 2; m:=m shl 1 end;
  if v > n then m:=m shr 1;
  m:=(n div m+m) shr 1;
  m:=(n div m+m) shr 1;
  m:=(n div m+m) shr 1;
  LSqrt:=m
  end;

procedure MouseCoord;
var x,y:integer;
begin
for y:=0 to 7
do for x:=0 to 7
   do if getpixel(E.Where.X*8+x-xView,E.Where.Y*8+y) = 0
      then begin mouseX:=E.Where.X*8+x-xView; mouseY:=E.Where.Y*8+y; exit; end
end;

function IsVertex(var v:integer):Boolean;
var k:integer;
begin
for k:=1 to n
do if sqr(mouseX-vX[k])+sqr(mouseY-vY[k]) <= 100
   then begin IsVertex:=true; v:=k; exit end;
IsVertex:=false
end;

function IsEdge(var v1,v2:integer):Boolean;
var k:integer; x1,y1,x2,y2,dx,dy:longint;
begin
IsEdge:=true;
for k:=1 to m
do begin
   v1:=eV1[k]; v2:=eV2[k];
   x1:=vX[v1]; y1:=vY[v1]; x2:=vX[v2]; y2:=vY[v2]; dx:=x2-x1; dy:=y2-y1;
   if (abs((mouseX-x1)*dy-(mouseY-y1)*dx) < 3*Lsqrt(sqr(dx)+sqr(dy))) and
      ((mouseX-x1)*dx+(mouseY-y1)*dy > 0) and
      ((mouseX-x2)*dx+(mouseY-y2)*dy < 0)
   then exit
   end;
IsEdge:=false
end;

procedure DrawVertex(v:integer);
var s:string;
begin
fillellipse(vX[v],vY[v],10,10);
moveto(vX[v],vY[v]); str(v,s); outtext(s);
end;

procedure EraseVertex(v:integer);
var k:integer;
begin
d:=0;
for k:=1 to m
do if      eV1[k] = v then begin inc(d); aV[d]:=eV2[k] end
   else if eV2[k] = v then begin inc(d); aV[d]:=eV1[k] end;
setcolor(7);
for k:=1 to d do line(vX[v],vY[v],vX[aV[k]],vY[aV[k]]);
fillellipse(vX[v],vY[v],10,10);
setcolor(2)
end;

procedure DrawIncEdges(x,y:integer);
var k,l,c:integer;             s:string;
begin
for k:=1 to d do line(x,y,vX[aV[k]],vY[aV[k]]);
line(x-10,y-2,x-10,y+2); line(x+10,y-2,x+10,y+2);
line(x+3,y-10,x-1,y-10); line(x-2,y+10,x+2,y+10);
line(x-9,y-5,x-5,y-9); line(x+9,y+5,x+5,y+9);
line(x+9,y-5,x+5,y-9); line(x-9,y+5,x-5,y+9)
end;

procedure RedrawGraph;
var k:integer;
begin
bar(0,0,639-xView,479); setwritemode(0); setlinestyle(0,0,1);
for k:=1 to m do line(vX[eV1[k]],vY[eV1[k]],vX[eV2[k]],vY[eV2[k]]);
for k:=1 to n do DrawVertex(k)
end;

procedure DeleteEdge(v,w:integer);
var k:integer;
begin
k:=1; while (k <= m) and
            not(((eV1[k] = v) and (eV2[k] = w)) or
                ((eV1[k] = w) and (eV2[k] = v)))    do inc(k);
for k:=k+1 to m do begin eV1[k-1]:=eV1[k]; eV2[k-1]:=eV2[k] end;
dec(m)
end;

procedure DeleteIncEdges(v:integer);
var k,k1:integer;
begin
k1:=0;
for k:=1 to m
do if (eV1[k] <> v) and (eV2[k] <> v)
   then begin inc(k1); eV1[k1]:=eV1[k]; eV2[k1]:=eV2[k] end;
m:=k1; if v = n then dec(n)
end;

procedure WriteSymbols;
begin
setviewport(0,0,639,479,true); setcolor(2);
moveto(22, 20); outtext('v');
moveto(22, 50); outtext('e');
moveto(22,110); outtext('m');
moveto(22,150); outtext('d');
setcolor(15);
case status of
0: begin moveto(22, 20); outtext('v') end;
1: begin moveto(22, 50); outtext('e') end;
3: begin moveto(22,110); outtext('m') end;
5: begin moveto(22,150); outtext('d') end;
end;
setviewport(xView,0,639,479,true); setcolor(2);
end;

function MouseInRectangle(x1,y1,x2,y2:integer):Boolean;
begin
MouseInRectangle:=(x1-xView <= mouseX) and (mouseX <= x2-xView) and
                  (y1 <= mouseY) and (mouseY <= y2)
end;

begin
Gd := Detect;
InitGraph(Gd, Gm, 'c:\bp\bgi'); if GraphResult <> grOk then  Halt(1);
setrgbpalette(1,32,32,32); setrgbpalette(2,0,0,0); setrgbpalette(5,0,0,0);
setfillstyle(1,2); bar(0,0,639,479);
setfillstyle(1,1); bar(0,0,xView-5,479);
setfillstyle(1,7); bar(xView,0,639,479);
settextjustify(1,1); setcolor(2);
rectangle(10, 10,xView-15, 30);
rectangle(10, 40,xView-15, 60);
rectangle(10,100,xView-15,120);
rectangle(10,140,xView-15,160);
rectangle( 5,450,xView-10,470);
moveto(23,460); outtext('Esc');
n:=0; m:=0; status:=0; WriteSymbols;
InitEvents;
while true
do begin
   if keypressed
   then begin
        c:=readkey;
        case ord(c) of
        27: begin DoneEvents; CloseGraph; halt; end;
        ord('v'): status:=0;
        ord('e'): status:=1;
        ord('m'): status:=3;
        ord('d'): status:=5;
        end;
        WriteSymbols;
        end;
   getMouseEvent(E); MouseCoord;
   if mouseX < 0
   then if (status = 2) or (status = 4)
        then mouseX:=0
        else begin
             if E.What = evMouseDown
             then begin
                  if      MouseInRectangle(10, 10,xView-15, 30) then status:=0
                  else if MouseInRectangle(10, 40,xView-15, 60) then status:=1
                  else if MouseInRectangle(10,100,xView-15,120) then status:=3
                  else if MouseInRectangle(10,140,xView-15,160) then status:=5
                  else if MouseInRectangle( 5,450,xView-10,470)
                       then begin DoneEvents; CloseGraph; halt; end;
                  HideMouse; WriteSymbols; ShowMouse
                  end;
                  continue
                  end;
   case status of
   0: if E.What = evMouseDown
      then begin inc(n); vX[n]:=mouseX; vY[n]:=mouseY;
                 hidemouse; DrawVertex(n)
           end;
   1: if E.What = evMouseDown
      then if IsVertex(v)
           then begin status:=2;
                      x0:=vX[v]; y0:=vY[v]; prevX:=x0; prevY:=y0;
                      setwritemode(1); setlinestyle(3,0,1)
                end;
   2: if E.What = evMouseAuto
      then begin hidemouse;
                 line(x0,y0,prevX,prevY); line(x0,y0,mouseX,mouseY);
                 prevX:=mouseX; prevY:=mouseY
           end
      else if E.What = evMouseUp
      then if IsVertex(w)
           then begin
                status:=1;
                if v <> w
                then begin hidemouse;
                           line(x0,y0,prevX,prevY);
                           setwritemode(0); setlinestyle(0,0,1);
                           line(vX[v],vY[v],vX[w],vY[w]);
                           DrawVertex(v); DrawVertex(w);
                           inc(m); eV1[m]:=v; eV2[m]:=w
                     end
                end;
   3: if E.What = evMouseDown
      then if IsVertex(v)
           then begin status:=4;
                      prevX:=vX[v]; prevY:=vY[v];
                      hidemouse; EraseVertex(v);
                      setwritemode(1); setlinestyle(3,0,1);
                      DrawIncEdges(prevX,prevY)
                end;
   4: if E.What = evMouseAuto
      then begin hidemouse;
                 DrawIncEdges(prevX,prevY); DrawIncEdges(mouseX,mouseY);
                 prevX:=mouseX; prevY:=mouseY
           end
      else if E.What = evMouseUp
      then begin status:=3;
                 vX[v]:=mouseX; vY[v]:=mouseY;
                 hidemouse; ReDrawGraph
           end;
   5: if E.What = evMouseDown
      then if IsVertex(v)
           then begin DeleteIncEdges(v);
                      hidemouse; ReDrawGraph
                end
           else if IsEdge(v,w)
                then begin DeleteEdge(v,w);
                           hidemouse; ReDrawGraph
                     end;
   end;
   ShowMouse;
   end;
end.