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. 

есть готовая программа рисующая графы...только не учтено условия рисования петель...прошу добавить процедуру или в процедуру рисования такую функцию...желательно основной код программы не трогать так как работает он без ошибок вроде

Обращайся к автору программы.
Что за странное веяние - переделывать чужие коды? Да еще не самим, а других просить!! Просто верх нахлебничества..

Делаешь сам - поможем. Если интересная задача - сделаем. НО НЕ ПРИНОСИТЕ ЖЕ ВЫ ЧУЖИЕ КОДЫ!!

Если честно это я сам и делал...
У меня просто так и получилось что всё нормально работает что не хотелось бы трогать этот код.
Я правда не знаю как доказать что это мой код..у меня есть ещё один вариант если надо могу показать но он недоделанный. А вот этот я вчера сделал и работает...
И комментарии я сам писал прямо тут чтобы потом лишних вопросов не было...
Это мой код честно(((

Так как граф состоит из кругов я пытался сделать петлю квадратной...сказали так можно, главное что понятно что петля..
Добавлял условия если строка s1=s2 то y=t то есть запоминаем номер когда они равны.. потом в процедуре рисования добавил условия если d=y то нарисовать квадрат иначе рисовать круг и так далее ...не помоглоэ
Добавил условие в самой процедуре рисования
если b[1,d]=b[1,d+1] и b[2,d]=b[2,d+1] то нарисовать квадрат но возникает ошибка что
если мы введем
AA->AAaa
AA->aaaa
AA->aaa
то получается программа нарисует несколько петель..
Добавял условия уже после рисования кружков.. Проверял массив p[i] если один элемент массива = следующему
то рисовать квадрат с координатами там...тоже не вышло...вот и выложил программу сюда...не надо говорить что это чужая... Я её не мог не выложить же ..попросили бы пказаать свои наработки...
А то что комментарии указал это для вас же чтоб вам легче было...Я попросил не трогать потому что он хорошо работает что мне нравится...

Добавлено через 19 мин.
Я больше не знаю как доказать что это моя программа..
writeln('BBeDuTe KoopDuHaTbi ',s2);
почему я тут пишу не на русском ..потому что у меня виста, а в турбо паскале русский и graph не работают
поэтому комментарии написанные на русском писал прямо тут на сайте
а прогу проверял на виртуальной машине..чтоб проблемы с кодировкой на висте не было то ничего по русски в программе неписал...

Не надо ничего доказывать, достаточно слова. Извини, было очень похоже на чужой код, и я уже устал от того, что все так делают. Еще раз извини.
Я посмотрю, когда будет время.

Спасибо ... но я уже сдал)))
Если кому то надо могу код выложить может пригодится...

Конечно, пригодится.

Программа будет завтра вечером..флешка с программой не у меня

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;
f:text;

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;

for j:=1 to  n do
if p[2*j-1]=p[2*j]  then circle(b[1,2*j]+r,b[2,2*j]+r,5) ;
end;
end;






begin
clrscr;
assign(f,'1.txt');
reset(f);
{writeln('Kolu4ecTBo CTPOK');}
readln(f,n);
writeln(n);
t:=1;
{writeln('BBEDuTe GPAMMATuky');   }

for i:=1 to n do
    readln(f,a[i]);

for i:=1 to n do
begin
     s:=a[i];
writeln(s);
for j:=1 to length(s) do
            begin

 if s[j]='-' then
    begin
         s1:=copy(s,1,j-1);
         k:=j+2;
         p[2*i-1]:=s1;
    end;

    end;
  if s[k] in ['a'..'z'] then
 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;




 end;

 end;


writeln('BBeDuTe KoopDuHaTbi ',s1);
read(f,l[1,t]); writeln(l[1,t]);
read(f,l[2,t]); writeln(l[2,t]);
t:=t+1;
writeln('BBeDuTe KoopDuHaTbi ',s2);
read(f,l[1,t]);   writeln(l[1,t]);
readln(f,l[2,t]); writeln(l[2,t]);
t:=t+1;




s2:='';
end;

readln;
ris(l);

close(f);
readln;
end. 

вот и программа