program Project2;

{$APPTYPE CONSOLE}

{$R *.res}

uses
  System.SysUtils;

const
  N = 4;
Type
  Arr = array of array of char;
  arr2 = array of integer;
  Arr3 = array of array of Boolean;
var
  Str: string;
  i: Integer;
  FirstArr: arr2;
  Alphabet: set of char;

function ArrToStr(TempArr: Arr): string;
var
   i, j: Integer;
   TempStr: string;
begin
   SetLength(TempArr, n, n);
   for i := 0 to n - 1 do
      for j := 0 to n - 1 do
         TempStr := TempStr + TempArr[i, j];
   ArrToStr := TempStr;
end;

function StrToArr(TempStr: string): Arr;
var
   i, j, k: Integer;
   TempArr: Arr;
begin
   k := 1;
   SetLength(TempArr, n, n);
   for i := 0 to n - 1 do
      for j := 0 to n - 1 do
      begin
         TempArr[i, j] := TempStr[k];
         inc(k);
      end;
   StrToArr := TempArr;
end;

function GetNext(MyStr: string; MyArr: arr; amount: Integer): string;
var
   counter: Integer;
   i, j, k, f: Integer;
   CurrentI, CurrentJ: Integer;
   NextI, NextJ: Integer;
   str, str2: string;
begin
   counter := 0;
   k := amount  + 1;
   for i := 0 to Length(MyStr) - amount - 1 do
   begin
      CurrentI := FirstArr[counter];
      CurrentJ := FirstArr[counter + 1];
      NextI :=  CurrentJ;
      NextJ :=  N - CurrentI - 1;
      MyArr[Nexti, Nextj] := MyStr[k];
      inc(k);
      FirstArr[counter + n * 2] := Nexti;
      FirstArr[counter + n * 2 + 1] := Nextj;
      inc(counter, 2);
      exclude(Alphabet, AnsiChar(MyArr[Nexti, Nextj]));
   end;
   for i := 97 to 122 do
      if (chr(i) in Alphabet)  then
            str2 := str2 + chr(i);
   for i := 0 to n-1 do
       for j := 0 to n-1 do
          if MyArr[i,j] = '' then
          begin
             randomize;
             f := random(Length(str2)) + 1;
             MyArr[i,j] := str2[f];
          end;
   str := ArrToStr(MyArr);
   GetNext := str;
end;

function Deshifr(TempArr: Arr; n1: integer): string;
var
   counter: Integer;
   i: Integer;
   CurrentI, CurrentJ: Integer;
   NextI, NextJ: Integer;
   TempStr: string;
begin
   counter := 0;
   for i := 0 to n1 - 1 do
   begin
      CurrentI := FirstArr[counter];
      CurrentJ := FirstArr[counter + 1];
      TempStr := TempStr + TempArr[CurrentI, CurrentJ];
      NextI :=  CurrentJ;
      NextJ :=  N - CurrentI - 1;
      FirstArr[counter + n * 2] := Nexti;
      FirstArr[counter + n * 2 + 1] := Nextj;
      inc(counter, 2);
   end;
   Deshifr := TempStr;
end;

function GetString(MyStr: string): string;
var
  Starti, Startj: Integer;
  Nexti, Nextj: Integer;
  MyArr: Arr;
  amount, k, i, j, f: Integer;
  BoolMatrix: Arr3;
  cc: integer;
  firstcc: integer;
begin
   Alphabet := ['a'..'z', 'A'..'Z'];
   randomize;
   k:=1;
   if Length(MyStr) < N then
     amount := Length(MyStr)
   else
     amount := N;
   SetLength(FirstArr, Length(MyStr)*2);
   firstcc := 0;
   SetLength(BoolMatrix, n, n);
   for i := 0 to n-1 do
       for j := 0 to n-1 do
          BoolMatrix[i,j] := False;
   SetLength(MyArr, n, n);
   for i := 0 to amount - 1 do
   begin
     repeat
        f := random(N);
        j := random(N);
     until (BoolMatrix[f,j] = False);
     BoolMatrix[f,j] := True;
     cc := 1;
     Starti := f;
     Startj := j;
     repeat
       Nexti :=  Startj;
       Nextj :=  N - Starti - 1;
       if (Starti + Nextj = n - 1) then
       begin
         BoolMatrix[Nexti,Nextj] := True;
         inc(cc);
       end;
       Starti := Nexti;
       Startj := Nextj;
     until cc = amount;
     MyArr[f, j] := MyStr[k];
     exclude(Alphabet, AnsiChar(MyArr[f, j]));
     FirstArr[firstcc] := f;
     FirstArr[firstcc + 1] := j;
     inc(firstcc, 2);
     inc(k);
   end;
   GetString := GetNext(MyStr, MyArr, amount);
end;

function LowCase(ch: char): char;
begin
   if ch in ['A'..'Z'] then
      LowCase := chr(ord(ch) + 32)
   else
      LowCase := ch;
end;

var
   mystr: string;
   NewArr: Arr;
   NewStr: string;
   myFile: TextFile;
   letter: char;
   text: string;
begin
   AssignFile(myFile, 'Test.txt');
   Reset(myFile);
   while not Eof(myFile) do
   begin
      read(myFile, letter);
      if (letter in (['a'..'z', 'A'..'Z'])) then
      begin
         letter := LowCase(letter);
         Str := Str + letter;
      end;
   end;
   CloseFile(myFile);
   mystr := GetString(Str);
   for i := 1 to Length(mystr) do
      write(mystr[i]);
   NewArr := StrToArr(mystr);
   NewStr := Deshifr(NewArr, Length(Str));
   writeln;
   for i := 1 to Length(NewStr) do
      write(NewStr[i]);
   readln;
end.