program ed;
{ PASCAL-Entwurf fuer den TRAC Editor

  22. Okt. 1986 ~4:00
  23. Okt. 1986 ~4:00
  24. Okt. 1986  2:40
  26. Okt. 1986  1:40
  27. Okt. 1986  2:10
  28. Okt. 1986  1:10
  30. Okt. 1986  2:20
}

const TXTMAX = 800;
      COLMAX = 80;
      LINMAX = 20;
      TABPOS = 8;

const cr: char = #$0D;
      lf: char = #$0A;
      up: char = #$0B;
      tab: char = #$09;
      esc: char = #$1B;

var textfile: text;                                 { external file }

var digits:            set of char;                 { numeric chars }
    letters:           set of char;                 { alpha chars }
    alphanums:         set of char;                 { alpha-numeric chars }
    separators:        set of char;                 { separator chars }

var text:              array[1..TXTMAX] of char;    { text string }
    exp_length:        array[0..127] of integer;    { expanded char length }
    line_length:       array[0..LINMAX] of integer; { chars to end of line }
    eol_index:         array[0..LINMAX] of integer; { index of end of line }
    eol_length:        array[0..LINMAX] of integer; { total chars to end of line }

var text_length:       integer;                     { text length }
    no_lines:          integer;                     { no. of lines }
    index:             integer;                     { text index}
    i,j:               integer;                     { auxiliary indices }
    cx,cy:             integer;                     { cursor coordinates }
    ch:                char;                        { input character }
    finis:             boolean;                     { end of input flag }
    insert_flag:       boolean;                     { text insertion on/off }
    crflag, lfflag:    boolean;                     { cr/lf flags }
    flag:              boolean;                     { auxiliary flag }

label switch;

function min(i,j:integer): integer;
begin
if i<j then min:=i else min:=j;
end;

function max(i,j:integer): integer;
begin
if i>j then max:=i else max:=j;
end;

function line(index:integer): integer;
var j: integer;
begin
j:=1;
while (j<=no_lines) and (eol_index[j]<index) do j:=j+1;
line:=j;
end; { line }


function accu_length(index:integer): integer;
var i,j,m,sum: integer;
begin
i:=line(index);
sum:=eol_length[i-1];
m:=min(index,text_length);
for j:=eol_index[i-1]+1 to m do
    if text[j]=tab then
        repeat sum:=sum+1 until (sum mod TABPOS) = 0
    else
        sum:=sum+exp_length[ord(text[j])];
accu_length:=sum;
end; { accu_length }

function column(index:integer): integer;
var i,j,sum:integer;
begin
i:=line(index);
sum:=0;
for j:=eol_index[i-1]+1 to min(index,text_length)-1 do
    if text[j]=tab then
        repeat sum:=sum+1 until (sum mod TABPOS) = 0
    else
        sum:=sum+exp_length[ord(text[j])];
column:=sum+1;
{gotoxy(1,15); write('column at',index:3,'=',sum+1:2);readln;}
end; { column }

function expand(i:integer): integer;
var j,k:integer;
begin
if text[i]=tab then
    begin
    j:=1; k:=column(i);
    while (k+j) mod TABPOS <> 0 do j:=j+1;
    expand:=j;
    end
else expand:=exp_length[ord(text[i])];
end; { expand }

function chars_to_eol(line: integer): integer;
var i, line_sum, accu_sum: integer;
    crflag: boolean;
begin { chars_to_eol }
if line=0 then
    chars_to_eol := 0
else
    begin
    line_sum := 0;
    i := eol_index[line-1]+1;
    accu_sum:=eol_length[line-1];
    crflag:=false;
    while (i<=text_length) and (not crflag) do
        begin
        line_sum := line_sum + expand(i);
        accu_sum := accu_sum + expand(i);
        crflag := text[i]=cr;
        i := i+1;
        end;
    eol_index[line] := i-1;
    eol_length[line]:= accu_sum;
    chars_to_eol := line_sum;
    end;
end; {chars_to_eol}

function calc_tables(line:integer): integer;
var i,j: integer;
begin
i:=line-1;
{GotoXY(1,15);}
repeat
    i:=i+1;
    line_length[i]:=chars_to_eol(i);
{    writeln(i:2, line_length[i]:4, eol_index[i]:4);}
until eol_index[i]=text_length;
calc_tables:=i;
end; { calc_tables }

procedure clear_rest_screen;
begin
write(esc,'[');
end;

procedure clear_rest_line;
begin
write(esc,'Z');
end;

procedure display_rest_page(index:integer);
var flag: boolean;
    i: integer;
begin
GotoXY(column(index),line(index));
clear_rest_screen;
flag:=true;
for i:=index to text_length do
    begin
    if exp_length[ord(text[i])]>0 then
        begin
        if flag then GotoXY(column(i),line(i));
        write(text[i]);
        flag:=false;
        end
    else
        flag:=true;
    end;
end; { display_rest_page }

procedure display_rest_line(index:integer);
var flag: boolean;
    i: integer;
begin
GotoXY(column(index),line(index));
clear_rest_line;
flag:=true;
for i:=index to eol_index[line(index)] do
    begin
    if exp_length[ord(text[i])]>0 then
        begin
        if flag then GotoXY(column(i),line(i));
        flag:=false;
        write(text[i]);
        end
    else
        flag:=true;
    end;
end; { display_rest_line }

function previous_word(i:integer): integer;
begin
if (text[i] in alphanums) and (text[i-1] in alphanums) then
    while (i>1) and (text[i] in alphanums) do i:=i-1
else
    begin
    i:=i-1;
    while (i>1) and (text[i] in separators) do i:=i-1;
    while (i>1) and (text[i] in alphanums) do  i:=i-1;
    end;
