home *** CD-ROM | disk | FTP | other *** search
/ Power-Programmierung / CD1.mdf / pascal / library / dos / communic / async4_2 / tty.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1994-04-11  |  8.6 KB  |  333 lines
  1. { Test shell for Async unit }
  2.  
  3. { DEFINE Test}
  4. { DEFINE TapCIS}
  5. { DEFINE BProto}
  6.  
  7. PROGRAM TTY ;
  8.  
  9. uses
  10.   Dos,
  11.   Crt,
  12.   {$IFDEF BProto}
  13.     PBm,
  14.     {$ENDIF}
  15.   Async4 ;
  16.  
  17. VAR
  18.   c             : char ;
  19.   TestPort      : INTEGER ;
  20.   TestRate      : aBpsRate ;
  21.   TestParity    : aParitySetting ;
  22.   TestWordLen   : byte ;
  23.   TestStopBits  : byte ;
  24.   CurrRate      : aBpsRate ;
  25.   CurrParity    : aParitySetting ;
  26.   CurrWordLen   : byte ;
  27.   CurrStopBits  : byte ;
  28.   DelayCount    : INTEGER ;
  29.   YorN          : CHAR ;
  30.   CharMask      : byte ;
  31.   State         : (MenuMode, TermMode, Exitting) ;
  32.   Open          : BOOLEAN ;
  33.  
  34.  
  35. {$IFDEF TapCIS}
  36.   FUNCTION Async_Buffer_Check( VAR c : CHAR ) : BOOLEAN ;
  37.   BEGIN
  38.     Async_Buffer_Check := Async_Get_Char( c )
  39.     END ;
  40.   {$ENDIF}
  41.  
  42. PROCEDURE SetParams ;
  43.  
  44. VAR
  45.   Parity    : CHAR ;
  46.   Rate      : word ;
  47.   GoodPorts : aSetOfPorts ;
  48.   NewUartBase : word ;
  49.   NewIrq      : byte ;
  50.  
  51. BEGIN { SetParams }
  52.   IF NOT Open THEN BEGIN
  53.     REPEAT
  54.       WRITE( 'Port (1=com1, 2=com2' ) ;
  55.       IF Async_ComputerType = DG1 THEN
  56.         WRITE( ', 3=INternal modem' ) ;
  57.       WRITE( ')? ' ) ;
  58.       READLN( TestPort ) ;
  59.       Async_AvailablePorts( GoodPorts ) ;
  60.       IF NOT (TestPort IN GoodPorts) THEN BEGIN
  61.         WRITE( '  Enter uart base address (in DECIMAL): ' ) ;
  62.         READLN( NewUartBase ) ;
  63.         WRITE( '  Enter irq: ' ) ;
  64.         READLN( NewIrq ) ;
  65.         IF Async_DefinePort( TestPort, NewUartBase, NewIrq ) THEN
  66.           Async_AvailablePorts( GoodPorts )
  67.         ELSE
  68.           WRITELN( '*** Error defining port number ', TestPort, ' ***' )
  69.         END
  70.       UNTIL TestPort IN GoodPorts
  71.     END ;
  72.   WRITE( 'Baud? ' ) ;
  73.   READLN( Rate ) ;
  74.   TestRate := Async_MapBpsRate( Rate ) ;
  75.   WRITE( 'Word length (7, 8)? ' ) ;
  76.   READLN( TestWordLen ) ;
  77.   WRITE( 'Stop bits (1, 2)? ' ) ;
  78.   READLN( TestStopBits ) ;
  79.   WRITE( 'Parity (O, E, N)? ' ) ;
  80.   READLN( Parity ) ;
  81.   CASE upcase( Parity ) OF
  82.     'O' : TestParity := OddParity ;
  83.     'E' : TestParity := EvenParity ;
  84.     'N' : TestParity := NoParity
  85.     END ;
  86.   IF Open THEN BEGIN
  87.     Async_Change( TestRate, TestParity, TestWordLen, TestStopBits ) ;
  88.     {$IFDEF Test}
  89.       Async_GetParams( CurrRate, CurrParity, CurrWordLen, CurrStopBits ) ;
  90.       WRITELN( 'Parameters set to:' ) ;
  91.       WRITE( '  ' ) ;
  92.       CASE CurrRate OF
  93.         bps110  : WRITE( '110'  ) ;
  94.         bps150  : WRITE( '150'  ) ;
  95.         bps300  : WRITE( '300'  ) ;
  96.         bps600  : WRITE( '600'  ) ;
  97.         bps1200 : WRITE( '1200' ) ;
  98.         bps2400 : WRITE( '2400' ) ;
  99.         bps4800 : WRITE( '4800' ) ;
  100.         bps9600 : WRITE( '9600' )
  101.         END ; { case }
  102.       WRITELN( ' bps' ) ;
  103.       WRITELN( CurrWordLen:3, ' data bits' ) ;
  104.       WRITELN( CurrStopBits:3, ' stop bits' ) ;
  105.       WRITE( '  ' ) ;
  106.       CASE CurrParity OF
  107.         NoParity   : WRITE( 'No' ) ;
  108.         OddParity  : WRITE( 'Odd' ) ;
  109.         EvenParity : WRITE( 'Even' )
  110.         END ; { case }
  111.       WRITELN( ' parity' )
  112.       {$ENDIF}
  113.     END
  114.   ELSE BEGIN
  115.     WRITE( 'Mask high order bit (y/n)? ' ) ;
  116.     READLN( YorN ) ;
  117.     IF YorN IN ['n', 'N'] THEN
  118.       CharMask := $FF
  119.     END
  120.   END { SetParams } ;
  121.  
  122.  
  123. PROCEDURE OpenPort ;
  124.  
  125. BEGIN { OpenPort }
  126.   IF NOT Async_Open( TestPort,
  127.                      TestRate,
  128.                      TestParity,
  129.                      TestWordLen,
  130.                      TestStopBits ) THEN BEGIN
  131.     WRITELN('**ERROR: Async_Open failed') ;
  132.     Open := FALSE
  133.     END
  134.   ELSE
  135.     Open := TRUE
  136.   END { OpenPort } ;
  137.  
  138.  
  139. PROCEDURE TermTest ;
  140.  
  141.   PROCEDURE Help( ExitKey : string ) ;
  142.  
  143.   BEGIN { Help }
  144.     WRITELN ;
  145.     WRITELN( '*** ', ExitKey, ' to exit ***' ) ;
  146.     WRITELN
  147.     END { Help } ;
  148.  
  149.   PROCEDURE Quit ;
  150.  
  151.   BEGIN { Quit }
  152.     WRITELN ;
  153.     WRITELN('=== End of TTY Emulation ===');
  154.     {$IFDEF Test}
  155.       WRITELN('Max Buffer Used = ', Async_MaxBufferUsed);
  156.       {$ENDIF}
  157.     WRITELN ;
  158.     State := MenuMode
  159.     END { Quit } ;
  160.  
  161. BEGIN { TermTest }
  162.   IF Open THEN BEGIN
  163.     {$IFDEF Test}
  164.       WRITE( 'Delay (milliseconds)? ' ) ;
  165.       READLN( DelayCount ) ;
  166.       {$ENDIF}
  167.     WRITELN('TTY Emulation begins now...');
  168.     WRITELN('Press <F10> to terminate...');
  169.     State := TermMode ;
  170.     REPEAT
  171.       WHILE Async_Buffer_Check( c ) DO BEGIN
  172.         { empty all pending chars from the buffer }
  173.         c := chr( ord(c) and CharMask ) ;
  174.         CASE c OF
  175.           #000 : ;  { strip incoming nulls }
  176.           {$IFDEF BProto}
  177.           #005 : IF ProtocolTransfer( TRUE ) THEN
  178.                    WRITELN( '*** B-Protocol transfer success ***' )
  179.                  ELSE
  180.                    WRITELN( '*** B-Protocol transfer failure ***' ) ;
  181.           {$ENDIF}
  182.           #010 : ;  { strip incoming line feeds }
  183.           #012 : clrscr ; { clear screen on a form feed }
  184.           #013 : WRITELN  { handle carrige return as CR/LF }
  185.           ELSE
  186.             WRITE( c )  { else write incoming char to the screen }
  187.           END { case }
  188.         END ; { while }
  189.       IF KeyPressed THEN BEGIN
  190.         c := ReadKey ;
  191.         IF (c = #0) THEN  { handle IBM Extended Ascii codes } BEGIN
  192.           c := ReadKey ;  { get the rest of the extended code }
  193.           CASE c OF
  194.             #59 : {f1 } Help( 'F10' ) ;
  195.             #60 : {f2 } Async_Send_String( 'ATDT9530212'+CHR(13) ) ;
  196.             #61 : {f3 } Help( 'F7' ) ;
  197.             #62 : {f4 } ;
  198.             #63 : {f5 } ;
  199.             #64 : {f6 } ;
  200.             #65 : {f7 } Quit ;
  201.             #66 : {f8 } Async_Send_String( 'bye'+CHR(13) ) ;
  202.             #67 : {f9 } Async_Send_String( 'bye'+CHR(13) ) ;
  203.             #68 : {f10} Quit ;
  204.             ELSE Async_Send( c )
  205.             END ; { case }
  206.           END
  207.         ELSE
  208.           Async_Send( c )
  209.         END
  210.     {$IFDEF Test}
  211.       ELSE
  212.         delay( DelayCount )
  213.       {$ENDIF}
  214.       UNTIL State = MenuMode
  215.     END
  216.   ELSE BEGIN
  217.     WRITELN( 'You must open the port first!' )
  218.     END
  219.   END { TermTest } ;
  220.  
  221.  
  222. PROCEDURE EnablePort ;
  223.  
  224. BEGIN { EnablePort }
  225.   WRITE( '  Enable: P(ort or D(TR? ' ) ;
  226.   REPEAT
  227.     c := upcase( ReadKey )
  228.     UNTIL c IN ['P', 'D'] ;
  229.   WRITELN( c ) ;
  230.   IF c = 'P' THEN BEGIN
  231.     WRITE( '    Enable Port: via B(IOS or D(irect? ' ) ;
  232.     REPEAT
  233.       c := upcase( ReadKey )
  234.       UNTIL c IN ['B', 'D'] ;
  235.     WRITELN( c ) ;
  236.     IF c = 'B' THEN BEGIN
  237.       (*IF Async_dg1_enableport( _async_Port, _dg1_IntOrExt ) THEN*)
  238.         (*WRITELN( '      Port enabled via BIOS' )*)
  239.       END
  240.     ELSE BEGIN
  241.       writeln( '*** NOT IMPLEMENTED YET ***' )
  242.       END
  243.     END
  244.   (*|||
  245.   ELSE BEGIN
  246.     _async_dtr( _async_Port, TRUE ) ;
  247.     WRITELN( '    DTR asserted' )
  248.     END
  249.   (*|*)
  250.   END { EnablePort } ;
  251.  
  252.  
  253. PROCEDURE DisablePort ;
  254.  
  255. BEGIN { DisablePort }
  256.   WRITE( '  Disable: P(ort or D(TR? ' ) ;
  257.   REPEAT
  258.     c := upcase( ReadKey )
  259.     UNTIL c IN ['P', 'D'] ;
  260.   WRITELN( c ) ;
  261.   IF c = 'P' THEN BEGIN
  262.     WRITE( '    Disable Port: via B(IOS or D(irect? ' ) ;
  263.     REPEAT
  264.       c := upcase( ReadKey )
  265.       UNTIL c IN ['B', 'D'] ;
  266.     WRITELN( c ) ;
  267.     IF c = 'B' THEN BEGIN
  268.       (*_dg1_disableport( _async_Port, _dg1_IntOrExt ) ;*)
  269.       (*WRITELN( '      Port disabled via BIOS' )*)
  270.       END
  271.     ELSE BEGIN
  272.       writeln( '*** NOT IMPLEMENTED YET ***' )
  273.       END
  274.     END
  275.   (*|||
  276.   ELSE BEGIN
  277.     _async_dtr( _async_Port, FALSE ) ;
  278.     WRITELN( '    DTR cleared' )
  279.     END
  280.   (*|*)
  281.   END { DisablePort } ;
  282.  
  283.  
  284. PROCEDURE ClosePort ;
  285.  
  286. BEGIN { ClosePort }
  287.   WRITELN( 'Closing async' ) ;
  288.   Async_Close ;   { reset the interrupt system, etc. }
  289.   Open := FALSE
  290.   END { ClosePort } ;
  291.  
  292.  
  293. BEGIN { TtyDG }
  294.   ClrScr ;
  295.   WRITELN( '* TTY: Test driver for Async & BProto units' ) ;
  296.   WRITELN(
  297.     '* Using Async  version ', Async4.UnitVersion, ' (', Async4.UnitVerDate, ')');
  298.   {$IFDEF BProto}
  299.     WRITELN(
  300.       '* Using BProto version ', PBm.UnitVersion,  ' (', PBm.UnitVerDate, ')');
  301.     {$ENDIF}
  302.   Open          := false ;
  303.   DelayCount    := 1 ;
  304.   TestPort      := 1 ;
  305.   TestRate      := bps1200 ;
  306.   TestWordLen   := 8 ;
  307.   TestStopBits  := 1 ;
  308.   TestParity    := NoParity ;
  309.   CharMask      := $7F ;
  310.  
  311.   REPEAT
  312.     State := MenuMode ;
  313.     WRITE( 'S(et/change params, O(pen, T(est, E(nable, D(isable, C(lose or Q(uit ' ) ;
  314.     REPEAT
  315.       c := upcase( ReadKey ) ;
  316.       UNTIL c IN ['S', 'O', 'T', 'E', 'D', 'C', 'Q'] ;
  317.     WRITELN( c ) ;
  318.     CASE c OF
  319.       'S' : SetParams ;
  320.       'O' : OpenPort ;
  321.       'T' : TermTest ;
  322.       'E' : EnablePort ;
  323.       'D' : DisablePort ;
  324.       'C' : ClosePort ;
  325.       'Q' : State := Exitting
  326.       END ; { CASE }
  327.     UNTIL State = Exitting ;
  328.   IF Open THEN BEGIN
  329.     WRITELN( 'Closing async' ) ;
  330.     Async_Close
  331.     END
  332.   END { TTYDG } .
  333.