program Text_Editor;
uses Crt;

Const KolS=80;
      KolSt=21;

Type PTekst=^Tekst;
     Tekst=array[1..kolst,1..KolS] of Char;

     Var  CurX,CurY:Byte;
     arr:PTekst;
     Ch:char;
     f,f1:text;
     S:string;
     i:integer;

Procedure ClearText_Editor(var arr:PTekst; var curX,curY:byte);
var i,j:byte;
begin
 for i:=1 to kolst do
 for j:=1 to KolS do
 arr^[i,j]:=' ';
 curX:=1;
 curY:=1;
end;

Procedure Input_Symbol(var curX,curY:byte;ch:char;var arr:PTekst);
var I:byte;
begin
  if (curX=Kols) then
  arr^[curx,curx]:=ch;
  if (curx<KolS) then
  begin
    for i:=KolS downto curX+1 do
    arr^[curY,i]:=arr^[curY,i-1];
    arr^[curY,curX]:=ch;
    curX:=curX+1;
  end;
end;

Procedure Delete_String(var curX,curY:byte;var arr:PTekst);
var i:byte;
begin
  if curX>1 then
  for i:=curX to KolS do
  arr^[curY,i]:=' ';
  if curX=1 then
    begin
      for i:=curY to kolst do
      arr^[i]:=arr^[i+1];
      for i:=1 to KolS do
      arr^[kolst,i]:=' ';
    end;
end;

Procedure BackSpace_Editor(var curX,curY:byte;var arr:PTekst);
var i:byte;
begin
  if curX>1 then
  begin
    for i:=curX-1 to (KolS-1) do
    arr^[curY,i]:=arr^[curY,i+1];
    arr^[cury,KolS]:=' ';
    curX:=curX-1;
  end;
end;

Procedure Delete_Editor(var curX,curY:byte; var arr:PTekst);
var i:byte;
begin
  begin
  for i:=curX to KolS do
  arr^[curY,i]:=arr^[curY,i+1];
  arr^[curY,KolS]:=' ';
  end;
end;

Procedure Enter_Editor(var curX,curY:byte; var arr:PTekst);
var i,j:integer;
    st:string[KolS];
begin
  for i:=1 to KolS do
  st[i]:=' ';
  for i:=curX to KolS do
  begin
    st[i-curX+1]:=arr^[curY,i];
    arr^[curY,i]:=' ';
  end;
  for i:=kolst downto curY+1 do
   arr^[i]:=arr^[i-1];
  curY:=curY+1;
  curX:=1;
  for i:=1 to KolS do
  arr^[curY,i]:=st[i];
end;

Procedure AlignLeft_Editor(var curx, cury:byte;var arr:PTekst);
var i, j, k:byte;
begin
     for i:=1 to 21 do
     begin
          k:=1;
          repeat
                if arr ^[i, 1]=' ' then
                begin
                     for j:=1 to (KolS-1) do
                     arr ^[i, j]:=arr ^[i,j+1];
                arr ^[i, KolS]:=' ';
                end;
                k:=k+1;
          until (arr ^[i, 1]<>' ') or (k=KolS);
     curx:=1;
     end;
end;

Procedure AlignRight_Editor(var curx:Byte;var arr:PTekst);
var i, j, k:byte;
begin
     for i:=1 to kolst do
     begin
          k:=KolS;
          repeat
                if arr ^[i, KolS]=' ' then
                begin
                     for j:=KolS downto 2 do
                     arr ^[i, j]:=arr ^[i, j-1];
                     arr ^[i, j]:=' ';
                end;
                k:=k-1;
          until (arr ^[i, KolS]<>' ') or (k=1);
     curx:=KolS;
     end;
end;

Procedure AlignCenter_Editor(var curX:Byte;var arr:PTekst);
var i, j, m, p:byte;
    line:string [KolS];
