Слова текста из малых латинских букв записаны не менее чем через один пробел

program project;
{$mode Objfpc} {$H+}
 
uses crt, FileUtil, SysUtils;
type
  Prec=^Frec;
 
  Frec=record
  M:array of char;
  n:word;
  next:Prec;
  end;
 
 
 
var
  p,pL:Prec;
  A:array of char;
  t:char;
  i:word;
 
 
begin
  while true do begin
    t:=readkey();
    write(t);
    if t=#46 then break;
    if t=#32 then begin
       new(p); if pL<>nil then pL^.next:=p;
       p^.n:=i; p^.M:=copy(A);
       pL:=p;
       i:=0;
       continue;
    end;
    inc(i);
    SetLength(A,i);
    A[i-1]:=t;
  end;
  //readkey();
end.

var
  words:array[byte,byte] of char;
  wordLength:array[byte] of byte;
  i,j,k:byte;
  ch:char;
  dif:boolean;
begin
  writeln('Input text');
  i:=1;
  j:=1;
  repeat
    repeat
      read(ch);
    until ch<>#32;
    while (ch<>#32) and (ch<>#46) do
      begin
        words[i,j]:=ch;
        read(ch);
        inc(j);
      end;
    if ch=#32 then
      begin
        wordLength[i]:=j-1;
        inc(i);
        j:=1;
      end;
  until ch=#46;
  k:=i;
  wordLength[k]:=j-1;
  writeln('Words that differ from last one with last letter at start');
  for i:=1 to k-1 do
    begin
      j:=1;
      while (j<=wordLength[i]) and (words[i,j]=words[k,j]) do
        inc(j);
      dif:=j<=wordLength[i];
      if dif then
        begin
          if wordLength[i]>1 then
            begin
              ch:=words[i,wordLength[i]];
              for j:=wordLength[i] downto 2 do 
                words[i,j]:=words[i,j-1];
              words[i,1]:=ch;
            end;
          for j:=1 to wordLength[i] do
            write(words[i,j]);
          write(#32);
        end;
    end;
end.