var i,p:integer; l,s,isx:string;
 
procedure exchange(var a,b:string);
var c:string;
begin
c:=a; a:=b; b:=c; end;
 
procedure sort_pr(s:string);
var i,n,p,j:integer;
    m:array[1..100] of string;
    swop:boolean;
begin
i:=0; {обнуляем СЧЁТЧИК кол-ва СЛОВ в строке}
repeat  {***цикл в котором записываем СЛОВА В массив***}
p:=pos(' ',s);  {смотрим на какой позиции находится пробел}
inc(i);  m[i]:=copy(s,1,p-1);  {то увеличиваем СЧЁТЧИК на +1 и записываем это слово в МАССИВ}
delete(s,1,p); {после того, как слово ПРОСМОТРЕННО - мы это слово удаляем}
until p=0; {***КОНЕЦ цикла, в котором записываем НУЖНЫЕ СЛОВА В массив}
n:=i;  p:=i;
m[n]:=copy(s,1,length(s)-1);{у нас осталось последнее слово в строке, которое + в массив}
//****************************************
repeat
swop:=false;
for j:=1 to n-1 do                  BEGIN
i:=1;
l:=m[j];
s:=m[j+1];
While (I<=5)and(l[i]=s[i]) do inc(i);
If i>5 then writeln('the same')
 else
    if ord(l[i])>ord(s[i]) then begin exchange(m[j+1],m[j]); swop:=true; end;
                                  END;
n:=n-1;
until not swop;
//***************************************
m[p]:=m[p]+'.';
for i:=1 to p do write(m[i],' '); writeln;
end;
begin
write('Text= '); readln(isx);
repeat
p:=pos('.',isx);
sort_pr(copy(isx,1,p));
delete(isx,1,p+1);
until p=0;
readln; readln;
end.