PROGRAM DOSCREEN;

{Version 2.0 by Steve Cohen 2/13/85}
{Released to Public Domain         }
{To be compiled under Turbo-Pascal }

{Revised 3/16/85 -- Fixed bug in GetScreen procedure that
 was truncating file Name.  Also Upcased the FileNames input by
 the user and allowed aborting of the file creation process in
 WriteFile by simply pressing <CR> in response to filename prompt}

{I USED THE CP/M VERSION, BUT OFFHAND, I CAN'T }
{SEE WHY IT SHOULDN'T WORK WITH MS-DOS AS WELL }

{$C-,V-}


const

  { Change these if you don't have a 24x80 screen or if you    }
  { wish to change the number of usable input lines.           }
  { Configuration below mimics the format of BTREE.PAS included}
  { in the Turbo-ToolBox                                       }

  Top = 4;
  Bottom = 21;
  Right = 80;
  Left = 1;

  HV = #27#40; { these are the codes that generate normal      }
  LV = #27#41; { intensity and reduced intensity characters on }
               { my Advent System Kaypro video add-on board.   }
               { Omit if you can't do reduced intensity.       }

type XAxis =0..81;
     YAxis =0..25;
     AnyStr = String[255];
     Str80 = String[80];
     FullScreen = array[Top..Bottom,Left..Right] of char;
     DisplayField = record
       XBegin : XAxis;
       YBegin : YAxis;
       Contents : String[80];
     END;

Var Screen:FullScreen;
    FieldTag,FieldBlank : Array[1..50] of DisplayField;
    PasFile : Text;
    ScrFile:File of FullScreen;
    NoOfBlanks,NoOfTags : Integer;
    FileName : String[10];

FUNCTION ConstStr(c:Char;N:Integer):AnyStr;
 Var S: AnyStr;
 BEGIN
   S[0] := Chr(N);
   FillChar(s[1],N,C);
   ConstStr := S;
 END;

PROCEDURE MKSCREEN (var Screen:FullScreen);

VAR
  Ins                   : Boolean;
  X                     : XAxis;
  Y                     : YAxis;
  C,Ch,Done             : Char;
  Buffer                : str80;

PROCEDURE Display(VAR Screen: Fullscreen);
  VAR I: XAxis;
      J: YAxis;

  BEGIN
    For J := Top to Bottom do
    BEGIN
      GotoXY(Left,J);
      For I := Left to Right do
        Write(Screen[J,I]);
    END;
    GotoXY(70,2);
    If Ins then
      Write(HV,'INSERT')
    Else
      Clreol;
    GotoXY(1,23); Clreol;
    Write('Type ^F to get screen from file, ^C when finished',LV);
    X:=Left; Y := Top;
    GotoXY(X,Y);
  END;

PROCEDURE GETSCREEN (Var Screen:FullScreen);
VAR FileName : String[10];
    NScreen : FullScreen;
    ScrFile  : File of Fullscreen;
    C: Char;
    I : Integer;
BEGIN
  GotoXY(1,23); Clreol;
  Write('Name of File to get:  ');
  Readln(FileName);
  For I := 1 to Length(FileName) do
    FileName[I] := UpCase(FileName[I]);
  Assign(ScrFile,FileName + '.SCR');
  {$I-}
  Reset(ScrFile);
  {$I+}
  If IOResult <> 0 then
  BEGIN
    GotoXY(1,23); Clreol;
    Write(^G,'FILE ',FILENAME,'.SCR NOT FOUND. TYPE ANY KEY TO CONTINUE.');
    READ(KBD,C);
  END ELSE
  BEGIN
    Read(ScrFile,NScreen);
    If IOResult <> 0 then
    BEGIN
      GotoXY(1,23); Clreol;
      Write('BAD FILE. Can''t Read.  Type any key to continue.');
      Read(Kbd,C);
    END ELSE
      Screen := NScreen;
  END;
  Display(Screen);
END;

{AddChar adds characters to the screen in the non-insert mode }

PROCEDURE AddChar(C:Char);
  BEGIN
    Write(C);
    Screen[Y,X] := C;
    X := Succ(X);
    If X > Right Then
      BEGIN
        X := Left;
        Y := Succ(Y);
        If Y > Bottom Then Y := Top;
        GotoXY(X,Y);
      END; {If}
  END;{AddChar}

{ InsChar inserts characters into the screen display in the    }
{ insert mode.                                                 }

PROCEDURE InsChar(C:Char);
VAR Buffer : Str80;
    I : Integer;
  BEGIN
    If X < Right then
    BEGIN
      Move(Screen[Y,X],Buffer[1],Right - X);
      Buffer[0] := Chr(Right - X);
      Insert(C,Buffer,1);
      Move(Buffer[1],Screen[Y,X],Right - Pred(x));
      I := Succ(Length(Buffer));
      REPEAT
        I := Pred(I);
        If Buffer[I] = ' ' then
          Delete(Buffer,I,1)
      UNTIL (Buffer[I] <> ' ') or (I <= 1);
      Write(Buffer);
      X := Succ(X);
      If X > Right then
      BEGIN
        X := Left;
        Y := Succ(Y);
        If Y > Bottom then Y := Top;
      END;
      GotoXY(X,Y);
    END else AddChar(C);
  END;

{ MoveCursor handles those control codes which simply move the }
{ cursor around the screen display.                            }

PROCEDURE MoveCursor(C:Char);
  BEGIN
    Case C of
      #24,#10 : Y := Succ(Y);
      #19,#8  : X := Pred(X);
      #4,#12  : X := Succ(X);
      #5,#11  : Y := Pred(Y);
      #13     : BEGIN
                  Y := Succ(Y);
                  X := Left;
                END;{13}

    END;{Case}
      If X < Left then
        BEGIN
          X := Right;
          Y := Pred(Y);
        END;{If}
      If X > Right then
        BEGIN
          X := Left;
          Y := Succ(Y);
        END;{If}
      If Y < Top then Y := Bottom;
      If Y > Bottom then Y := Top;
      GotoXY(X,Y);
    END;{MoveCursor}

  { Delchar deletes a character both from the screen and from  }
  { its proper place in memory.                                }

  PROCEDURE Delchar;
  BEGIN
    Move(Screen[Y,X],Buffer[1],Right-Pred(X));
    Buffer[0] := Chr(Right - Pred(X));
    Delete(Buffer,1,1);
    Buffer := Buffer + ' ';
    Write(Buffer);
    Move(Buffer[1],Screen[Y,X],Length(Buffer));
    GotoXY(X,Y);
  END;

  {TabOver implements an 8-character fixed tab                 }

  PROCEDURE TabOver(Var XPos: XAxis; Var YPos: YAxis);
  BEGIN
    If X <= 72 then
      XPos := Succ(8 * (Succ(Pred(XPos) div 8)))
    Else
    BEGIN
      XPos := 1;
      YPos := Succ(YPos);
      If YPos > Bottom then
        YPos := Top;
    END;
    GotoXY(XPos,YPos);
  END;


BEGIN {MkScreen}
  Ins := True;
  Done := ' ';
  Clrscr;

   { the following four lines produce the bordering effect I   }
   { chose for the screens I wish to generate.  Modify or omit }
   { if you wish.  If you do change these you may also wish to }
   { change the 'Top' and 'Bottom' constants declared at the   }
   { start of this program.                                    }

  GotoXY(1,1);Write(LV,ConstStr('-',79));
  GotoXY(1,3);Write(ConstStr('-',79));
  GotoXY(1,22);Write(ConstStr('-',79));
  GotoXY(1,24);Write(ConstStr('-',79));

  Ins := True;
  Display(Screen);

  REPEAT
    Read(Kbd,Ch);
    Case Ch of
      #32 .. #126 : If Ins then InsChar(Ch) else
                                   AddChar(Ch);
      ^D,^E,^H,^J,
      ^K,^L,^M,^S,
      ^X          : MoveCursor(Ch);
      ^I          : TabOver(X,Y);
      ^G          : Delchar;
      #127        : BEGIN
                      MoveCursor(^H);
                      Delchar;
             