home *** CD-ROM | disk | FTP | other *** search
/ ProfitPress Mega CDROM2 …eeware (MSDOS)(1992)(Eng) / ProfitPress-MegaCDROM2.B6I / BBS / DOORS / QKTERM3.ZIP / QKTERM.PAS < prev   
Encoding:
Pascal/Delphi Source File  |  1991-10-21  |  4.8 KB  |  181 lines
  1. PROGRAM QkTerm;
  2.  
  3. USES
  4. Dos, OpDos, OpCrt, ApAnsi, ApMisc, ApPort, ApUart, OoCom;
  5.  
  6. {
  7.           Modified 10/16/91
  8.           Uses Async Professional Only!
  9. }
  10.  
  11. CONST
  12.   ACK = #06;
  13.   NAK = #15;
  14.   ESC = #27;
  15.   MNREV = #254;      {MultiNode Scrabble Identifier}
  16.   SGREV = #255;      {Single Node Scrabble Identifier}
  17.  
  18. VAR
  19.   aUP                               : UartPort;
  20.   ComName                           : ComNameType;
  21.   Done, Graphics, MultiNode         : Boolean;
  22.   Baud                              : longint;
  23.   Value                             : integer;
  24.   sPort, sBaud                      : string;
  25.   ch                                : char;
  26.  
  27.   PROCEDURE ShowScreen(ScreenData : Pointer);
  28.   VAR
  29.     ScreenSegment : Word;
  30.   BEGIN
  31.     IF Graphics THEN
  32.       ScreenSegment := $B800
  33.     ELSE
  34.       ScreenSegment := $B000;
  35.     Move(ScreenData^, Ptr(ScreenSegment, 0)^, 4000);
  36.   END;
  37.  
  38.   PROCEDURE ExitQkTerm;
  39.   BEGIN
  40.     aUP.Done;
  41.     Halt;
  42.   END;
  43.  
  44.   PROCEDURE OpenScreenColor; EXTERNAL;
  45.   {$L OpenCol}
  46.   PROCEDURE OpenScreenMono; EXTERNAL;
  47.   {$L OpenMon}
  48.   PROCEDURE GameBoardColor; EXTERNAL;
  49.   {$L Color}
  50.   PROCEDURE MNBoardColor; EXTERNAL;
  51.   {$L ColorMN}
  52.   PROCEDURE GameBoardMono; EXTERNAL;
  53.   {$L Mono}
  54.   PROCEDURE MNBoardMono; EXTERNAL;
  55.   {$L MonoMN}
  56.  
  57. PROCEDURE ShowCopyright;
  58. BEGIN
  59.   clrscr;
  60.   Writeln('QkTerm III  Copyright (c) 1991 Christopher Hall');
  61.   Writeln;
  62.   Writeln('                   Christopher Hall');
  63.   Writeln('                   P.O. Box 26025');
  64.   Writeln('                   Austin, Tx   78755');
  65.   Writeln('                   Fido 1:382/29.4');
  66.   Writeln;
  67. END;
  68.  
  69. BEGIN
  70.   Graphics  := (Lo(LastMode) <> 7);
  71.   MultiNode := False;
  72.   IF ParamCount < 2 THEN
  73.   BEGIN
  74.     ShowCopyright;
  75.     WriteLn('Syntax:  QkTerm Port# Baud_Rate [Use CTS?]');
  76.     WriteLn('eg.      QkTerm 1 2400     - Specify Port Params w/ NO CTS HandShaking');
  77.     WriteLn('         QkTerm 1 38400 Y  - Specify Port Params Use CTS HandShaking');
  78.     Halt;
  79.   END;
  80.   sPort := ParamStr(1);
  81.   Value := Ord(sPort[1]) - Ord('1');
  82.   ComName := ComNameType(Value);
  83.   sBaud := ParamStr(2);
  84.   CASE sBaud[1] OF
  85.     '1': IF sBaud[2] = '9' THEN
  86.            Baud := 19200
  87.          ELSE
  88.            Baud := 1200;
  89.     '2': Baud := 2400;
  90.     '3': IF sBaud[2] = '0' THEN
  91.            Baud := 300
  92.          ELSE
  93.            Baud := 38400;
  94.     '4': Baud := 4800;
  95.     '9': Baud := 9600;
  96.     else Baud := 2400;
  97.   END;
  98.   if NOT aUP.InitCustom(ComName, Baud, NoParity, 8, 1, 2000, 2000, ptRestoreOnClose+ptRaiseModemOnOpen) then
  99.   begin
  100.     writeln('Unable to initialize Comm Port: ', AsyncStatus);
  101.     Halt;
  102.   end;
  103.   if ClassifyUart(aUP.GetBaseAddr, True) = U16550A then
  104.   begin
  105.     SetFifoBuffering(aUP.GetBaseAddr, False, 1);
  106.     SetFifoBuffering(aUP.GetBaseAddr, True, 8);
  107.   end;
  108.   if ParamCount > 2 then
  109.     aUP.HWFlowEnable(1800,200,hfUseRTS+hfRequireCTS);
  110.   aUP.SetDTR(True);
  111.   clrscr;
  112.   WriteLn('QkTerm is Activated!  Press <ESC> any time to Abort!');
  113.   Done := False;
  114.   if aUP.CheckDCD then
  115.     aUP.PutChar(ACK);      {Send an ACK for Auto-Checking of Qkterm}
  116.   REPEAT
  117.     IF KeyPressed THEN
  118.     BEGIN
  119.       ch := ReadKey;
  120.       IF ch = ESC THEN ExitQkTerm;
  121.       IF ch = #0 THEN
  122.       BEGIN
  123.         ch := ReadKey;
  124.         CASE ch OF
  125.           ESC, #45 : ExitQkTerm;       {Esc or Alt-X to Exit}
  126.           #46      : ClrScr;           {Alt-C to Clear Screen}
  127.         END; {CASE}
  128.       END
  129.       ELSE
  130.       BEGIN
  131.         while NOT aUP.TransReady DO;
  132.         aUP.PutChar(ch);
  133.       END;
  134.     END;
  135.  
  136.     IF aUP.CharReady THEN
  137.     BEGIN
  138.       aUP.GetChar(ch);
  139.       if ch <> ESC then WriteCharAnsi(ch)
  140.       ELSE
  141.       BEGIN
  142.         while NOT aUP.CharReady do;
  143.         aUP.GetChar(ch);
  144.         CASE ch OF
  145.           MNREV : BEGIN
  146.                     MultiNode := True;
  147.                     aUP.PutChar(ACK);
  148.                   END;
  149.           SGREV : aUP.PutChar(ACK);
  150.           '@'   : IF Graphics THEN
  151.                   BEGIN
  152.                     IF MultiNode THEN
  153.                       ShowScreen(@MNBoardColor)
  154.                     ELSE
  155.                       ShowScreen(@GameBoardColor);
  156.                   END
  157.                   ELSE
  158.                   BEGIN
  159.                     IF MultiNode THEN
  160.                       ShowScreen(@MNBoardMono)
  161.                     ELSE
  162.                       ShowScreen(@GameBoardMono);
  163.                   END;
  164.           '*'   : IF Graphics THEN
  165.                     ShowScreen(@OpenScreenColor)
  166.                   ELSE
  167.                     ShowScreen(@OpenScreenMono);
  168.           '!' : Done := True;
  169.           ELSE
  170.           BEGIN
  171.             WriteCharAnsi(ESC);         {stuff ESC back in}
  172.             WriteCharAnsi(ch);          {process the ANSI sequence}
  173.           END;
  174.         END; {CASE}
  175.       END;
  176.     END;
  177.   UNTIL Done;
  178.   ShowCopyright;
  179.   ExitQkTerm;
  180. END.
  181.