if text[i] in separators then i:=i+1;
previous_word:=i;
end; { previous_word }

function next_word(i:integer): integer;
begin
while (i<text_length) and (text[i] in alphanums) do i:=i+1;
while (i<text_length) and (text[i] in separators) do i:=i+1;
next_word:=i;
end; { next_word }

procedure delete_char(n:integer);
var i,new_length:integer;
begin
if text_length>0 then
    begin
    new_length:=text_length-n;
    if index<=new_length then
        for i:=index to new_length do
            text[i]:=text[i+n];
    text_length:=max(index-1,new_length);
    index:=min(index,new_length);
    i:=no_lines;
    no_lines:=calc_tables(line(index));
    if i=no_lines then display_rest_line(index)
    else display_rest_page(index);
    end;
end; { delete_char }

procedure insert_char(ch:char);
var i:integer;
begin
if text_length<TXTMAX then
    begin
    for i:=text_length downto index do text[i+1]:=text[i];
    text[index]:=ch;
    text_length:=text_length+1;
    i:=no_lines;
    no_lines:=calc_tables(line(index));
    if i=no_lines then display_rest_line(index)
    else display_rest_page(index);
    end;
end; { insert_char }


begin  { ed ----------------------------------------------------------- }

{ Initialize sets }

digits := ['0'..'9'];
letters := ['A'..'Z'] + ['a'..'z'];
alphanums := digits + letters;
separators := [#0..#$7E] - alphanums;

{ Set expand function table - simple version }

for i:=0 to 31 do
    exp_length[i] := 0;
for i:=32 to 127 do
    exp_length[i] := 1;

{ Open text file and read into text array substituting cr/lf's by cr's }

assign(textfile,'TEST.TXT');
reset(textfile);
text_length := 0;
crflag := false; lfflag := false;
while not eof(textfile) do
    begin
    read(textfile,ch);
    if crflag then
        begin
        lfflag:= ch=lf;
        crflag:=false;
        end
    else crflag:= ch=cr;
    if not lfflag then
        begin
        text_length := text_length+1;
        text[text_length]:=ch;
        end
    else lfflag:=false;
    end;
writeln('text_length=',text_length);

{ Recursively calculate tables for line_length and eol_index }

eol_index[0] := 0;
eol_length[0]:= 0;
no_lines:=calc_tables(1);

write('Press RETURN...'); readln;

{ Initialize control flags }

insert_flag:=true;

{ Clear screen and write text character by character }

ClrScr;
index:=1;
display_rest_page(index);

{ Process input from keyboard -------------------------------------------- }

finis:=false;
repeat
    cx:=column(index); cy:=line(index);
    GotoXY(1,23);
    write('Index:',index:4);
    write('  Char=',ord(text[index]):3);
    write('  Pos: ',accu_length(index):4, cx:3,cy:3);
    write('  Text length: ',text_length:4);
    write('  Lines: ',no_lines:2);
    GotoXY(cx,cy);
    read(KBD,ch);

switch:
    case ch of

{ Cursor positioning }

    ^R:  index:=min(1,text_length);
    ^C:  index:=text_length;
    ^H,
    ^S:  index:=max(min(1,text_length),index-1);
    ^D:  index:=min(text_length,index+1);
    ^E:  if cy>1 then
             begin
             while line(index)>=cy do index:=index-1;
             while column(index)> cx do index:=index-1;
             end;
    ^X: if cy<no_lines then
             begin
             index:=eol_index[cy]+1;
             cy:=line(index);
             while (column(index)<cx) and (line(index)=cy) and (index<text_length) do
                 index:=index+1;
             if line(index)>cy then index:=index-1;
             end;
    ^A:  if (index>1) then index:=previous_word(index);
    ^F:  index:=next_word(index);

{ Text deletion }

    ^G:  delete_char(1);
   #$7F: if index>1 then
             begin
             index:=index-1;
             ch:=^G;
             goto switch;
             end;
    ^T:  begin
         i:=index;
         if text[i] in alphanums then
             while (i<text_length) and (text[i] in alphanums) do i:=i+1
         else
             while (i<text_length) and (text[i] in separators) do i:=i+1;
         delete_char(i-index);
         end;
    ^Y:  begin
         index:=eol_index[cy-1];
         delete_char(line_length[cy]+1);
         ch:=^D;
         goto switch;
         end;

{ Text insertion/overwrite }

    ^N:  insert_char(cr);
    #$0D: if insert_flag then
              begin
              insert_char(ch);
              index:=index+1;
              end
          else index:=min(text_length,eol_index[cy]+1);

    #$09,
    #$20..#$7E:
        if insert_flag then
            begin
            insert_char(ch);
            index:=index+1;
            end
        else
            begin
            if text[index]<>cr then
                begin
                text[index]:=ch;
                write(text[index]);
                end
            else insert_char(ch);
            index:=index+1;
            end;

{ Editor control }

    ^V:  insert_flag:=not insert_flag;

{ Q-commands }

    ^Q:  begin
         read(KBD,ch);
         if ch<>#$7F then ch:=chr(ord(ch) and $1F);
         case ch of
         ^S:  index:=eol_index[cy-1]+1;
         ^D:  index:=eol_index[cy];
         ^Y:  delete_char(eol_index[cy]-index);
        #$7F: begin
              i:=index; index:=eol_index[cy-1]+1;
              delete_char(i-index);
              end;
         end;
         end;

{ K-commands }

    ^K:  begin
         read(KBD,ch);
         ch:=chr(ord(ch) and $1F);
         case ch of

{ Finis }

         ^D:  begin
              finis:=true;
              index:=text_length;
              cx:=column(index); cy:=line(index);
              GotoXY(cx,cy);
              end;
         end;
         end;

    end;
until finis;
writeln;

end.  { ed }
