home *** CD-ROM | disk | FTP | other *** search
/ ftp.wwiv.com / ftp.wwiv.com.zip / ftp.wwiv.com / pub / PROTOCOL / WXTRM305.ZIP / WXTERM.PAS < prev    next >
Pascal/Delphi Source File  |  1991-08-12  |  14KB  |  528 lines
  1. PROGRAM wxterm;
  2. {$S+,R+,D+,L+,V-,B+}
  3.  
  4. USES Dos,CRT,TURBO3; {3.04}
  5.   {
  6.   Scott Murphy
  7.   77 So. Adams St. #301
  8.   Denver, CO 80209
  9.   Compuserve 70156,263
  10.  
  11.   Defaults, help screen and hot keys improved.  Ran thru Pascal
  12.   Formatter, changed to a two file program.  Changed to Ver: 3.01
  13.   12-05-87 L.B. Neal, Sunnyvale, CA.
  14.   }
  15. {**************************************************************}
  16. { Jun 1990. Upgraded to Turbo Pascal 5.0/5.5. Ver:3.04         }
  17. { Aug 1991. Corrected several items. New version is 3.05.      }
  18. { L.B. Neal, Sunnyvale,CA.                                     }
  19. {**************************************************************}
  20.  
  21. CONST
  22.   Version = '3.05 ';          { 12-AUG-91 Another look}
  23.   BELL_FREQ = 440;            {frequency for bell sound}
  24.   BELL_DELAY = 100;           {duration of bell sound}
  25.   DEFAULT_BAUD = 2400;        {Serial port speed at start-up}
  26.   RECV_BUF_SIZE = 4097;       {this may be changed to whatever size you need}
  27.   Buffer_End = RECV_BUF_SIZE-1; { safety margin }
  28.   ComPort : Byte = 1;
  29.   WxExit : Boolean = False;  {3.05}
  30.  
  31. TYPE
  32.   bigstring = STRING[80];     {general purpose}
  33.   cset = SET OF 0..127;
  34.   parity_set = (none, even);  {readability and expansion}
  35.  
  36. VAR
  37.   AsyncVector: Pointer;
  38.   xtnd : Boolean;
  39.   a : Byte;
  40.   c, i : Integer;
  41.   ch : Char;
  42.   regs: Registers;            { 3.04 }
  43.   INVLIST : Integer;
  44.   Buffer_Head, Buffer_Tail,Buffer_Count: Integer;
  45.   recv_buffer : ARRAY[1..RECV_BUF_SIZE] OF Byte;
  46.  
  47.   speed : Integer;            {I don't know the top speed these
  48.  
  49.                               routines will handle}
  50.   dbits : 7..8;               {only ones most people use}
  51.   stop_bits : 1..2;           {does anyone use 2?}
  52.   parity : parity_set;        {even and none are the common ones}
  53.   Cport: String[4];           {3.04}
  54.   Base: Word;                 {3.04}
  55.   Async_Irq: Word;            {3.04}
  56.   OutPort: Word;              {3.04}
  57.   junk: Char;                 {3.04}
  58.   PassStrg: BigString;        {3.04}
  59.   wcol,wrow: Integer;         {3.04}
  60.  
  61.  {$R-,S-}
  62.  
  63.  {$F+} { MUST be a FAR Procedure 3.04 }
  64.  PROCEDURE async_isr; Interrupt;
  65.   BEGIN
  66.    Inline($FA); {CLI} {3.05}
  67.    Recv_Buffer[Buffer_Head] := Port[Base];
  68.    IF (Buffer_Head = Buffer_End) THEN
  69.     Buffer_Head := 1
  70.    ELSE
  71.     INC(Buffer_Head);
  72.    INC(Buffer_Count);
  73.    Inline($FB); {STI} {3.05}
  74.    Port[$20] := $20;
  75.   END;
  76.   {$F-}
  77.  
  78.   PROCEDURE DoBorder(FstCol,FstRow,LstCol,LstRow : Integer);
  79.   VAR i,thisrow,width,height,column: Integer; horiz: String[90];
  80.   BEGIN
  81.     Window(FstCol,FstRow,LstCol,LstRow);
  82.     ClrScr;
  83.     thisrow := 2;
  84.     width := (LstCol-FstCol)-2;
  85.     height := (LstRow-FstRow)-1;
  86.     column := Width+2;
  87.    
  88.     FOR i := 1 to width DO horiz[i] := #205;
  89.     horiz[0] := Char(width);
  90.  
  91.     Gotoxy(1,1); Write(Chr(201));
  92.     Write(horiz);
  93.     Write(Chr(187));
  94.  
  95.     FOR i := 1 TO height DO
  96.      BEGIN
  97.       Gotoxy(1,thisrow);       Write(Chr(186));
  98.       Gotoxy(column,thisrow);  Write(Chr(186));
  99.       INC(thisrow);
  100.      END;
  101.  
  102.     Gotoxy(1,thisrow); Write(CHR(200));
  103.     Write(horiz);
  104.     Write(#188);
  105.   END;
  106.  
  107.   FUNCTION Carrier:Boolean;
  108.   BEGIN
  109.    Carrier := (port[base+6] AND 128) <> 0;
  110.   END;
  111.  
  112.   FUNCTION Wcgetc: Byte; { 3.04 }
  113.   BEGIN
  114.    INLINE($FA); {suspend interrupts}
  115.    wcgetc := Recv_Buffer[buffer_Tail];
  116.    IF Buffer_Tail < Buffer_End THEN { 3.04 safer this way }
  117.     INC(Buffer_Tail)
  118.    ELSE
  119.     Buffer_Tail := 1;
  120.    DEC(Buffer_Count); 
  121.    INLINE($FB); {resume interrupts}
  122.    Port[$20] := $20; {3.05}
  123.   END;
  124.  
  125.   PROCEDURE send(c:Byte);
  126.   BEGIN
  127.    WHILE (port[outport] AND 32) = 0 DO {NOP};
  128.    port[base] := c;
  129.   END;
  130.  
  131.  PROCEDURE set_baud(r:integer);
  132.  VAR a:byte; rw:word;
  133.  BEGIN
  134.   IF (r >= 300) AND (r <= 9600) THEN
  135.    BEGIN
  136.     IF r = 2400 THEN rw := 48
  137.      ELSE IF r = 1200 THEN rw := 96
  138.       ELSE IF r = 9600 THEN rw := 6 { really 19200 baud }
  139.        ELSE IF r = 300 THEN rw := 384;
  140.     a := port[base+3] OR 128;
  141.     port[base+3] := a;
  142.     port[base] := lo(rw);
  143.     port[base+1] := hi(rw);
  144.     port[base+3] := a AND 127;
  145.    END
  146.   ELSE
  147.    BEGIN
  148.     Writeln('Invalid Baud Rate = ', r); { 2.0i }
  149.     Halt(1);
  150.    END;
  151.  END;
  152.  
  153. procedure dump;
  154. begin
  155.   Inline($FA); {CLI}
  156.   buffer_head := 1;
  157.   buffer_tail := 1;
  158.   buffer_count := 0;
  159.   Inline($FB); {STI}
  160.   Port[$20] := $20; {3.05}
  161. end;
  162.  
  163.  procedure remove_port;
  164.  var i,m : Word;
  165.  begin
  166.   inline($FA); {CLI}
  167.   i := port[$21];
  168.   m := 1 SHL Async_Irq;
  169.   port[$21] := i OR m;
  170.   port[base+2] := 0;
  171.   port[base+4] := port[base+4] AND 1;
  172.   inline($FB); {STI}
  173.   Port[$20] := $20; {3.05}
  174.  end;
  175.  
  176. procedure term_ready(s:Boolean);
  177. var x:byte;
  178. begin
  179.   x := port[base+4] and $FE;
  180.   if s then x := x+1;
  181.   port[base+4] := x;
  182. end;
  183.  
  184.  PROCEDURE iport1;
  185.   BEGIN
  186.    CASE comport OF
  187.    1 : begin
  188.         base := $3f8; Async_Irq  := 4; cport := 'COM1:';
  189.        end;
  190.    2 : begin
  191.         base := $2f8; Async_Irq  := 3; cport := 'COM2:';
  192.        end;
  193.    3 : begin
  194.         base := $3E8; Async_Irq  := 4; cport := 'COM3:';
  195.        end;
  196.    4 : begin
  197.         base := $2E8; Async_Irq  := 3; cport := 'COM4:';
  198.        end;
  199.    ELSE
  200.     WriteLn('Invalid Comport:',comport);
  201.     Halt(1);
  202.    END; {case}
  203.    outport := Base+5;
  204.   END;
  205.  
  206.  procedure iport;
  207.  var i,m:Integer;
  208.  BEGIN
  209.   If (Port[base+2] and $00F8) <> 0 Then
  210.    begin
  211.     writeln('Illegal com port number:',cport);
  212.     halt(1); {3.05}
  213.    end
  214.   else
  215.    begin
  216.     buffer_Head := 1;
  217.     buffer_Tail := 1;
  218.     buffer_Count := 0;
  219.     port[base+3]:= $03;
  220.     with regs do
  221.      begin
  222.       ah := $25; al := async_irq+8;
  223.       ds := cseg;
  224.       dx := ofs(async_isr); msdos(regs);
  225.      end;
  226.     inline($FA);
  227.     i := port[base+5];
  228.     i := port[base];
  229.     i := port[$21];
  230.     m := (1 shl Async_Irq) xor $00FF;
  231.     port[$21] := i and m;
  232.     port[base+1] := $01;
  233.     i := port[base+4];
  234.     port[base+4] := i or $08;
  235.     term_ready(true);
  236.     inline($FB);
  237.     Port[$20] := $20; {3.05}
  238.    end;
  239.  end;
  240.  
  241.   PROCEDURE break; {send a break}
  242.   VAR a, b : Byte;
  243.   BEGIN
  244.     a := Port[base+3];
  245.     b := (a AND $7F) OR $40;
  246.     Port[base+3] := b;
  247.     Delay(750);
  248.     Port[base+3] := a;
  249.   END;
  250.  
  251.   FUNCTION exists(fname:bigstring): Boolean;
  252.   VAR f : FILE;
  253.   BEGIN
  254.     Assign(f, fname);
  255.     {$I-} Reset(f); {$I+}
  256.     IF IOResult = 0 THEN
  257.      BEGIN
  258.       exists := True;
  259.       Close(f);
  260.      END
  261.     ELSE
  262.      exists := False
  263.   END;
  264.  
  265.   PROCEDURE supcase(VAR s);
  266.   VAR ss:bigstring ABSOLUTE s; i:Integer;
  267.   BEGIN
  268.     FOR i := 1 TO Length(ss) DO ss[i] := UpCase(ss[i])
  269.   END;
  270.  
  271.   PROCEDURE processcom;
  272.   VAR c,cnt: Byte;
  273.   BEGIN
  274.    IF Buffer_Count > 0 THEN {Safety net 3.04 }
  275.     BEGIN
  276.      c := WcGetc;
  277.      IF c < 13 THEN
  278.       BEGIN
  279.        CASE c OF
  280.         10 : Write(Chr(c)); {3.05}
  281.          9 : FOR cnt := WhereX TO (WhereX DIV 8+1)* 8 DO Write(' ');
  282.          7 : BEGIN {bell}
  283.               Sound(BELL_FREQ);
  284.               Delay(BELL_DELAY);
  285.               NoSound
  286.              END;
  287.         12 : ClrScr;
  288.        END;
  289.       END
  290.      ELSE
  291.        Write(Chr(c));             { Full IBM char set now - 3.03}
  292.     END;
  293.   END;
  294.  {$R+,S+}
  295.  
  296.   {$I WXTMXFER.INC}
  297.  
  298. CONST MASTER_FILE_NAME = 'WXTERM.MST';
  299.  
  300. TYPE
  301.   MasterRec = RECORD
  302.                 mdbits : 7..8;
  303.                 mparity :parity_set;
  304.                 mstop_bits : 1..2;
  305.                 mcom_port: Byte;
  306.                 mspeed : Integer;
  307.               END;
  308. VAR
  309.   msrecord : MasterRec;
  310.   msfile : FILE OF MasterRec;
  311.  
  312.   PROCEDURE setup; {initialize most stuff - you may want to replace this}
  313.   VAR err: Integer; {3.05}
  314.   BEGIN
  315.     WITH msrecord DO
  316.       BEGIN
  317.         Assign(msfile, MASTER_FILE_NAME);
  318.         IF exists(MASTER_FILE_NAME) THEN
  319.           BEGIN
  320.            Reset(msfile);
  321.            Read(msfile, msrecord)
  322.           END
  323.         ELSE
  324.           BEGIN
  325.             Rewrite(msfile);
  326.             mdbits := 8;        {Chg 3.01}
  327.             mparity := NONE;    {Chg 3.01}
  328.             mstop_bits := 1;    {Chg 3.01}
  329.             mcom_port := comport;
  330.             mspeed := DEFAULT_BAUD;
  331.             Write(msfile, msrecord);
  332.           END;
  333.         {$I-} Close(msfile); {$I+} err := IoResult; {3.05}
  334.         dbits := mdbits;
  335.         parity := mparity;
  336.         stop_bits := mstop_bits;
  337.         speed := mspeed;
  338.         ComPort := mcom_port;
  339.       END;
  340.   END;
  341.  
  342.   PROCEDURE GetParms;
  343.   VAR p: string[4]; yn,cp,ans: Char; junk: integer;
  344.   BEGIN
  345.    GotoXy(3,2); Write('Current Parameters:');
  346.    Gotoxy(3,3); Write('Baud Rate:', speed:6);
  347.    Gotoxy(3,4); Write('Data Bits:', dbits:6);
  348.    Gotoxy(3,5); Write('Stop Bits:', stop_bits:6);
  349.    CASE parity OF
  350.     even : p := 'EVEN';
  351.     none : p := 'NONE';
  352.     ELSE
  353.     p := '????'
  354.    END;{case}
  355.    Gotoxy(3,6); Write('Parity   : ', p:6); {3.05}
  356.    Gotoxy(3,7); Write('Comm Port: ', Comport);
  357.    Gotoxy(3,9); Write('Change(Y/N)?');
  358.    REPEAT
  359.     ans := Upcase(ReadKey);
  360.    UNTIL (ans = 'Y') OR (ans = 'N');
  361.  
  362.    IF ans = 'Y' THEN   {3.05}
  363.     BEGIN
  364.      Gotoxy(3,10); Write('Baud Rate 3)00 1)200 2)400 <cr> to keep.'); {Chd 3.01}
  365.      REPEAT
  366.       ans := ReadKey;
  367.      UNTIL ans IN['1'..'3',#13];
  368.      IF ans IN['1'..'3'] THEN val(ans,comport,junk);
  369.  
  370.      Gotoxy(3,11); Write('New Data Bits[7/8] <cr> to keep.'); {Chd 3.05}
  371.      REPEAT
  372.       ans := ReadKey;
  373.      UNTIL ans IN['7','8',#13];
  374.      IF ans IN['7','8'] THEN val(ans,dbits,junk);
  375.  
  376.      Gotoxy(3,12); Write('New Stop Bits[1/2] <cr> to keep.'); {Chd 3.01}
  377.      REPEAT          {3.05}
  378.       ans := ReadKey;
  379.      UNTIL ans IN['1','2',#13];
  380.      IF ans IN['1','2'] THEN val(ans,stop_bits,junk);
  381.  
  382.      Gotoxy(3,13); Write('New Parity E or N <cr> to keep:'); {Chd 3.01}
  383.      REPEAT
  384.       ans := ReadKey;
  385.      UNTIL ans IN['E','N',#13];
  386.      IF (ans = 'E') THEN
  387.       parity := even
  388.      ELSE
  389.       IF (ans = 'N') THEN parity := none;
  390.  
  391.      Gotoxy(3,14); Write('New com port 1..4 or <cr> to keep.'); {Chd 3.05}
  392.      REPEAT
  393.       cp := Upcase(Readkey);
  394.      UNTIL cp IN['1'..'4',#13];
  395.      IF cp IN['1'..'4'] THEN Comport := ORD(cp)-48;
  396.  
  397.      GotoXY(3,15); {3.05}
  398.      Write('Save changes[Y/N]?'); {Chd 3.01}
  399.      REPEAT
  400.       yn := Upcase(Readkey);
  401.      UNTIL (yn = 'Y') OR (yn = 'N');
  402.      IF yn = 'Y' THEN
  403.       BEGIN
  404.        WITH msrecord DO
  405.         BEGIN
  406.          mdbits := dbits;
  407.          mparity := parity;
  408.          mstop_bits := stop_bits;
  409.          mspeed := speed;
  410.          mcom_port := Comport;
  411.          Reset(msfile);
  412.          Write(msfile, msrecord);
  413.          Close(msfile);
  414.         END;
  415.       END;
  416.     END;
  417.   END;
  418.  
  419.   PROCEDURE NewParms;
  420.   BEGIN
  421.    DoBorder(15,3,60,23);
  422.    GetParms;
  423.    ClrScr;
  424.    Window(1,1,80,24);
  425.    Set_Baud(speed);
  426.   END;
  427.  
  428.  BEGIN
  429.   IF Mem[$0000:$0449] = 7 THEN TextMode(MONO) ELSE TextMode(CO80);
  430.   DirectVideo := False;    {3.04}
  431.   CheckBreak := False;     {3.04}
  432.   CheckSnow := False;      {3.04}
  433.   ClrScr;
  434.   Window(1,25,80,25);      {statusline}
  435.   Gotoxy(1,1);
  436.   Write(' WXTERM:'+Version+' Mode:                    <Home> for help');
  437.   setup;
  438.   iport1;
  439.   GetIntVec(Async_Irq+8, AsyncVector);
  440.   iport;
  441.   Set_Baud(speed);
  442.   term_ready(True);
  443.  
  444.   {WxExit := False;} {3.05 now typed constant}
  445.  
  446.   GotoXY(19,1); {3.05}
  447.   IF carrier THEN Write('On-Line/Ready ') ELSE Write('Off-Line/Ready'); {3.05}
  448.  
  449.   Window(1,1,80,24);
  450.   {Gotoxy(1,1);}     {3.05 redundant}
  451.  
  452.   {$R-,S-}
  453.   WHILE NOT WxExit DO    { our main program loop }
  454.    BEGIN
  455.     WHILE Buffer_Count > 0 DO Processcom;  {3.04}
  456.     wcol := WhereX; wrow := WhereY; {3.05 moved here}
  457.     DEC(wcol);                      {3.05 moved here}
  458.     IF keypressed THEN
  459.      BEGIN
  460.       a := ORD(Readkey);
  461.       IF a = 0 THEN
  462.        BEGIN
  463.         a := ORD(Readkey);
  464.         CASE a OF
  465.          81 : recv_wcp;  {PgDn - now is more standard 3.05}
  466.          45 : BEGIN { alt-X}
  467.                DoBorder(20,18,60,22);
  468.                Gotoxy(13,2); Write('─── WXTERM ───');
  469.                Gotoxy(4,3); Write('Do you really want to exit(Y/N)?');
  470.                REPEAT
  471.                 ch := Upcase(Readkey);
  472.                UNTIL (ch = 'Y') OR (ch = 'N');
  473.                IF ch = 'Y' THEN
  474.                 WxExit := True
  475.                ELSE
  476.                 BEGIN
  477.                  Clrscr; Window(1,1,80,24);
  478.                  GotoXY(wcol,wrow);
  479.                 END;
  480.               END;
  481.          73 : send_wcp; {PgUp - now is more to standard 3.05}
  482.          35 : BEGIN    { alt-H }
  483.                WriteLn('─── WXTERM ───');
  484.                WriteLn('Disconnecting');
  485.                term_ready(False);
  486.                Delay(500);
  487.                term_ready(True);
  488.                IF Carrier THEN                   { 3.04 added }
  489.                 WriteLn('Oops! Hangup Failed!')
  490.                ELSE
  491.                 BEGIN
  492.                  wcol := WhereX; wrow := WhereY;
  493.                  Window(1,25,80,25);
  494.                  Gotoxy(19,1);
  495.                  Write('Off-Line/Ready');
  496.                  Window(1,1,80,24);
  497.                  Gotoxy(wcol,wrow);
  498.                 END;
  499.               END;
  500.          46 : ClrScr;         {alt-C}
  501.          48 : Break;          {alt-B}
  502.          25 : BEGIN NewParms; GotoXY(wcol,wrow); END; {3.05}  {alt-P}
  503.          71 : BEGIN           {Home}
  504.                DoBorder(34,3,78,10);
  505.                Gotoxy(3,2); Write('Rcv WXmodem <PGDN>   Send WXmodem <PGUP>');
  506.                Gotoxy(3,3); Write('Exit ALT-X           Hangup ALT-H       ');
  507.                Gotoxy(3,4); Write('Send Break ALT-B     ClrSrn ALT-C       ');            
  508.                Gotoxy(3,5); Write('     Change Comm Params. ALT-P         ');
  509.                Gotoxy(3,7); Write('    <Press any key to continue>        ');
  510.                REPEAT UNTIL (KeyPressed);
  511.                junk := ReadKey;
  512.                BEGIN ClrScr; Window(1,1,80,24); Gotoxy(wcol,wrow); END;
  513.               END;
  514.         END; {case}
  515.        END    {if extended key}
  516.       ELSE    {not extended}
  517.        Send(a);
  518.     END;{if KeyPressed}
  519.   END;{while not wxexit}
  520.   {$R+,S+}
  521.  
  522.   remove_port;
  523.   SetIntVec(Async_irq+8, AsyncVector);
  524.   NormVideo;
  525.   Window(1,1,80,25);           { Added 3.03 }
  526.   ClrScr;                      { Added 3.01 }
  527. END.
  528.