Program Sibirian;
Type Tmas = array [1..50, 1..50] of char;
Var a: Tmas;
    n: Longint;
 
Procedure Load (Var a:Tmas);
Var i, j:Longint;
Begin
   For i := 1 to 50 do
      For j := 1 to 50 do 
         a[i, j] := '*';
End;
 
Procedure DoSimple (a:Tmas; Var r, i, j:Longint);
Begin
   If r=1 then Begin
      dec (i); inc (j);
      If a[i, j]<>'*' then Write (a[i, j]);
   End
   else If r=0 then Begin
      inc (i); dec (j);
      If a[i, j]<>'*' then Write (a[i, j]);
   End;
   If j=1 then Begin
      inc (i); r := 1;
      If a[i, j]<>'*' then Write (a[i, j]);
   End;
   If i=1 then Begin
      inc (j); r := 0;
      If a[i, j]<>'*' then Write (a[i, j]);
   End;
   If a[i, j]<>'*' then DoSimple (a, r, i, j);
End;
 
Procedure Simple(Var a:Tmas);
Type Mas = array [1..50] of String;
Var s: String;
    w: Mas;
    i, j, m, k, r: Longint;
Begin
   Writeln ('Выберите тип:');
   Writeln ('1. Классический');
   Writeln ('2. Усложненный');
   Readln (m);
   While (m<>1)and(m<>2) do Begin
      Writeln ('Ошибка!');
      Readln (m);
   End;
   k := 1;
   Writeln ('Введите текст:');
   Readln (s);
   s := s + ' ';
   Load (a);
   While (s<>'') do Begin
      w[k] := copy (s, 1, pos(' ', s)-1);
      delete (s, 1, pos(' ', s));
      inc (k);
   End;
   dec (k);
   For i := 1 to k do 
      For j := 1 to length(w[i]) do a[i, j] := w[i][j];
   i := 1; j := 1;
   Writeln ('Таблица:');
   While (a[i,1]<>'*') do Begin
      While a[i,j]<>'*' do Begin
         Write (a[i, j]);
         inc (j);
      End;
      Writeln;
      inc (i);
      j := 1;
   End;
   Write ('Ответ: ');
   i := 1; j := 1;
   Write (a[i, j]);
   If m=1 then Begin
      i := 1; j := 2;
      Write (a[i, j]);
      i := 2; j := 1;
      Write (a[i, j]);
      i := 3; j := 1;
      Write (a[i, j]);
      r := 1;
      DoSimple(a, r, i, j);
   End
   else If m=2 then Begin
      i := 2; j := 1;
      Write (a[i, j]);
      i := 1; j := 2;
      Write (a[i, j]);
      i := 1; j := 3;
      Write (a[i, j]);
      r := 0;
      DoSimple(a, r, i, j);
   End;
   Writeln;
End;

Procedure DoTable (Var a:Tmas; Var r, l, x, i, j:Longint);
Begin
   If r=1 then Begin
      dec (i); inc (j);
      If x<l then a[i, j] := '#'; inc (x);
   End
   else If r=0 then Begin
      inc (i); dec (j);
      If x<l then a[i, j] := '#'; inc (x);
   End;
   If j=1 then Begin
      inc (i); r := 1;
      If x<l then a[i, j] := '#'; inc (x);
   End;
   If i=1 then Begin
      inc (j); r := 0;
      If x<l then a[i, j] := '#'; inc (x);
   End;
   If x<l then DoTable(a, r, l, x, i, j);
End;

Procedure Table (Var a:Tmas; m, l:Longint);
Var i, j, x, r:Longint;
Begin
   i := 1; j := 1;
   a[i, j] := '#';
   x := 1;
   If m=1 then Begin
      i := 1; j := 2;
      a[i, j] := '#'; inc (x);
      i := 2; j := 1;
      a[i, j] := '#'; inc (x);
      i := 3; j := 1;
      a[i, j] := '#'; inc (x);
      r := 1;
      DoTable(a, r, l, x, i, j);
   End
   else If m=2 then Begin
      i := 2; j := 1;
      a[i, j] := '#'; inc (x);
      i := 1; j := 2;
      a[i, j] := '#'; inc (x);
      i := 1; j := 3;
      a[i, j] := '#'; inc (x);
      r := 0;
      DoTable(a, r, l, x, i, j);
   End;
End;

Procedure Modification(Var a:Tmas; n:Longint);
Var s: String;
    m, i, j, x, r: Longint;
Begin
   Writeln ('Выберите тип:');
   Writeln ('1. Классический');
   Writeln ('2. Усложненный');
   Readln (m);
   While (m<>1)and(m<>2) do Begin
      Writeln ('Ошибка!');
      Readln (m);
   End;
   Writeln ('Введите текст:');
   Readln (s);
   s := s + ' ';
   Load (a);
   If n=2 then While pos(' ', s)<>length(s) do delete (s, pos(' ', s), 1);
   Table (a, m, length(s)-1);
   x := 1; i := 1; j := 1;
   Writeln ('Таблица:');
   While (a[i,1]<>'*') do Begin
      While a[i,j]<>'*' do Begin
         a[i, j] := s[x];
         Write (a[i, j]);
         inc (j);
         inc (x);
      End;
      Writeln;
      inc (i);
      j := 1;
   End;
   Write ('Ответ: ');
   i := 1; j := 1;
   Write (a[i, j]);
   If m=1 then Begin
      i := 1; j := 2;
      Write (a[i, j]);
      i := 2; j := 1;
      Write (a[i, j]);
      i := 3; j := 1;
      Write (a[i, j]);
      r := 1;
      DoSimple(a, r, i, j);
   End
   else If m=2 then Begin
      i := 2; j := 1;
      Write (a[i, j]);
      i := 1; j := 2;
      Write (a[i, j]);
      i := 1; j := 3;
      Write (a[i, j]);
      r := 0;
      DoSimple(a, r, i, j);
   End;
   Writeln;
End;

Begin
   Writeln ('Сибирский метод кодировки:');
   Writeln ('1. Простой сибирский');
   Writeln ('2. Модифицированный сибирский');
   Writeln ('3. Сложный сибирский');
   Writeln ('0. Выход');
   Readln (n);
   While (n<>0)and(n<>1)and(n<>2)and(n<>3) do Begin
      Writeln ('Ошибка!');
      Readln (n);
   End;
   If n=1 then Simple(a)
   else If (n=2)or(n=3) then Modification(a, n);
   Writeln ('До новых встреч!');
End.