{ File: TC.PAS }
Program TurboComm;
   { Program's function: Test out COMMLIB.INC }
   { Some code has been added that will only compile under }
   { Turbo Pascal Version 3.0 or greater }
   { Search for 'Version 3.0', comment that code out, and }
   { un-comment out the code marked '< 3.0' }


  { Turn off ^C checking, to enhance speed somewhat }
  {$C-}

   Label EndProgram;


   Const
      TCVersion = '1.11';
      Esc = ^[;
      CarrReturn = ^M;
      ReverseScreen = ^['[?5h';
      UnreverseScreen = ^['[?5l';
      SaveCursor = ^['7';
      RestoreCursor = ^['8';
      Bold = ^['[1m';
      Off  = ^['[m';
      Reverse = ^['[7m';
      ReverseBold = ^['[7;1m';
      PrinterReady    = ^['[?10n';  { Printer is turned on }
      PrinterNotReady = ^['[?11n';  { Printer if not turned on }
      TermVT102 = ^['[?6c';
      TermVT125 = ^['[?12;7;0c';
      TermVT220 = ^['[?62;1;2c';
      TermVT240 = ^['[?62;1;2;3;4c';
      DefaultTerm = TermVT220;      { Set default terminal to VT220 }
      SendRetries = 10;             { Max number of times to resend a char }
      VT200Keys : Boolean = True;   { Use the VT2xx function key values }

      FileNameLen = 62;             { Turbo Pascal Version 3.0 Only }
                                    { i.e. It supports pathnames    }

{     FileNameLen = 14;             { Turbo Pascal Version < 3.0    }

   Type
      STR80 = String[80];
      StringLong = String[150];


   Var
      DummyLogical : Boolean;
      Counter, Counter2, CurrentBaud, CtrlCCheck : Integer;
      TermID : STR80;    { String returned on host after Terminal ID request }
      FileOpen  : Boolean;
      ReGISOn   : Boolean;   { Are we running the Poly-ReGIS emulator? }
      DisplayOn : Boolean;   { Output to screen? }
      PrinterOn : Boolean;   { Output to printer? }
      LoggingOn : Boolean;   { Output to file? }
      FileVar : Text;        { File type for sending or receiving }
      Filename : String[FileNameLen];
      CursorRow, CursorCol : Integer;  { Supplied by GetCursorPosition }


      { These are the different data registers used for MSDOS interrupts }
   Type

      __Regs = Record case Integer of
               1: (AX,BX,CX,DX,BP,SI,DI,DS,ES,Flags : INTEGER);
               2: (AL,AH,BL,BH,CL,CH,DL,DH : Byte);
               end;

   Var
      __Registers : __Regs;
      __SaveRegisters : __Regs;   { Use this to save the initial reg values }



   {$I FUNKEY.INC }       { Include function key input definiton }






   Procedure WriteStatus(OutputString : StringLong);
      { Get current cursor position, write status on bottom of screen,
        return to previous cursor position }

      Begin
         Write(SaveCursor);      { Save cursor position }
         GotoXY(1,24);
         ClrEol;
         Write(OutputString);
         Write(RestoreCursor);      { Restore cursor position }
         End; { Procedure WriteStatus }


   Procedure SetCtrlCCheck;
      { Read startup value of Control-C checking, set off, save value }
      { N.B. This is the equivalent of the MS-DOS BREAK=OFF command   }
      {      and is required to run this program.                     }
      Begin
         { Get initial value and save to variable }
         __Registers.AH := $33;
         __Registers.AL := 0;
         Intr($21,__Registers);
         CtrlCCheck := __Registers.DL;
         
         { Set checking off }
         __Registers.AH := $33;
         __Registers.AL := 1;
         __Registers.DL := 0;
         Intr($21,__Registers);

         End; { Procedure SetCtrlCCheck }
         

   Procedure ResetCtrlCCheck;
      { Reset the original Control C checking value to startup value }
      { See previous procedure for explaination. }
      Begin
         __Registers.AH := $33;
         __Registers.AL := 1;
         __Registers.DL := CtrlCCheck;
         Intr($21,__Registers);
         End;  { Procedure ResetCtrlCCheck }


   Function CheckPrinter : Boolean;
      { Check the status of the printer port }
      Begin
         If Port[$43] = 100
            Then CheckPrinter := True
            Else CheckPrinter := False;
         End; { Function CheckPrinter }


   Procedure CheckFunctionStatus(FunctionStatus : Boolean;
                                 FunctionName : STR80);
      { Check the status of a function's value, and print on error,
        given the name of the function that was called. }
      Var
         OutputLine : STR80;

      Begin
         If Not FunctionStatus
            Then
              Begin
                 OutputLine := Bold+FunctionName+' not successful.'+Off;
                 WriteStatus(OutputLine);
                 End  { If file not opened }

         End;  { Procedure CheckFunctionStatus }


   {$I COMMLIB.INC }      { Include communications function definitions }
   {$I CHECKESC.INC }     { Check all escape sequences for specials }
   {$I GETVIDLN.INC }     { Read video memory for screen line }
   {$I REDEFINE.INC }       { Include function key redefinition routines }

   Procedure PrintScreen;
      { Read the current screen from video memory, and dump to printer }
      { N.B. If ReGIS is running, let it handle print screens itself }
      Var
         VidChar : Char;
         LineCounter, ColCounter : Integer;
         VideoString,DummyString : StringLong;
         LineDrawingOn : Boolean;
      Begin

         If CheckPrinter And (Not ReGISOn)   { The printer is ready }
            Then                             { and we're not running ReGIS }
               Begin
                  { First set up video screen width by getting a line twice }
                  DummyString := GetVidLine(1);
                  DummyString := GetVidLine(1);
                  { Now set printer width according to screen width }
                  If VideoScreenWidth = 132
                     Then Write(Lst,^[,'[4w')
                     Else Write(Lst,^[,'[0w');

                  LineDrawingOn := False;
                  Write(Lst,^O);   { Turn printer graphics off }

                  { Now get all the screen lines and print them }
                  Write(ReverseScreen);  { Reverse the screen until done }
                  For LineCounter := 1 to 24 Do
                     Begin
                        VideoString := GetVidLine(Linecounter); { Get line }

          { Move source code left, because of length of lines }
          For ColCounter := 1 to Length(VideoString) Do
             Begin  { Checking and printing character }
                VidChar := VideoString[ColCounter];
                If Ord(VidChar) < 32
                   Then { We've got a graphics character to print }
                        If LineDrawingOn
                           Then Write(Lst,Chr(Ord(VidChar) + 95))
                           Else Begin
                              Write(Lst,^N);  { Printer to graphics mode }
                              Write(Lst,Chr(Ord(VidChar) + 95));
                              LineDrawingOn := True;
                              End  { We had to turn on graphics mode }
                        Else If Not LineDrawingOn
                                Then Write(Lst,VidChar) { normal character }
                                Else Begin
                                   Write(Lst,^O);
                                   Write(Lst,VidChar);
                                   LineDrawingOn := False;
                                   End; { We had to turn off graphics & print }
                End; { FOR ColCounter loop to print video line }
                Writeln(Lst);  { Send a carriage return, line feed to printer }
                Delay(2);   { Give it a short rest }
                        End; { FOR LineCounter loop to print video line }
                  Write(UnReverseScreen);
                  Write(Lst,^O);  { Always turn line drawing off when done }
                  End;
         End; { Procedure PrintScreen }


{   Const     { Turbo Pascal Version < 3.0 }
{      ParamStrArray : Array[1..5] of STR80 = ('','','','','');  { nulls }

{   Var       { Turbo Pascal Version < 3.0 }
{      ParamCount : Byte;

{   Procedure ParseCmdLine;    { Turbo Pascal Version < 3.0 }
      { Read any user command line, and return it as a string }
      { This loads the array ParamStrArray }
{     Var
         CL : STR80 absolute cseg:$80;
         CLCopy : STR80;
      begin
         ParamCount := 0;
         CLCopy := CL;
         While CLCopy > '' Do
            Begin
               While CLCopy[1] = ' ' Do
                  CLCopy := Copy(CLCopy,2,Length(CLCopy) - 1);
               ParamCount := ParamCount + 1;
               While (CLCopy[1] <> ' ') And (CLCopy > '') Do
                  Begin
                     ParamStrArray[ParamCount] := ParamStrArray[ParamCount]
                                                     + CLCopy[1];
                     CLCopy := Copy(CLCopy,2,Length(CLCopy) - 1);
                     End; { While the next char isn't a space }
 {              End; { While there are more characters to get }

 {        end; { Procedure ParseCmdLine }

 {  Function ParamStr(I : Byte) : STR80;   { Turbo Pascal Version < 3.0 }
      { Given the index number, return the parameter string from the array }
 {     Begin
         ParamStr := ParamStrArray[I];
         End; { Function ParamStr }


   Function DisplayMenu : Boolean;
      { Check command line for 'T' --> go directly to terminal emulation }
      {                                (i.e. don't display opening menu  }
      { Also check for initial baud rate setting }

      Type
         ValidBaudType = Array [1..8] of String[4];

      Const
         NumBauds  = 8;
         ValidBaud : ValidBaudType = ('110','150','300',
                     '600','1200','2400',
                     '4800','9600');

      Var
         Counter,BaudIndex : Integer;
         TempStr : STR80;

      Begin
         DisplayMenu := True;
         CurrentBaud := DefaultBaud;
         VT200Keys := True;

         { Read through command line for valid input parameters }
         For Counter := 1 to ParamCount Do
            Begin
               TempStr := ParamStr(Counter);
               If UpCase(TempStr[1]) = 'T'
                  Then DisplayMenu := False
                  Else If (TempStr = 'VT100') Or
                          (TempStr = 'vt100')
                          Then VT200Keys := False
                          Else If TempStr[1] = '@'
                                  Then KeyFileName := Copy(TempStr,2,80)
                                  Else
                          { Compare ParamStr against valid baud rates }
                             For BaudIndex := 1 to NumBauds Do
                                If TempStr = ValidBaud[BaudIndex]
                                   Then Val(TempStr,CurrentBaud,Counter2);
               End; { For Counter loop }

            End; { Function DisplayMenu }


   Function MSDosVersion : Real;
      { Return the current MS-DOS version number }
      begin
         __Registers.AX := $3000;
         MSDos( __Registers );
         MSDosVersion := __Registers.AL + __Registers.AH/100;
         end; { Function MSDosVersion }


   Procedure WriteScr(Var CharToPrint : Char);
      { Write a character to the screen }
      { This could be replaced by the standard Write statement, but }
      { it runs about 5 percent faster. }
      { Save and restore the values of the registers }
      Begin
         __SaveRegisters := __Registers;
         With __Registers Do Begin
            CX := 0;
            DI := 0;       { Function code for Console Out }
            AL := Ord(CharToPrint);
            End;
         Intr(24,__Registers);
         __Registers := __SaveRegisters;
         End; { Procedure WriteScr }


   Procedure DisplayHelp;
      { Display help text on the screen }

      Var
         OutputLine : StringLong;
         OldVideoLine : StringLong;   { Old value of 24th line Declaration }

      Begin
         OutputLine := Off+'Press '+Bold+'<F4>'+Off+
                       ' for command mode: '+Bold+
               'C'+Off+'lose '+Bold+
               'D'+Off+'isconnect '+Bold+
               'P'+Off+'rinter '+Bold+
               'Q'+Off+'uit '+Bold+
               'R'+Off+'eceive '+Bold+
               'S'+Off+'end '+
               'e'+Bold+'X'+Off+'it';
         OldVideoLine := GetVidLine(24);  { Old value of 24th line assignment }

         WriteStatus(OutputLine);
         Delay(8000);
         Write(OldVideoLine);             { Restore old value of 24th line }
         End; { Procedure DisplayHelp }


   Procedure InitTermID;
      { Initialize the global variable TermID, based on whether we're running
        ReGIS emulation software or operating in normal mode. }
      Var
         InputString : STR80;

      Begin
         TermID := DefaultTerm;     { Default:  I am a VT220 terminal }
         ReGISOn := False;
         InputString := '';

         Write(Esc,'PpR(p)',Esc,'\');  { Send out ReGIS report request }

         { ReGIS should return something like '[0,0]'.  If ReGIS isn't on,   }
         { nothing should be returned.  So just check for the standard chars }
         For Counter := 1 to 50 Do
             If ReadKey
               Then
                  InputString := InputString + InString;

                  If Pos(']',InputString) > 0
                     Then Begin
                        ReGISOn := True;
                        If VT200Keys
                        Then       { Graphics and VT200 Class }
                           TermID := TermVT240
                        Else       { Graphics and VT100 Class }
                           TermID := TermVT125;
                        End
                     Else Begin
                        ReGISOn := False;
                        If VT200Keys
                        Then       { No Graphics and VT200 Class }
                           TermID := TermVT220
                        Else       { No Graphics and VT100 Class }
                           TermID := TermVT102;
                        End;

         ClrScr;
         End;


   Function Space(X : Byte) : STR80;
      { BASIC-like function to return x number of spaces }
      Var
         TempString : STR80;
         Counter : Integer;
      Begin
         TempString := '';
         For Counter := 1 to X Do TempString := TempString + ' ';
         Space := TempString;
         End; { Function Space }


   Function MoveLeft(X : Integer) : STR80;
      { Move the cursor left X number of positions }
      Var
         TempString : STR80;
      Begin
         Str(X,TempString);
         MoveLeft := ^[ + '[' + TempString + 'D';
         End; { Function MoveLeft }


   Procedure CloseFile;
      { When done receiving text file, close it }
      Var
         OldVideoLine : StringLong;   { Old value of 24th line Declaration }

      Begin
         If FileOpen Then
            Begin
               Write(SaveCursor);
               Close(FileVar);
               OldVideoLine := GetVidLine(24);
               GotoXY(1,24);
               ClrEol;
               NormVideo;
               Write('Closing any open files');
               LowVideo;
               Delay(1000);
               GotoXY(1,24);
               ClrEol;
               Write(OldVideoLine);  { Restore old value of 24th line }
               Write(RestoreCursor);
               FileOpen := False;
               LoggingOn := False;
               End;
         End; { Procedure CloseFile }


   Procedure SendFile;
      { Send a text file from disk via comm line }

      Var
         Line : StringLong;
         OldVideoLine : StringLong;   { Old value of 24th line Declaration }
         Counter : Byte;

      Begin
         { First check that a file isn't already open }
         If FileOpen Then
            Begin
               CloseFile;
               FileOpen := False;
               End; { If they had :Nþté4ý¡dâ‹fâ-P
