Организовать циклическую перестановку слов

 
const nmax=100;
 
type m=array [1..nmax] of string;
 
var i,c,tmp:byte;
    s:string;
    p:integer;
    A:m;
    B:array[1..nmax,1..nmax] of integer;
 
Procedure vvodstroki(var st:string);
 
begin
readln(st);
st:=st+concat(' ');
end;
 
function Revers(s:string;k:byte):string;
var s1:string;
begin
if k=1 then Revers:=s[k]
else Revers:=s[k]+Revers(s,k-1);
end;
Procedure kol_slov(st:string; var k:integer);
 
begin
 
k:=0;
repeat
for var i:=1 to length(st) do
 if st[i] = ' ' then
  k:=k+1;
until k in [1..nmax];
 
 
end;
 
 
Begin
 
 
vvodstroki(s);
kol_slov(s,p);
for i:=1 to p  do
 begin
  A[i]:=copy(s,1,pos(' ',s)-1);
  delete(s,1,pos(' ',s));
 end;
 
 
 
   for i:=1 to p do 
   for var j:=1 to p do B[i,j]:=j;
   
   for i:=1 to p do begin
   swap(B[i,random(1,p)],B[i,random(1,p)]);
   swap(B[i,random(1,p)],B[i,random(1,p)]);
   swap(B[i,random(1,p)],B[i,random(1,p)]);
   swap(B[i,random(1,p)],B[i,random(1,p)]);
   swap(B[i,random(1,p)],B[i,random(1,p)]);
   end;
   c:=p;
   
   tmp:=1;
   for i:=1 to c do begin
 for var j:=1 to c do begin
 write(A[B[i,j]],' ');
 tmp:=random(1,c);
 end;
 writeln;
 end;
 
 
 
end.

var s, t: string;
    p: integer;
begin
  writeln('Введите строку:');
  readln(s);
  s := s + ' ';
  //здесь можно добавить проверку на корректность формата строки
  t := s;
  writeln;
  repeat
    writeln(t);
    p := pos(' ', t);
    t := copy(t, p + 1, length(s) - p) + copy(t, 1, p)
  until t = s;
  readln
end.