program ;
 
procedure alg(var f1,f2:text);
var sl,s:string; i,k:integer;
begin
readln(f1,s);
i:=0;
writeln(s);
repeat
if (s[i]=' ')
then begin if sl[1]=sl[length(sl)] then write(f2,sl+' ');
sl:='';
end
else sl:=sl+s[i];
i:=i+1
until i>length(s);
writeln (f2);
s:='';
end;
 
Procedure FileToFile (var f1, f2: text);
begin
     reset(f1);
     rewrite(f2);
    while not eof(f1) do
begin
alg (f1,f2);
     end;
     end;
 
var  s,fname1,fname2 :string;
     var f1,f2:text;
begin
writeln ('печать для каждой строки б в результирующий файл слова, начинающиеся и заканчивающиеся одной и той же буквой.');
writeln ('введите имя файла');
readln (fname1);
if FileExists(fname1+'.txt') then begin
   writeln ('Введите имя рeзультирующего файла');
   readln(fname2);
   assign(f1,fname1+'.txt');
   assign(f2,fname2+'.txt');
   FileToFile(f1,f2);
   end;
writeln ('Результат - в результирующий файл');
close(f1);
close(f2);
end.