PROGRAM DOSCREEN;

{Version 2.0 by Steve Cohen 2/13/85}
{Released to Public Domain         }
{To be compiled under Turbo-Pascal }

{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;
BEGIN
  GotoXY(1,23); Clreol;
  Write('Name of File to get:  ');
  Readln(FileName);
  FileName := FileName + '.SCR';
  Assign(ScrFile,FileName);
  {$I-}
  Reset(ScrFile);
  If IOResult <> 0 then
  BEGIN
    GotoXY(1,23); Clreol;
    Write(^G,'FILE ',FILENAME,' 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;
                    END;
      ^N          : {Code to insert a line}
                    BEGIN
                      Move(Screen[Y,1],Screen[Succ(Y),1],
                        (Right-Pred(Left)) * (Bottom - Y));
                      FillChar(Screen[Y,1],Right - Pred(Left),' ');
                      GotoXY(1,Bottom);DelLine;
                      GotoXY(1,Y);InsLine;
                    END;
      ^Y          : {Code to delete a line}
                    BEGIN
                      If Y < Bottom then
                        Move(Screen[Succ(Y),1],Screen[Y,1],
                           (Right - Pred(Left)) * (Bottom - Y));
                      FillChar(Screen[Bottom,1],Right - Pred(Left),' ');
                      DelLine;
                      GotoXY(1,Bottom);InsLine;
                      GotoXY(X,Y);
                    END;
      ^V          : BEGIN
                      Ins := Not Ins;
                      GotoXY(70,2);
                      If Ins then
                        Write('INSERT') else
                        Clreol;
                      GotoXY(X,Y);
                    END;
       ^C         : BEGIN
                      GotoXY(1,23);Clreol;
                      Write('Sure you want to stop now (Y/N)?');
                      REPEAT
                        Read(Kbd,Done);
                        Done := UpCase(Done);
                        If Not (Done in ['Y','N']) then Write(^G);
                      UNTIL (Done in ['Y','N']);
                      GotoXY(1,23);Clreol;
                      If Done = 'N' then GotoXY(X,Y);
                    END;
       ^F         : GetScreen(Screen);
    END;{Case}
  UNTIL Done = 'Y';
END;

  { FormStrings concatenates the various characters entered    }
  { under Mkscreen into strings -- either strings of solid     }
  { underscores (data entry blanks) -- or prompt strings.      }

PROCEDURE FormStrings(Screen:FullScreen);
  TYPE
    Action = (Skip,Tag,Blank);
  VAR
    Y    : Top..Bottom;
    X,X1 : Left..Right;
    I,J : Integer;
    S : String[80];
    Mode : Action;
    Spaces : Integer;

    { Terminate stops the string formation process when a      }
    { string is completed, and reinitializes the process of    }
    { formation for the next string                            }

    PROCEDURE Terminate(Var Stg : Str80);
      BEGIN
        Case Mode of
          Tag : BEGIN
                  REPEAT
                    If Stg[Length(Stg)] = ' ' then
                      Delete(Stg,Length(Stg),1);
                  UNTIL (Stg[Length(Stg)] <> ' ') or (Length(Stg) = 0);
                  I := Succ(I);
                  With FieldTag[I] do
                  BEGIN
                    XBegin := X1;
                    YBegin := Y;
                    Contents := Stg;
                  END;
                END;
          Blank : BEGIN
                    J := Succ(J);
                    With FieldBlank[J] do
                    BEGIN
                      XBegin := X1;
                      YBegin := Y;
                      Contents := Stg;
                    END;
                  END;
        END; {Case}
        Stg := '';
        X1 := X;
      END;{Terminate}

BEGIN {Formstrings}
  I := 0; J := 0;
  For Y := Top to Bottom Do
  BEGIN
    S := '';
    Spaces := 0;
    Mode := Skip;
    For X := Left to Right Do
    BEGIN
      CASE Mode Of
        Skip : If Screen[Y,X] <> ' ' then
               BEGIN
                 If Screen[Y,X] = '_' then
                   Mode := Blank else
                   Mode := Tag;
                 S := S + Screen[Y,X];
                 X1 := X;
               END;
        Tag : BEGIN
                If Screen[Y,X] = ' ' then
                BEGIN
                  Spaces := Succ(Spaces);
                  If Spaces > 2 then
                  BEGIN
                    Terminate(S);
                    Mode := Skip;
                  END else
                    S := S + Screen[Y,X];
                END else

                If Screen[Y,X] = '_' then
                BEGIN
                  Spaces := 0;
                  Terminate(S);
                  S := '_';
                  Mode := Blank;
                END else
                BEGIN
                  S := S + Screen[Y,X];
                  Spaces := 0;
                  If Screen[Y,X] = #39 then
                    S := S + #39;
                END;
              END;
        Blank:   If Screen[Y,X] = '_' then
                   S := S + '_'  else
                   BEGIN
                     Terminate(S);
                     If Screen[Y,X] <> ' ' then
                     BEGIN
                       S := S + Screen[Y,X];
                       Mode := Tag;
                     END else
                     Mode := Skip;
                   END;
        END;{case}
      END;{For X}
      If Mode <> Skip then Terminate(S);
    END;{FOR Y}
  NoOfTags := I;
  NoOfBlanks := J;
END;{FormStrings}

{ WriteFiles writes two files                                     }
{ 1> a Turbo-Pascal source code Procedure file with type '.PAS'   }
{    containing the following:                                    }
{    'Outform' - a procedure which will put the prompts that have }
{    been input onto the screen in their proper places.         }
{    'ClearForm' - a procedure that will clear any characters   }
{    from the screen in the  places which you have designated   }
{    (by '_') as  data-entry places.  Use the ClearForm         }
{    coordinates as the starting locations for your input       }
{    routines.                                                  }
{    The 'Main Program which is simply to test Outform -  once  }
{    tested, you'll want to throw it away.                      }
{ 2> A screen File for later access by screendo with Type '.SCR'}

PROCEDURE WriteFiles;
Const
  S2 = '  ';
  S4 = '    ';
  S6 = '      ';
  G = 'GotoXY(';
  W = 'Write(''';
Var
  I : Integer;

BEGIN
  GotoXY(1,23);Clreol;
  Write('Enter File Name:  ');
  Readln(FileName);
  Assign(PasFile,FileName + '.PAS');
  ReWrite(PasFile);
  Writeln(PasFile,'PROCEDURE OutForm;');
  Writeln(PasFile,'BEGIN');
  For I := 1 to NoOfTags do With FieldTag[I] do
  BEGIN
    Write(PasFile,S2,G,XBegin,',',YBegin,'); ');
    Writeln(PasFile,W,Contents,''');');
  END;
  Writeln(PasFile,'END;');
  Writeln(PasFile);
  Writeln(PasFile,'PROCEDURE ClearForm;');
  Writeln(PasFile,'BEGIN');
  For I := 1 to NoOfBlanks do With FieldBlank[I] do
  BEGIN
    Write(PasFile,S2,G,XBegin,',',YBegin,'); ');
    Writeln(PasFile,W,'''',':',Length(Contents),');');
  END;
  Writeln(PasFile,'END;');
  Writeln(PasFile);
  Writeln(PasFile,'BEGIN');
  Writeln(PasFile,S2,'ClrScr;');
  Writeln(PasFile,S2,'OutForm;');
  Writeln(PasFile,'END.');
  Close(PasFile);
  Assign(ScrFile,FileName + '.SCR');
  ReWrite(ScrFile);
  Write(ScrFile,Screen);
  Close(ScrFile);
END;

BEGIN
  FillChar(FileName,SizeOf(FileName),0);
  FillChar(Screen,SizeOf(Screen),' ');
  FillChar(FieldTag,SizeOf(FieldTag),0);
  FillChar(FieldBlank,SizeOf(FieldBlank),0);
  MkScreen(Screen);
  FormStrings(Screen);
  WriteFiles;
END.