PROGRAM ED;     {Video text editor}
 
 
{       Revision History
 
1.  6/14/77    First usable version

2.  6/18/77    Variable length list nodes and checking for dynamic memory
               overflow supported using extended version of NEW procedure.

3.  6/20/77    EMPTYTTYINBUF routine added to prevent buffer overflow 
               problems when scrooling using repeat key.

4.  6/23/77    SEARCH and TOP commands added.

5.  6/29/77    TAB support added.

6.  7/7/77     TAG, SAVE and UNSAVE commands added.

7.  7/26/77    Input file now renamed with a .BAK extension.
}
 
CONST
  id='ED Version 7.10';
  maxline=80;        {Maximum number of characters per line}
  screensize=24;     {Maximum number of lines displayable}
  hdrlength=8;
  lf=12B;
  cr=15B;
  del=177B;
  esc=33B;
  home=110B;
  erasetoeos=112B;
  erasetoeol=113B;
  direct=131B;
  cursorright=103B;
  cursorleft=104B;
  reverse=111B;
  keypadmode=75B;
  exitkeypadmode=76B;
  tab=11B;
  defaultext='PAS';
  defaultname='DK:TEMP.DAT   ';
 
 
TYPE
  link=^line;
  line=record
    next:link;
    last:link;
    maxlength:1..maxline;
    length:1..maxline;
    data:array[1..maxline] of char;
  end;
 
  cptr=1..maxline;
  str14=array[1..14] of char;
 
 
VAR
  cline:link;       {Pointer to current line}
  listhead:link;    {Pointer to dummy line at beginning of linked list}
  lastline:link;    {Pointer to lastline in buffer}
  lastdeleted:link;
  tagline:link;
  c:char;
  cur:1..maxline;   {Current cursor position}
  toggle:(repl,ins); {Character replace/insert flag}
  jsw origin 44B: integer;
  linecount:integer;
  ans:array[1..3] of char;
  filename:str14;
  finished:boolean;
  memoryleft:integer;
  maxnodelength:integer;
  inputfile:text;
  filesize:integer;
  savepattern:str14;
  savesslength:integer;
 
 
 
 
PROCEDURE POS(lineptr:link; charptr:cptr; var xloc:cptr);
  {Returns the X screen position of the specified internal chracter}

var
  i:cptr;
  size:1..8;

begin
  xloc:=1; size:=0;
  for i:=1 to charptr do begin
    xloc:=xloc+size;
    if lineptr^.data[i]=chr(tab) then size:=8-(xloc-1) mod 8
    else size:=1
  end
end;




PROCEDURE DEBUG;
 
var
  xloc:cptr;

begin
  writeln('cur=',cur);
  writeln('linecount=',linecount);
  writeln('cline=',cline^.data[1]);
  writeln('listhead=',listhead^.data[1]);
  writeln('lastline=',lastline^.data[1]);
  writeln('last=',cline^.last^.data[1]);
  writeln('next=',cline^.next^.data[1]);
  writeln('length=',cline^.length);
  writeln('maxlength=',cline^.maxlength);
  writeln('memoryleft=',memoryleft);
  writeln('filesize=',filesize);
  pos(cline,cur,xloc);
  write('xloc=',xloc);
end;
 
 
 
 
PROCEDURE NEWV(var ptr:link; size:integer; var memoryleft:integer);

  {Extends NEW procedure to support allocation of variable
  length lines and to provide(as an unsigned integer) the number
  of bytes remaining in dynamic storage.}
 
var
 kore,sp:integer;

begin
  if odd(size) then size:=size+1;
  {$C mov size(%6),.+8  }
  new(ptr);
  {$C .globle $kore
      mov $kore,kore(%6)
      mov %6,sp(%6)
  }
  memoryleft:=sp-kore;
end;
 
 
 
 
PROCEDURE ESCAPE(code:integer);
  {Outputs specified escape sequence}
 
begin
  write(chr(esc)); write(chr(code))
end;
 
 
 
 
PROCEDURE MOVCUR(line,column:integer);
  {Moves cursor to specified line and column}
 
begin
  escape(direct);
  write(chr(37B+line));
  write(chr(37B+column))
end;



PROCEDURE WRITET(l:link; startloc,endloc:cptr; line:integer);
  {Writes the specified segment of the line pointed to by 'l' on
  the CRT line specified by 'line'}

var
  i,j,xloc:cptr;
  size:1..8;

begin
  pos(l,startloc,xloc);
  movcur(line,xloc);
  with l^ do begin
    for i:=startloc to endloc do
      if data[i]=chr(tab) then begin
        size:=8-(xloc-1) mod 8;
        for j:=1 to size do write(' ');
        xloc:=xloc+size
      end
      else begin write(data[i]); xloc:=xloc+1 end
  end