begin
     for j:=1 to kolst do
     begin
          line:=' ';
          for i:=1 to KolS do
          line:=line+arr ^[j, i];

          while line [length (line)]=' ' do
          begin
               delete (line, length (line), 1);
          end;
          while (line [1]=' ') and (line<>' ') do
          begin
               delete (line, 1, 1);
          end;
          p:=(KolS-length(line)) div 2;
          m:=p;
          while p<>0 do
          begin
            line:=' '+line;
            p:=p-1;
          end;
          for i:=KolS downto (KolS-m) do
          line[i]:=' ';
          for i:=1 to KolS do
          arr^[j,i]:=line[i];
          curX:=40;
     end;
end;

Procedure Open_File_Editor(var arr:PTekst);
var i,j:byte;
    s:string;
    line:string[80];
    f1:text;
Begin
    clrscr;
    write('Put k faily: '); readln(s);
    assign(f,s);
    {$I-}
    reset(f);
    {$I+}
    j:=1;
    repeat
      begin
        readln(f,line);
        for i:=1 to KolS do
        arr^[j,i]:=line[i];
        j:=j+1;
      end;
    until eof(f) or (j=20);
End;

Procedure ShowText_Editor(arr:Ptekst;var curX,curY:byte);
Var i:byte;
Begin
clrscr;
for i:=1 to 20 do
write(arr^[i]);
GoToXY(curX,curY);
End;


Procedure Save(arr:PTekst;var f1:text);
var i,j:byte;
    line:string[KolS];
begin
clrscr;
Write('Imya ');readln(s);
assign(f1,s);
rewrite(f1);
j:=1;
delete(line,1,length(line));
repeat
  delete(line,1,length(line));
  for i:=1 to KolS do
  line:=line+arr^[j,i];
  writeln(f1,line);
  j:=j+1;
until (j=22);
write('1');
readln;
close(f1);
end;

Procedure Editor;
Var cm:char;
Begin
new(arr);
Open_File_Editor(arr);
curX:=1;curY:=1;
Repeat
ShowText_Editor(arr,curX,curY);
Repeat
 cm:=readkey;
Until cm in [#62..#64,#13,#65,#8,#72,#75,#77,#80,#67,#6,#83,#0,'A'..'Z','a'..'z','0'..'9',',','.',']','[','`','~','!','@','#',
'$','%','^','&','*','(',')','-','=','+','\',';',':','{','}','<','"','>','?','/'];
if cm=#0 then
 begin
  repeat
   cm:=readkey;
  until cm in [#62..#64,#13,#8,#63,#67,#72,#75,#77,#80,#83];
 end;
case cm of
 #72: if curY>1 then curY:=curY-1; {up}
 #80: if curY<kolst then curY:=curY+1; {down}
 #75: begin
       if curX>1 then curX:=curX-1;
       if (curX=1) and (curY>1) then
         begin
         curX:=80;
         curY:=curY-1;
         end;
      end; {left}
 #77: begin
       if curX<KolS then curX:=curX+1;
       if (curX=KolS) and (curX<kolst) then
         begin
         curX:=1;
         curY:=curY+1;
       end; {right}
      end;
 #65: new(arr);
 #64: ClearText_Editor(arr,curX,curY); {F6}
 #63: Delete_String(curX,curY,arr); {F5}
 #8:  BackSpace_Editor(curX,curY,arr); {Backspace}
 #13: if (curY<kolst) then Enter_Editor(curX,curY,arr); {Enter}
 #83: Delete_Editor(curX,curY,arr);
 else
 if cm in ['A'..'Z','a'..'z','0'..'9','`','~','!','@','#','$','%','^','&','*','(',')','{','}',
 '[',']',':',' ',';','"','<','>','?','.',',']
 then Input_Symbol(curX,curY,cm,arr);
end;
Until cm=#67;
end;

begin
     GetMem(arr,kols*kolst);
     Editor;
     FreeMem(arr,kols*kolst);
end.