program ed;
{ PASCAL-Entwurf fuer den TRAC Editor }

{$Ieddcl.pas}
{$Iedfct.pas}

                   { --- Text to Screen mappings --- }

function line(i:integer): integer;
var j,k: integer;
begin
k:=min(i,text_length);
j:=1;
while (j<=n_lines) and (eol_index[j]<k) do j:=j+1;
if (i>text_length) and (text[text_length]=CR) then line:=j+1 else line:=j;
end; { line }

function column(index:integer): integer;
var i,j,sum:integer;
begin
i:=line(index);
sum:=0;
for j:=eol_index[i-1]+1 to index-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;
end; { column }

procedure page_pos_xy(col,line:integer);
begin
while (line<page_top) and (page_top>1) do
    begin
    page_top:=page_top-1;
    GotoXY(1,TOPWINDOW); InsLine;
    end;
GotoXY(col,TOPWINDOW-1+line);
end; { page_pos_xy }

function calc_tables(line:integer): integer;
var i,j: integer;
    cr_flag: boolean;
begin
i:=line-1;
repeat
    j:=eol_index[i]+1;
    i:=i+1;
    cr_flag:=false;
    while (j<=text_length) and (not cr_flag) do
        begin
        cr_flag := text[j]=CR;
        j:=j+1;
        end;
    eol_index[i] := j-1;
until eol_index[i]=text_length;
calc_tables:=i;
end; { calc_tables }

                      { --- Display subroutines --- }

{$Iedclr.pas}

procedure display_char(i:integer;var flag:boolean);
begin
if i<=text_length then
    if exp_length[ord(text[i])]>0 then
        begin
        if flag then page_pos_xy(column(i),line(i));
        if (block_flag) and (i>=block_begin) and (i<=block_end) then
                begin LowVideo; write(text[i]); HighVideo; end
        else write(text[i]);
        flag:=false;
        end
    else
        flag:=true;
end; { display_char }

procedure display_rest_line(index:integer);
var flag: boolean;
    i: integer;
begin
page_pos_xy(column(index),line(index));
clear_rest_line;
flag:=true;
for i:=index to eol_index[line(index)] do display_char(i,flag);
end; { display_rest_line }

procedure display_rest_page(index:integer);
var flag: boolean;
    i: integer;
begin
i:=index;
while (line(i)<=page_bottom) and (i<=text_length) do
    begin
    display_rest_line(i);
    i:=eol_index[line(i)]+1;
    end;
clear_rest_screen;
end; { display_rest_page }

{$Iedloc.pas}

                  { --- Text alteration subroutines --- }

procedure delete_chars(n:integer);
var i,new_length:integer;
begin
if (n>0) and (text_length>0) and (index<=text_length) 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:=max(1,min(index,new_length)); }
    if block_flag then
        begin
        if index<block_begin then block_begin:=block_begin-n;
        if index<=block_end then block_end:=block_end-n;
        end;
    i:=n_lines;
    n_lines:=calc_tables(line(index));
    if i=n_lines then display_rest_line(index)
    else display_rest_page(index);
    end;
end; { delete_chars }

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

{$Iedcop.pas}

procedure show_status;
begin
GotoXY(1,1);
if insert_flag then write('I') else write('O');
write(' Index:',index:4);
write('  Char:',ord(text[index]):3);
write('  Pos: ',cx:3,cy:3);
write('  Text length: ',text_length:4);
write('  Lines: ',n_lines:2);
end; { show_status }

                           { --- Main program --- }

begin  { ed }

{$Iedini.pas}

text_length := 0;

{$Iedfil.pas}

{ Recursively calculate tables for eol_index }

eol_index[0] := 0;
n_lines:=calc_tables(1);
{ show_tables(n_lines); }

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

{ Clear screen and display text }

ClrScr;
index:=1;
page_top:=1; page_bottom:=page_top+PAGELEN-1;
display_rest_page(index);

                       { Process input from keyboard }

finis:=false;
repeat
    cx:=column(index); cy:=line(index);
    show_status;
{    show_tables(n_lines); }
    page_pos_xy(cx,cy);
    read(KBD,ch);

switch:
    case ch of

{ Cursor positioning }

    ^R:  index:=1;
    ^C:  index:=text_length+1;
    ^H,
    ^S:  index:=max(1,index-1);
    ^D:  index:=min(text_length+1,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<n_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;
             if cy>page_bottom then
                 begin
                 page_top:=page_top+1; page_bottom:=page_bottom+1;
                 display_rest_page(page_top);
                 end;
             end;
    ^A:  if (index>1) then index:=previous_word(index);
    ^F:  index:=next_word(index);

{ Text deletion }

    ^G:  delete_chars(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_chars(i-index);
         end;
    ^Y:  begin
         index:=eol_index[cy-1];
         delete_chars(eol_index[cy]-index);
         ch:=^D;
         goto switch;
         end;

{ Text insertion/overwrite }

    ^N:  begin
         insert_char(CR);
         index:=index-1;
         end;
  #$0D:  if insert_flag then insert_char(ch)
         else index:=min(text_length,eol_index[cy]+1);
  #$09,#$20..#$7E:
        if insert_flag then insert_char(ch)
        else
            begin
            if text[index]<>CR then
                begin
                text[index]:=ch;
                write(text[index]);
                index:=index+1;
                end
            else insert_char(ch);
            end;

{ Editor status }

    ^V:  begin
         insert_flag:=not insert_flag;
         if insert_flag then write(cursor1) else write(cursor2);
         end;

{ Q-commands }

    ^Q:  begin
         read(KBD,ch);
         if ch<>#$7F then ch:=chr(ord(ch) and $1F);
         case ch of
         ^B:  if block_flag then index:=block_begin;
         ^K:  if block_flag then index:=block_end+1;
         ^S:  index:=eol_index[cy-1]+1;
         ^D:  begin
              index:=eol_index[cy];
              if (index=text_length) and (text[index]<>CR) then index:=index+1;
              end;
         ^Y:  delete_chars(eol_index[cy]-index);
       #$7F:  begin
              i:=index; index:=eol_index[cy-1]+1;
              delete_chars(i-index);
              end;
         end;
         end;

{ K-commands }

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

{ Block commands }

         ^H:  begin
              block_flag:=not block_flag;
              goto display_block;
              end;
         ^B:  begin
              block_begin:=index;
              block_flag:=(block_begin<=block_end);
              goto display_block;
              end;
         ^K:  begin
              block_end:=index-1;
              block_flag:=(block_begin<=block_end);
display_block:
              display_rest_page(1);
              end;
         ^C:  if block_flag then copy_block(true);
         ^V:  if block_flag then copy_block(false);
         ^Y:  begin
              if block_flag then
                  begin
                  k:=block_end-block_begin+1;
                  if k>0 then
                      begin
                      if index>=block_end then i:=index-k
                      else if index<block_begin then i:=index
                      else i:=block_begin;
                      index:=block_begin;
                      delete_chars(k);
                      index:=i;
                      block_flag:=false;
                      end;
                  end;
              end;

{ Finis }

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

    end;
until finis;
writeln;

end.  { ed }