end;



PROCEDURE POSITIONCURSOR;
  {Positions cursor after scrooling up or down}

var c,xloc:cptr;

begin
  if cur<=cline^.length then begin pos(cline,cur,xloc); c:=cur end
  else begin xloc:=1; c:=1 end;
  movcur(screensize,xloc); cur:=c;
end;
 
 
 
 
PROCEDURE DISPLAYTOP(l:link);
  {Displays line pointed to by l at top of screen}
 
begin
  movcur(1,1);
  escape(reverse);
  writet(l,1,l^.length,1);
  positioncursor;
end;
 
 
 
 
PROCEDURE DISPLAYBOTTOM(l:link);
  {Display line pointed to by l at bottom of screen}
 
begin
  movcur(screensize,1);
  writeln;
  writet(l,1,l^.length,screensize);
  positioncursor;
end;
 
 
 
 
PROCEDURE INSERTNODE(l:link);
  {Inserts line pointed to by l into linked list following current line}
 
begin
  l^.last:=cline;
  l^.next:=cline^.next;
  cline^.next^.last:=l;
  cline^.next:=l;
  linecount:=linecount+1;
  if cline=lastline then lastline:=l;
end;
 
 
 
 
PROCEDURE DELETENODE;
  {Deletes current line from linked list}
 
begin
  if cline#listhead then
  begin
    if cline=lastline then lastline:=cline^.last;
    cline^.last^.next:=cline^.next;
    cline^.next^.last:=cline^.last;
    linecount:=linecount-1;
    lastdeleted:=cline;
  end;
end;
 
 
 
 
PROCEDURE SQUEEZE;
  {Reduces length of current node if it is at the maximum}
 
var
  l:link;
  i:cptr;
 
