uses crt,graph;
const r=20;
type z=array [1..2,1..10] of integer;
var
a,p: array [1..10] of string;
y,gd,gm,k,x1,y1,t,i,n,d,j: integer;
s,s1,s2: string;
l:z;
procedure ris (b:z ) ; {Процедура рисования графа}
begin
gd:=VGA; gm:=VGAhi; initgraph(gd,gm,'');
if graphresult=grok then
begin
d:=1;
while d<=2*n-1 do
begin
setcolor(yellow);
circle(b[1,d],b[2,d],r);
outtextXY(b[1,d],b[2,d],p[d]);
circle(b[1,d+1],b[2,d+1],r);
outtextXY(b[1,d+1],b[2,d+1],p[d+1]);
line(b[1,d],b[2,d],b[1,d+1],b[2,d+1]);
d:=d+2;
end;
d:=1;
{while d<2*n-1 do {попытался сделать рисования петли с помощью квадрата}
begin
setcolor(yellow);
if (b[1,d]=b[1,d+1]) and (b[2,d]=b[2,d+1]) then {если координаты первого круга графа =координатам второго круга то нарисовать квадрат }
begin
rectangle(10,20,50,100);
end;
d:=d+2;
end;}
end;
end;
begin
clrscr;
writeln('Kolu4ecTBo CTPOK');
readln(n);
t:=1;
writeln('BBEDuTe GPAMMATuky');
for i:=1 to n do
readln(a[i]); {вводим массив из строк}
for i:=1 to n do
begin
s:=a[i]; {одну строку из массива копируем во временную строку }
for j:=1 to length(s) do
begin
if s[j]='-' then
begin
s1:=copy(s,1,j-1); {в строку s1 копируем нетерминалы левой части}
k:=j+2;
p[2*i-1]:=s1; {массив р[i] служит для запоминания нетерминалов}
end;
end;
if s[k] in ['a'..'z'] then {если первый символ правой части маленькая буква строке s2 присваиваем символ N}
begin
p[2*i]:='N';
s2:='N';
end else
for j:=k to length(s) do
begin
if s[j] in ['A'..'Z'] then
begin
s2:=s2+s[j];
p[2*i]:=s2; {в строку s2 запоминаем нетерминал правой части}
end;
end;
writeln('BBeDuTe KoopDuHaTbi ',s1); {в массив l[i,j] запоминаются координаты}
readln(l[1,t]);
readln(l[2,t]);
t:=t+1;
writeln('BBeDuTe KoopDuHaTbi ',s2);
readln(l[1,t]);
readln(l[2,t]);
t:=t+1;
s2:='';
end;
ris(l);
readln;
end.
есть готовая программа рисующая графы...только не учтено условия рисования петель...прошу добавить процедуру или в процедуру рисования такую функцию...желательно основной код программы не трогать так как работает он без ошибок вроде