Программа сортировки слов зацикливается! Помогите разобраться

[olenka.ke]

Необходимо отсортировать слова во вводимой строчке буквой К. Моя программа работает для строки "В лесу родилась елочка". Если вводить, например, "В лесу родилась елочка в лесу она росла", то программа зацикливается. Попытки исправить это ни к чему не привели, помогите пожалуйста исправить ошибки

program dopolnitelnoe;
 label
 met;
 var
 st,m,max,min:string;
 i,k:integer;
{первая половина буквы К, нахожу максимальное слово,пишу его, удаляю его из строки, и ищу снова максимальное в новой строке}
 {-----------------------------------------------------------}
 procedure polovina1(m,st:string);
  begin
  repeat 
  k:=pos(' ',st);
  if k>0 then max:='' else max:=st;
  while k>0 do
  begin 
  if length(copy(st,1,k-1))>length(max)
  then max:=copy(st,1,k-1);
  delete(st,1,k);
  k:=pos(' ',st);
  end;
  if length(st)>length(max) then max:=st;
  writeln(max);
  delete(m,pos(max,m),length(max)+1);
  st:=m;
  until length(st)=0;
  end;
{вторая половина слова, аналогично с первой, только ищу минимальное}
 {-----------------------------------------------------------------------}
 procedure polovina2(m,st:string);
  begin
  repeat 
  k:=pos(' ',st);
  if k=length(m) then begin Writeln(m); exit end;
  min:=st;
  while k>0 do
  begin 
  if length(copy(st,1,k-1))<length(min)
  then min:=copy(st,1,k-1);
  delete(st,1,k);
  k:=pos(' ',st);
  end;
  if length(st)<length(min) then min:=st;
  writeln(min);
  delete(m,pos(min,m),length(min)+1);
  st:=m;
  until length(st)=0;
  Writeln(m);
  end;
 {-----------------------------------------------------------------------}
 begin
 writeln('Введите строку:');
 readln(st);
 Writeln('Отсортированная строка:');
 Writeln;
 m:=st;
 polovina1(m,st);
 polovina2(m,st);
 end.

[AleksandrH]

Сообщение от olenka.ke

Необходимо отсортировать слова во вводимой строчке буквой К.

Как ето?

А просто отсортировать не подходит?

uses crt;
type ar = array [1..50] of string;
var st,s1 : string;
    s,s11,s22 : ar;
    i,N,j : integer;

begin
clrscr;
writeln('Input Line');readln(st);
st := st + ' ';
s1 := '';
writeln('Slova:');
For i := 1 to Length(st) do
begin
     if st[i] <> ' ' then
        s1 := s1 + st[i]
     else
     begin
          N := N + 1;
          s[N] := s1;
          s1 := '';
          writeln(N,': ',s[N])
     end;
end;

writeln;
writeln('AZsort');
s11 := s;
   for i := 1 to n-1 do
   for j:=i to n do
     if s11[i] >s11[j] then
        begin
             s1 := s11[i];
             s11[i] := s11[j];
             s11[j] := s1
        end;
   for i := 1 to N do
     writeln(s11[i]);
   writeln('====');
writeln('ZAsort');
s11 := s;
   for i := 1 to n-1 do
   for j:=i to n do
     if s11[i] < s11[j] then
        begin
             s1 := s11[i];
             s11[i] := s11[j];
             s11[j] := s1
        end;
   for i := 1 to N do
     writeln(s11[i]);
   writeln('====');
readln;
end.

[Serge_Bliznykov]

отсортировать слова во вводимой строчке буквой К.

никак не могу сообразить, что такое сортировка "буквой К", объясните, пожалуйста.

первая половина буквы К

И что означает это?!!!

[Dvoishnik]

о шибка у вас во второй процедуре

[olenka.ke]

вы ее запускать то пробовали? она не сортирует ничего. набор слов выдает.

сначала пишутся по порядку на каждой новой строке слова- от большего к меньшему, потом наоборот. и получается "буква К"

я знаю, что во второй, я не понимаю где конкретно.

[Stilet]

Какая хитрозная задачка

program Project1;

var s:string; a:array[1..100] of string;
  i,j,v,count:integer;
  q,w:array[1..100] of integer;
begin   {$o-}
 s:='В лесу родилась елочка в лесу она росла';
 count:=1;
 i:=1; while (i<=length(s)) do begin
   if s[i]=' ' then begin inc(count);inc(i);end;
   a[count]:=a[count]+s[i];
   inc(i);
 end;
 for i:=1 to count do begin q[i]:=i; w[i]:=i; end;
 for i:=1 to count do for j:=1 to count do begin
  if length(a[q[i]])<length(a[q[j]]) then begin v:=q[i]; q[i]:=q[j]; q[j]:=v; end;
  if length(a[w[i]])>length(a[w[j]]) then begin v:=w[i]; w[i]:=w[j]; w[j]:=v; end;
 end;
 for i:=1 to count do writeln(a[w[i]]);
 for i:=1 to count do writeln(a[q[i]]);

 readln;
  { TODO -oUser -cConsole Main : Insert code here }
end.

Я угадал?