Найти в каждом предложении текста первое слово и вывести слова, которые состоят из тех же букв, что и первое слово

var a:array[1..50] of string;
i,n,j,np,k,g,l:integer;
s,s1,s2,buf:string;
f:text;
begin
assign(f,'Night.txt');
reset(f);
while not eof(f) do begin
read(f,s);
write(s);
end;
writeln;
while pos('.',s)>0 do
begin
s1:=copy(s,1,pos('.',s)-1);
delete(s,1,pos('.',s));
if s1<>'' then
begin
inc(n);
a[n]:=s1;
end;
end;
for i:=1 to n do
writeln(A[i]);
for i:=1 to n do begin
s1:=a[i];
for j:=1 to length (s1) do begin
if s1[j]<>'' then s2:=s2+s1[j]
else begin
np:=j;
end;
for l:= np + 1 to length(s1) do
if s1[l] <> ' ' then buf := buf + s1[l] else begin
if length(buf) < length(s2) then begin
for k:= 1 to length(buf) do begin
for g:= 1 to length(s2) do
if buf[k] = s2[g] then begin
writeln(buf);
break;
end;
break;
end;
buf := '';
end
else
begin
for j := 1 to length(s2) do
begin
for g := 1 to length(buf) do
if buf[g] = s2[j] then begin
writeln(buf);
break;
end;
break;
end;
buf := '';
end;
end;
end;
end;
close(f);
end.

 const mnr=[' ',',','.','-','_','!','?',':',';'];
 Var A:array[1..30] of string;
    i,n,j,np,k,g,l:byte;
    s,s1,s2,buf,st:string;
    f:text;
    mnpr,mnbuf:set of char;
Begin
assign(f,'Night.txt');
reset(f);
while not eof(f) do begin
read(f,s);
write(s);
end;
writeln;
    While Pos('.',s)>0 do
    Begin
      s1:=Copy(s,1,Pos('.',s)-1);
      Delete(s,1,Pos('.',s));
      if s1<>'' then
      Begin
        inc(n);
        A[n]:=s1+'.';
      End;
    End;
    For i:=1 to n do begin
     writeln(A[i]);
     st:=st+a[i];
     end;
for i:=1 to n do begin
s1:=a[i];
for j:=1 to length (s1) do begin
if not (s1[j] in mnr) then s2:=s2+s1[j]
else
begin
np:=j;
break;
end;
end;
for k:=1 to length(s2) do begin 
if not(s2[k] in mnpr) then 
mnpr:=mnpr+[s2[k]];
end;
for l:= np + 1 to length(s1) do begin
if not(s1[l] in mnr) then begin
buf := buf + s1[l];
mnbuf:=mnbuf+[s1[l]];
end
else
begin
if mnpr=mnbuf then st:=st+buf+' ';
buf:='';
mnbuf:=[];
end;
end;
s2:='';
mnpr:=[];
end;
writeln;
write(st);
close(f);
end.