begin
  with cline^ do begin
    if (maxlength=maxline) and (length<maxline) 
    and (cline#listhead) then begin
      newv(l,hdrlength+length,memoryleft);
      l^.length:=length;
      l^.maxlength:=length;
      for i:=1 to length do l^.data[i]:=data[i];
      insertnode(l);
      deletenode;
      dispose(cline);
      if cline=lastline then lastline:=cline;
      cline:=l;
    end
  end
end;




FUNCTION GETC:char;
  {Attemts to fetch a character from terminal input ring buffer
   using .TTYIN monitor request. A zero byte is returned if no character
   is available.}

var c:char;

begin
  {$C	emt	^O340
	bcc	1$
	clr	%0
    1$: movb	%0,c(%6)}
  getc:=c
end;



FUNCTION GETCW:char;
  {Variation of GETC which waits for character to be typed before returning}
var c:char;
begin repeat c:=getc until ord(c)#0; getcw:=c end;




PROCEDURE EMPTYTTYINBUF;
  {Reads and ignores any characters that may be in RT-11 terminal
  input buffer to allow scrooling to work correctly}

var c1,c2:char;

begin
  c1:=getc;
  if ord(c1)#0 then begin
    repeat c2:=c1; c1:=getc until ord(c1)=0;
    if c2=chr(esc) then c2:=getcw
  end
end;

 
 
 
 

PROCEDURE SCROLLUP;
  {Moves window forward towards end of file by one line}
 
begin
  emptyttyinbuf;
  if cline#lastline then
  begin
    squeeze;
    cline:=cline^.next;
    displaybottom(cline)
  end
end;
 
 
 
 
PROCEDURE SCROLLDOWN;
  {Moves window forward towards beginning of file by one line}
 
var l:link; i:1..screensize;
begin
  emptyttyinbuf;
  if cline#listhead then
  begin
    if cline#lastdeleted then squeeze else lastdeleted:=nil;
    l:=cline;
    cline:=cline^.last;
    i:=1;
    while (i<=screensize) and (l#listhead) do begin i:=i+1; l:=l^.last end;
    displaytop(l);
  end
end;
 
 
 
 
PROCEDURE REPLACECHAR(c:char);
  {Replaces character at cursor position with argument}

var
  xloc:cptr;
  c2:char;
 
begin
  if (cur<=cline^.length) and (cline#listhead) then begin
    c2:=cline^.data[cur];
    cline^.data[cur]:=c;
    if (c=chr(tab)) or (c2=chr(tab)) then begin
      escape(erasetoeol);
      writet(cline,cur,cline^.length,screensize);
      pos(cline,cur+1,xloc);
      movcur(screensize,xloc)
    end else write(c);
    cur:=cur+1;
  end
end;
 
 
 
 
PROCEDURE INSERTCHAR(c:char);
  {Specified character is inserted at current cursor position}
 
var i:cptr;
    l:link;
    xloc:cptr;
 
begin
    if (cline^.length<maxline) and (cline#listhead) then
    begin
      with cline^ do begin
        if length>=maxlength then begin     {Expand node to make room}
          newv(l,maxnodelength,memoryleft);
          l^.length:=length;
          l^.maxlength:=maxline;
          for i:= 1 to length do l^.data[i]:=data[i];
          insertnode(l);
          deletenode;
          cline:=l;
        end;
      end;
      with cline^ do begin
        for i:=length downto cur do data[i+1]:=data[i];
        length:=length+1;
        replacechar(c);
        writet(cline,cur,length,screensize);
        pos(cline,cur,xloc);
        movcur(screensize,xloc)
      end;
    end
end;
 
 
 
 
PROCEDURE WINDOW;
  {Displays full screen of lines, ending at line pointed to by cline}
 
var
  i:integer;
  l:link;
 
begin
  escape(home); escape(erasetoeos);
  i:=1;
  l:=cline;
  while (i<=screensize) and (cline#listhead) do
  begin i:=i+1; cline:=cline^.last end;
  while cline#l do scrollup;
end;
 
 
 
 
PROCEDURE MOVERIGHT;
  {Moves cursor right one position}

var
  xloc:cptr;
 
begin
  if (cur<=cline^.length) and (cur<maxline) then
  begin
    cur:=cur+1;
    if cline^.data[cur-1]=chr(tab) then begin
      pos(cline,cur,xloc);
      movcur(screensize,xloc)
    end else escape(cursorright)
  end
end;
 
 
 
 
PROCEDURE MOVELEFT;
  {Move cursor left one position}
var
  xloc:cptr;
 
begin
  if cur>1 then
  begin
    cur:=cur-1;
    if cline^.data[cur]=chr(tab) then begin
      pos(cline,cur,xloc);
      movcur(screensize,xloc)
    end else escape(cursorleft)
  end
end;
 
 
 
 
PROCEDURE DELETECHAR;
  {Deletes character at current cursor position}
 
var i:integer;
    xloc:cptr;
 
begin
  with cline^ do
  begin
    if length#0 then
    begin
      if cur>length then begin
        cur:=length;
        pos(cline,cur,xloc);
        movcur(screensize,xloc)
      end;
      for i:=cur to length-1 do data[i]:=data[i+1];
      length:=length-1;
      writet(cline,cur,length,screensize);
      escape(erasetoeol);
      pos(cline,cur,xloc);
      movcur(screensize,xloc)
    end
  end
end;
 
 
 
 
PROCEDURE INSERTLINE;
  {Inserts null line into linked list following current line 
   scrolls up by one line}
 
var p:link;
 
begin
  newv(p,maxnodelength,memoryleft);
  p^.maxlength:=maxline;
  p^.length:=0;
  insertnode(p);
  scrollup
end;
 
 
 
 
PROCEDURE DELETELINE;
  {Deletes current line from linked list and scrolls down by one line}
 
begin
  deletenode;
  scrolldown;
  if linecount=0 then insertline;
end;
 
 
 
 
PROCEDURE INITBUFFER;
  {initializes doubly linked list used to represent text}
 
begin
  new(listhead);
  with listhead^ do begin
    next:=listhead;
    last:=listhead;
    maxlength:=maxline;
    length:=0;
    data[1]:='H';
  end;
  cline:=listhead;
  lastline:=listhead;
  linecount:=0;
  insertline;
end;
 
 
 
 
PROCEDURE FILEINPUT;
  {Inputs file into linked list}
 
var
  l:link;
  i:1..screensize;
 
begin
  cline:=listhead;
  while not eof(inputfile) do begin
    new(l);
    insertnode(l);
    cline:=cline^.next;
    with l^ do begin
      maxlength:=maxline;
      length:=0;
      while not eoln(inputfile) do begin
        if length<maxline then length:=length+1;
        read(inputfile,data[length]);
      end;
      readln(inputfile);
    end;
    squeeze;
  end;
  cline:=listhead;
  i:=1;
  while(i<=screensize) and (cline#lastline) do
  begin i:=i+1; cline:=cline^.next end
end;
 
 
 
 
PROCEDURE FILEOUTPUT(f:text; firstln,lastln:link);
  {File output routine}
 
var
  i:cptr;
  l:link;
 
begin
  if firstln#listhead then firstln:=firstln^.last;
  l:=firstln;
  while l#lastln do begin
    l:=l^.next;
    with l^ do begin
      for i:=1 to length do write(f,data[i]);
      if not((length=0) and (l=lastline)) then writeln(f);
    end;
  end;
  close(f);
end;




PROCEDURE ASK(prompt:str14; var ans:str14; var alength:integer);
  {Prompts for a string response from user}

var i:cptr;
    c:char;
    repeatsearch:boolean;

begin
  repeatsearch:=false;
  insertline;
  write(prompt);
  i:=0;
  repeat
    i:=i+1;
    c:=getcw;
    if (i=3)&(c='t')&(ans[1]=chr(esc)) then begin  {Repeat search if key} 
      ans:=savepattern;                            {pressed twice}    
      i:=savesslength+1;
      repeatsearch:=true;
      exit
    end;
    if ord(c)=del then begin
      i:=i-2;
      escape(cursorleft); write(' '); escape(cursorleft);
    end else begin
      ans[i]:=c; write(c) end;
  until (ord(c)=cr) or (i=14);
  if not repeatsearch then c:=getcw;	{get LF}
  alength:=i-1;
end;




PROCEDURE SEARCH;
  {Searches forward for specified text string. If a match is found then
  the line where the match occurs becomes the new current line.}

var
  l:link;
  i,lastmatch:integer;
  firstpos:integer;
  pattern:str14;
  sslength:integer;
  match:boolean;
  slinecount:integer;
  xloc:cptr;

begin
  ask('  Text string?',pattern,sslength);
  l:=cline;
  match:=false;
  slinecount:=0;
  while not match and (l#lastline) and (sslength#0) do
  begin
    l:=l^.next;
    slinecount:=slinecount+1;
    lastmatch:=l^.length-sslength+1;
    for firstpos:=1 to lastmatch do
    begin
      match:=true;
      for i:=1 to sslength do
        if l^.data[firstpos+i-1]#pattern[i] then begin match:=false; exit end;
      if match then exit;
    end
  end;
  deleteline;
  if match then begin
    if slinecount>screensize then begin cline:=l; window end else
    while cline#l do scrollup;
    pos(cline,firstpos,xloc);
    movcur(screensize,xloc);
    cur:=firstpos;
  end;
  savepattern:=pattern;
  savesslength:=sslength;
end;






PROCEDURE EXITPGM;
  {Writes out updated file and terminates program}

var
  outputfile:text;
  size:integer;

procedure bak(var n:str14);
  {Renames specified file with a .BAK extension}
const
  blank='   ';
type
  str3=array[1..3] of char;
  rad50filename=record dev,nam1,nam2,ext:integer end;
var
  old,new:rad50filename;
  t,t2:str3;
  i,filenamestart:1..14;
  j:1..6;

procedure rename(var old:rad50filename);
  {Provides a linkage to .RENAME monitor request}
type
  dblk=^rad50filename;
var
  usrloadadrs origin 46B:integer;
  area:record
           chan:char;
           functioncode:char;
           d:dblk
         end;
begin   {rename}
  area.chan:=chr(14);
  area.functioncode:=chr(4);
  area.d:=@old;
  usrloadadrs:=1000B;     {Don't let USR overlay arg list and/or stack}
  {$C	mov	%6,%0
	add	#area,%0
	emt	^o375}
  usrloadadrs:=0;
end;

function rad50(var s:str3):integer;
  {Converts a 3 character string to RAD50}
var
  c:array[1..3] of integer;
  i:1..3;
  t:integer;
begin   {rad50}
  for i:=1 to 3 do
    if(s[i]>='A')&(s[i]<='Z')then c[i]:=ord(s[i])-100B
      else if(s[i]>='0')&(s[i]<='9')then c[i]:=ord(s[i])-22B
        else if s[i]='$' then c[i]:=33B
          else c[i]:=0;
  t:=((c[1]*40)+c[2])*20;
  rad50:=t+t+c[3];
end;

begin   {bak}
  {Convert file name to upper case}
  for i:=1 to 14 do if (n[i]>='a')&(n[i]<='z') then n[i]:=chr(ord(n[i])-40B);

  {Find extension and convert to RAD50}
  i:=0;
  repeat i:=i+1 until (n[i]='.')!(i=14);
  t:=blank;
  if n[i]='.' then begin
    i:=i+1; j:=1;
    while (n[i]#' ')&(j<=3) do begin
      t[j]:=n[i];
      i:=i+1; j:=j+1;
    end;
  end else t:=defaultext;
  if t#'BAK' then       {Don't do anything if extension already .BAK}
  begin
    old.ext:=rad50(t);

    {Find device and convert to RAD50}
    filenamestart:=1;
    i:=0;
    repeat i:=i+1 until (n[i]=':')!(i=4)!(n[i]=' ');
    t:=blank;
    if n[i]=':' then begin
      filenamestart:=i+1;
      i:=1; j:=1;
      while (n[i]#':')&(j<=3) do begin
        t[j]:=n[i];
        i:=i+1; j:=j+1;
      end;
    end else t:='DK ';
    old.dev:=rad50(t);

    {Find file name and convert}
    i:=filenamestart; j:=1;
    t:=blank; t2:=blank;
    while (n[i]#' ')&(n[i]#'.')&(j<=6) do begin
      if j<=3 then t[j]:=n[i] else t2[j-3]:=n[i];
      i:=i+1; j:=j+1;
    end;
    old.nam1:=rad50(t); old.nam2:=rad50(t2);
    new:=old; t:='BAK'; new.ext:=rad50(t);
    rename(old)  
  end;
end;

begin   {exitpgm}
  bak(filename);
  size:=-1; rewrite(outputfile,filename,defaultext,size);
  fileoutput(outputfile,listhead,lastline);
  escape(exitkeypadmode);
  finished:=true;
end;





PROCEDURE SAVE;
  {Saves text in a file, beginning at taged line and ending at
  current line}

var
  l:link;
  name:str14;
  size:integer;
  savefile:text;

begin
  l:=cline;
  while (l#tagline)&(l#listhead) do l:=l^.last;
  if l=tagline then begin
    ask('    File name?',name,size);
    if ord(name[1])=cr then name:=defaultname;
    rewrite(savefile,name,defaultext);
    l:=cline^.last;
    fileoutput(savefile,tagline,l);
    deleteline
  end
end;



PROCEDURE UNSAVE;
  {Retrieves text from a file and inserts following current line}

var
  name:str14;
  size:integer;
  unsavefile:text;
  c:char;
  filesize:integer;

begin
  ask('    File name?',name,size);
  if ord(name[1])=cr then name:=defaultname;
  deleteline;
  reset(unsavefile,name,defaultext,filesize);
  if filesize>0 then
    while not eof(unsavefile) do begin
      insertline;
      while not eoln(unsavefile) do begin
        read(unsavefile,c); insertchar(c)
      end;
      readln(unsavefile)
    end;
    close(unsavefile)
end;




PROCEDURE TOPOFFILE;
  {Makes first line in file the current line}

begin
  cline:=listhead;
  window
end;
 
 
 
 
 
PROCEDURE DOCMD;
  {Decodes and executes escape sequence commands}
 
const
  scrollupcode='A';
  scrolldowncode='B';
  moverightcode='C';
  moveleftcode='D';
  deletecode='Q';     {Red}
  togglecode='P';     {Blue}
  keypadcode='?';
  searchcode='t';     {4}
  topcode='u';        {5}
  exitcode='v';       {6}
  tagcode='w';        {7}
  savecode='x';       {8}
  unsavecode='y';     {9}
 
begin
  c:=getcw;
  if c=keypadcode then c:=getcw;  
  case c of
    scrollupcode:    scrollup;
    scrolldowncode:  scrolldown;
    moverightcode:   moveright;
    moveleftcode:    moveleft;
    deletecode:      deleteline;
    togglecode:      if toggle=repl then toggle:=ins else toggle:=repl;
    exitcode:        exitpgm;
    searchcode:      search;
    topcode:         topoffile;
    tagcode:         tagline:=cline;
    savecode:        save;
    unsavecode:      unsave;
  end
end;
 
 
 
 
 
 
 
 
{MAIN PROGRAM}
 
begin
  jsw:=jsw or 50100B;        {Use special TTY mode & lower case}
  maxnodelength:=hdrlength+maxline;
  cur:=1;
  movcur(1,1); escape(erasetoeos);
  initbuffer;
  writeln(id); writeln;
  ask('    File name?',filename,filesize);
  deleteline;
  reset(inputfile,filename,defaultext,filesize);
  if filesize>0 then fileinput;
  window;           {Clear screen}
  toggle:=ins;      {Character insert is default}
  escape(keypadmode);
  finished:=false;
 
  repeat
    if (memoryleft>=0) and (memoryleft<1000) then
      begin writeln('<<Memory overflow>>'); exitpgm end;
    c:=getcw;    {Get a character and decode it}
    if c='`' then debug;
    if ord(c)=esc then docmd else
      if ord(c)=del then deletechar else
        if ord(c)=cr then begin c:=getcw; insertline end else
          if toggle=repl then replacechar(c) else
            insertchar(c)
  until finished
end.