program screen (input,output);

   {read from a file and display on the screen.}

TYPE
   txtstorage = ARRAY [0..200] OF string[90];
   pttext = ^ txtstorage;

VAR
   source,nat,temp, outfile: text;  {source file}
   filename, ofn, name: string[14];
   line: string[120];
   screen: pttext;
   lno,vkey,row,col,i,dstart,rlen: integer;
   key: char;

PROCEDURE cursor(x,y: integer);
   BEGIN
      write(chr(1bh), 'Y', chr(y+20h), chr(x+20h));
   END;
PROCEDURE putcursor; BEGIN cursor(col-1,row-dstart); END;
PROCEDURE writerow;
   BEGIN
      cursor(0,row-dstart); writeln(screen^[row]); putcursor;
   END;
PROCEDURE readscreen;
   VAR max: integer;
   BEGIN
     max := lno+40;
     WHILE (NOT eof(source)) AND (lno < max) DO BEGIN
        readln(source,line); screen^[lno] := line; lno := lno+1;
     END
   END;
PROCEDURE clearscreen;
   BEGIN
      write(chr(1bH)); write('E'); cursor(0, 1);
   END;

PROCEDURE upc;
   BEGIN
      IF row>1 THEN BEGIN
      row := row-1;
      IF row < dstart THEN BEGIN
         dstart := row; write(chr(1bh),'L'); writerow;
      END ELSE write(chr(1bH),chr(41H));
      END;
   END;
PROCEDURE testeof; FORWARD;
PROCEDURE downc;
   BEGIN
      row := row+1; IF row= lno THEN testeof;
      IF row = lno THEN row := row-1 ELSE BEGIN
         IF row=(dstart+29) THEN BEGIN
            writeln; writeln; writeln; dstart:= dstart+1; writerow;
            writeln; putcursor;  {does a scroll up}
         END ELSE write(chr(1bH),chr(42h));
      END;
   END;
PROCEDURE rightc;
   BEGIN
      IF (col<80) THEN BEGIN
         write(chr(1bh),chr(43h)); col := col+1;
      END;
   END;
PROCEDURE leftc;
   BEGIN
      IF (col>0) THEN BEGIN
         write(chr(1bh),chr(44h)); col := col-1;
      END;
   END;
PROCEDURE delc;
   BEGIN
      IF col > rlen THEN BEGIN col:=rlen+1;putcursor;END;
      IF col>1 THEN BEGIN
         leftc; write(chr(1bH),'N'); delete(screen^[row],col,1);
      END;
   END;
PROCEDURE cutl;
   VAR i,x: integer;
   BEGIN
      write(chr(1bh),'M'); IF row=lno THEN testeof;
      IF row<lno THEN BEGIN
         FOR i := row+1 to lno DO screen^[i-1] := screen^[i];
         x := row; row := dstart+28; writerow; row:=x;putcursor; lno:=lno-1;
      END;
   END;
PROCEDURE donl;
   VAR i,ll: integer;
   BEGIN
      readln(nat);  {clear eoln flag}
      IF lno = 200 THEN testeof;
      i := lno; lno := lno+1;
      WHILE i>row DO BEGIN
         screen^[i+1] := screen^[i]; i:= i-1;
      END;
      IF col>rlen THEN col:=rlen+1;
      line := screen^[row]; ll := length(line)-col+1;
      IF ll=0 THEN BEGIN
        screen^[row+1] := '';
      END ELSE BEGIN
         screen^[row+1] := copy(line, col, ll);  delete(screen^[row],col,ll);
      END;
      write(chr(1bh),'L');
      write(chr(1bh),'K'); writerow; row:=row+1; writeln; write(chr(1bh),'K');writerow;
      row := row-1; putcursor;
   END;

PROCEDURE rewritescr;
   VAR i,j: integer;
   BEGIN
     IF 28+dstart > 200 THEN testeof;
     j:=28+dstart;
     clearscreen;
     for i := dstart+1 to j DO writeln(screen^[i]);
     putcursor;
   END;

PROCEDURE testeof;
   VAR i,cut,j,fl: integer;
   BEGIN
      write(chr(7)); fl:=0;
      IF dstart+30 >= lno THEN BEGIN
         IF NOT eof(source) THEN BEGIN
            IF lno > 100 THEN BEGIN
               cut := lno-50;
               FOR i:= 1 to cut DO writeln(temp, screen^[i]);
               i := 1; j := cut;
               WHILE j < lno DO BEGIN
                  screen^[i] := screen^[j]; i := i+1; j:=j+1;
               END;
               dstart := dstart-cut; row := row-cut; lno := i; fl:=1;
            END;
            readscreen; IF fl=1 THEN rewritescr;
         END;
     END;
   END;

BEGIN
   new(screen); clearscreen;
   write('Source File:'); readln(name);
   IF name='' THEN name:='NUL:'; filename := name;
   assign(source, filename); reset (source);
   write('Output file?'); readln(ofn);
   IF ofn='' THEN ofn := filename;

   {Now read in the first screen full}

   clearscreen;  cursor(0,1); lno := 1; row := 1; col := 1; vkey:=0; dstart:=0;
   readscreen; rewritescr;
   assign(nat, 'KBD:'); reset(nat);  {get at keyboard directly}
   assign(temp,'M:SCR.TMP'); rewrite(temp);
   WHILE (vkey <> 3) AND (vkey<>27) DO
     BEGIN
      IF eoln(nat) THEN BEGIN donl; key := chr(0); END ELSE
      read(nat, key); vkey := ord(key);
      IF vkey <> 0 THEN BEGIN
         rlen := length(screen^[row]);
         IF (vkey>31) AND (vkey<127) THEN BEGIN
            IF col>rlen THEN col := rlen+1;
            insert(key,screen^[row],col); col := col+1; writerow;
         END ELSE BEGIN
            CASE vkey OF
             1: leftc;
             6: rightc;
            18: rewritescr;
            21: cutl;
            30: downc;
            31: upc;
           127: delc;
           OTHERWISE write(vkey);
           END {case}
        END;
      END;
     END;
     IF vkey = 27 DO BEGIN
        FOR i := 1 to lno DO writeln(temp,screen^[i]);
        clearscreen; writeln('File in ', ofn);
        WHILE NOT eof(source) DO BEGIN
           readln(source, line); writeln(temp, line);
        END;
        assign(outfile, ofn); rewrite(outfile); reset(temp)
        WHILE NOT eof(temp) DO BEGIN
           readln(temp, line); writeln(outfile, line);
        END;
     END;
END.