Поиск в ширину

[ROCKY111]

Здравствуйте, нужна помощь в решении задачи на паскале.

Имеются расписания вылетов самолетов в ряде аэропортов.
Требуется по начальному и конечному пунктам предложить
варианты маршрута с возможными пересадками в порядке
возрастания числа пересадок. Для поиска вариантов реализовать
алгоритм поиска в ширину.

У меня есть программа уже рабочая, осталось только проиллюстрировать, т.е. вывести на экран то как программа ищет нужный путь.

приложение к файлу PAS файл GRAF.
Содержание файла GRAF:
Moskva-Piter.
Moskva-Tula.
Piter-Saratov.
Piter-Penza.
и т.д.

[ROCKY111]

PROGRAM GRAF;
uses crt;
type mat=array[1..10,1..10] of integer; {матрица смежности}
ukaz=^usel;
usel=record
key:integer;
left,right,back:ukaz;
end;
var
top,t,p,q,ps:ukaz; {для дерева}
matr : mat;
gr,gp:array [1..100] of integer;
f:text;
l,r,w:boolean;
fail,s:string;
word,m1,m2:array [1..20] of string;
ch:char;
i,j,a,b,m,n,k,strok,stolb,z,kolway: integer;

procedure Chtenie; {чтение из файла}
begin
assign(f,fail);
reset(f);
if IoResult<>0 then writeln('OSHIBKA');
while not Eof(f) do
begin
readln(f,s);
m:=1;
if s='' then exit;
while (s[m]<>'-') and (s[m]<>' ') do begin
m1[i]:=m1[i]+s[m];
m:=m+1;
end;
if s[m]='-' then begin i:=i+1; m:=m+1; end;
while (s[m]<>'.') and (s[m]<>' ') do begin
m2[j]:=m2[j]+s[m];
m:=m+1;
end;
if s[m]='.' then begin m:=1; j:=j+1; end;
end;
close(f);
end;

Procedure zadanie; {задание матрицы смежности}
begin
For k:=1 to n-1 do
For m:=1 to n-1 do
begin
matr[k,m]:=0;
matr[k,m]:=0
end;

for m:=1 to i-1 do begin
for k:=1 to n-1 do
begin
if m1[m]=word[k] then strok:=k;
if m2[m]=word[k] then stolb:=k;
end;
matr[strok,stolb]:=1;
end;
end;

Procedure Wiwod(matr: mat);
Begin
Clrscr;
writeln('Матрица смежности: ');
writeln;
Write(' ');
For m:=1 to n-1 do
Write(m:2); {номера столбцов матрицы}
Writeln;
For k:=1 to n-1 do
begin
Write(k:2); {номера строк матрицы}
For m:=1 to n-1 do
Write(matr[k,m]:2);
Writeln
end;
writeln;
for i:=1 to n-1 do writeln(i,'-',word[i]);
End;

function proverka(j:integer):boolean;
begin
if (j<>b) and (j<>268) then begin
proverka:=true; r:=true;
for i:=1 to z do
if j=gp[i] then m:=m+1;
if m>=10 then begin proverka:=false; r:=false; end;
if r=true then begin gp[z]:=j; z:=z+1; end;
end; end;

procedure sozd_graf(p:ukaz);
begin
if p=nil then
begin
t:=t^.back;
if t^.back<>nil then sozd_graf(t^.right);
if t^.back=nil then l:=false;
end;
if ((p<>top) and ((p^.key=a) or (p^.key=b))) or (proverka(p^.key)=false) then
if p^.right<>nil then sozd_graf(p^.right) else
begin
t:=p;
sozd_graf(p^.back^.right);
end;
if l=true then begin
k:=0; j:=p^.key; ps:=p;
for i:=1 to n do
if matr[j,i]=1 then
begin
new(q);
q^.key:=i;
q^.left:=nil;
q^.right:=nil;
q^.back:=ps;
if k=1 then begin p^.right:=q; p:=q; end
else begin p^.left:=q; p:=q; k:=1; end;
end;
if k=1 then sozd_graf(p^.back^.left)
else begin t:=p^.back; sozd_graf(t^.right); end;
end; end;

procedure put(t:ukaz);
begin
i:=1;
while t<>nil do
begin
gr[i]:=t^.key;
i:=i+1;
t:=t^.back;
end;
for j:=i-1 downto 1 do write(word[gr[j]],' ');
end;

procedure obxod(p:ukaz);
begin
if p<>nil then begin
if p^.key=b then begin kolway:=kolway+1; write('Найден путь: ');
put(p);
writeln;
end;
obxod(p^.right);
obxod(p^.left);
end;
end;

{процедура поиска}
procedure poisk;
begin
top:=nil;
new(t);
t^.key:=a;
top:=t;
top^.back:=nil;
top^.left:=nil;
top^.right:=nil;
t:=nil;
l:=true; z:=1; m:=0; gp[1]:=0;
sozd_graf(top);
obxod(top^.left);
end;

begin
clrscr;
write('введите полный путь к файлу: ');
readln(fail);
i:=1;j:=1;
chtenie;
{Выделение отдельных городов в массив}
word[1]:=m1[1];
n:=1;
for m:=2 to i-1 do begin
l:=true;
for k:=1 to n do
if word[k]=m1[m] then l:=false;
if l=true then begin n:=n+1; word[n]:=m1[m]; end;
end;
for m:=1 to j do begin
l:=true;
for k:=1 to n do
if word[k]=m2[m] then l:=false;
if l=true then begin n:=n+1; word[n]:=m2[m]; end;
end;

zadanie;
wiwod(matr);
w:=true;
While w do
begin
Writeln;
Write('Введите пункт отправления: ');
Readln(a);
Write('Введите пункт прибытия: ');
Readln(b);
Writeln;
z:=1; kolway:=0;
poisk;
if kolway=0 then writeln('Нет путей');
Write('Повторить поиск[y/n] ? ');
Readln(ch);
if ch='n' then w:=false {для выхода из цикла}
end;
end.