Category : Pascal Source Code
Archive   : ASYNC41.ZIP
Filename : TTY.PAS

 
Output of file : TTY.PAS contained in archive : ASYNC41.ZIP
{ Test shell for Async unit }

{ DEFINE Test}
{ DEFINE TapCIS}
{ DEFINE BProto}

PROGRAM TTY ;

uses
Dos,
Crt,
{$IFDEF BProto}
PBm,
{$ENDIF}
Async4 ;

VAR
c : char ;
TestPort : INTEGER ;
TestRate : aBpsRate ;
TestParity : aParitySetting ;
TestWordLen : byte ;
TestStopBits : byte ;
CurrRate : aBpsRate ;
CurrParity : aParitySetting ;
CurrWordLen : byte ;
CurrStopBits : byte ;
DelayCount : INTEGER ;
YorN : CHAR ;
CharMask : byte ;
State : (MenuMode, TermMode, Exitting) ;
Open : BOOLEAN ;


{$IFDEF TapCIS}
FUNCTION Async_Buffer_Check( VAR c : CHAR ) : BOOLEAN ;
BEGIN
Async_Buffer_Check := Async_Get_Char( c )
END ;
{$ENDIF}

PROCEDURE SetParams ;

VAR
Parity : CHAR ;
Rate : word ;
GoodPorts : aSetOfPorts ;
NewUartBase : word ;
NewIrq : byte ;

BEGIN { SetParams }
IF NOT Open THEN BEGIN
REPEAT
WRITE( 'Port (1=com1, 2=com2' ) ;
IF Async_ComputerType = DG1 THEN
WRITE( ', 3=INternal modem' ) ;
WRITE( ')? ' ) ;
READLN( TestPort ) ;
Async_AvailablePorts( GoodPorts ) ;
IF NOT (TestPort IN GoodPorts) THEN BEGIN
WRITE( ' Enter uart base address (in DECIMAL): ' ) ;
READLN( NewUartBase ) ;
WRITE( ' Enter irq: ' ) ;
READLN( NewIrq ) ;
IF Async_DefinePort( TestPort, NewUartBase, NewIrq ) THEN
Async_AvailablePorts( GoodPorts )
ELSE
WRITELN( '*** Error defining port number ', TestPort, ' ***' )
END
UNTIL TestPort IN GoodPorts
END ;
WRITE( 'Baud? ' ) ;
READLN( Rate ) ;
TestRate := Async_MapBpsRate( Rate ) ;
WRITE( 'Word length (7, 8)? ' ) ;
READLN( TestWordLen ) ;
WRITE( 'Stop bits (1, 2)? ' ) ;
READLN( TestStopBits ) ;
WRITE( 'Parity (O, E, N)? ' ) ;
READLN( Parity ) ;
CASE upcase( Parity ) OF
'O' : TestParity := OddParity ;
'E' : TestParity := EvenParity ;
'N' : TestParity := NoParity
END ;
IF Open THEN BEGIN
Async_Change( TestRate, TestParity, TestWordLen, TestStopBits ) ;
{$IFDEF Test}
Async_GetParams( CurrRate, CurrParity, CurrWordLen, CurrStopBits ) ;
WRITELN( 'Parameters set to:' ) ;
WRITE( ' ' ) ;
CASE CurrRate OF
bps110 : WRITE( '110' ) ;
bps150 : WRITE( '150' ) ;
bps300 : WRITE( '300' ) ;
bps600 : WRITE( '600' ) ;
bps1200 : WRITE( '1200' ) ;
bps2400 : WRITE( '2400' ) ;
bps4800 : WRITE( '4800' ) ;
bps9600 : WRITE( '9600' )
END ; { case }
WRITELN( ' bps' ) ;
WRITELN( CurrWordLen:3, ' data bits' ) ;
WRITELN( CurrStopBits:3, ' stop bits' ) ;
WRITE( ' ' ) ;
CASE CurrParity OF
NoParity : WRITE( 'No' ) ;
OddParity : WRITE( 'Odd' ) ;
EvenParity : WRITE( 'Even' )
END ; { case }
WRITELN( ' parity' )
{$ENDIF}
END
ELSE BEGIN
WRITE( 'Mask high order bit (y/n)? ' ) ;
READLN( YorN ) ;
IF YorN IN ['n', 'N'] THEN
CharMask := $FF
END
END { SetParams } ;


PROCEDURE OpenPort ;

BEGIN { OpenPort }
IF NOT Async_Open( TestPort,
TestRate,
TestParity,
TestWordLen,
TestStopBits ) THEN BEGIN
WRITELN('**ERROR: Async_Open failed') ;
Open := FALSE
END
ELSE
Open := TRUE
END { OpenPort } ;


PROCEDURE TermTest ;

PROCEDURE Help( ExitKey : string ) ;

BEGIN { Help }
WRITELN ;
WRITELN( '*** ', ExitKey, ' to exit ***' ) ;
WRITELN
END { Help } ;

PROCEDURE Quit ;

BEGIN { Quit }
WRITELN ;
WRITELN('=== End of TTY Emulation ===');
{$IFDEF Test}
WRITELN('Max Buffer Used = ', Async_MaxBufferUsed);
{$ENDIF}
WRITELN ;
State := MenuMode
END { Quit } ;

BEGIN { TermTest }
IF Open THEN BEGIN
{$IFDEF Test}
WRITE( 'Delay (milliseconds)? ' ) ;
READLN( DelayCount ) ;
{$ENDIF}
WRITELN('TTY Emulation begins now...');
WRITELN('Press to terminate...');
State := TermMode ;
REPEAT
WHILE Async_Buffer_Check( c ) DO BEGIN
{ empty all pending chars from the buffer }
c := chr( ord(c) and CharMask ) ;
CASE c OF
#000 : ; { strip incoming nulls }
{$IFDEF BProto}
#005 : IF ProtocolTransfer( TRUE ) THEN
WRITELN( '*** B-Protocol transfer success ***' )
ELSE
WRITELN( '*** B-Protocol transfer failure ***' ) ;
{$ENDIF}
#010 : ; { strip incoming line feeds }
#012 : clrscr ; { clear screen on a form feed }
#013 : WRITELN { handle carrige return as CR/LF }
ELSE
WRITE( c ) { else write incoming char to the screen }
END { case }
END ; { while }
IF KeyPressed THEN BEGIN
c := ReadKey ;
IF (c = #0) THEN { handle IBM Extended Ascii codes } BEGIN
c := ReadKey ; { get the rest of the extended code }
CASE c OF
#59 : {f1 } Help( 'F10' ) ;
#60 : {f2 } Async_Send_String( 'ATDT9530212'+CHR(13) ) ;
#61 : {f3 } Help( 'F7' ) ;
#62 : {f4 } ;
#63 : {f5 } ;
#64 : {f6 } ;
#65 : {f7 } Quit ;
#66 : {f8 } Async_Send_String( 'bye'+CHR(13) ) ;
#67 : {f9 } Async_Send_String( 'bye'+CHR(13) ) ;
#68 : {f10} Quit ;
ELSE Async_Send( c )
END ; { case }
END
ELSE
Async_Send( c )
END
{$IFDEF Test}
ELSE
delay( DelayCount )
{$ENDIF}
UNTIL State = MenuMode
END
ELSE BEGIN
WRITELN( 'You must open the port first!' )
END
END { TermTest } ;


PROCEDURE EnablePort ;

BEGIN { EnablePort }
WRITE( ' Enable: P(ort or D(TR? ' ) ;
REPEAT
c := upcase( ReadKey )
UNTIL c IN ['P', 'D'] ;
WRITELN( c ) ;
IF c = 'P' THEN BEGIN
WRITE( ' Enable Port: via B(IOS or D(irect? ' ) ;
REPEAT
c := upcase( ReadKey )
UNTIL c IN ['B', 'D'] ;
WRITELN( c ) ;
IF c = 'B' THEN BEGIN
(*IF Async_dg1_enableport( _async_Port, _dg1_IntOrExt ) THEN*)
(*WRITELN( ' Port enabled via BIOS' )*)
END
ELSE BEGIN
writeln( '*** NOT IMPLEMENTED YET ***' )
END
END
(*|||
ELSE BEGIN
_async_dtr( _async_Port, TRUE ) ;
WRITELN( ' DTR asserted' )
END
(*|*)
END { EnablePort } ;


PROCEDURE DisablePort ;

BEGIN { DisablePort }
WRITE( ' Disable: P(ort or D(TR? ' ) ;
REPEAT
c := upcase( ReadKey )
UNTIL c IN ['P', 'D'] ;
WRITELN( c ) ;
IF c = 'P' THEN BEGIN
WRITE( ' Disable Port: via B(IOS or D(irect? ' ) ;
REPEAT
c := upcase( ReadKey )
UNTIL c IN ['B', 'D'] ;
WRITELN( c ) ;
IF c = 'B' THEN BEGIN
(*_dg1_disableport( _async_Port, _dg1_IntOrExt ) ;*)
(*WRITELN( ' Port disabled via BIOS' )*)
END
ELSE BEGIN
writeln( '*** NOT IMPLEMENTED YET ***' )
END
END
(*|||
ELSE BEGIN
_async_dtr( _async_Port, FALSE ) ;
WRITELN( ' DTR cleared' )
END
(*|*)
END { DisablePort } ;


PROCEDURE ClosePort ;

BEGIN { ClosePort }
WRITELN( 'Closing async' ) ;
Async_Close ; { reset the interrupt system, etc. }
Open := FALSE
END { ClosePort } ;


BEGIN { TtyDG }
ClrScr ;
WRITELN( '* TTY: Test driver for Async & BProto units' ) ;
WRITELN(
'* Using Async version ', Async4.UnitVersion, ' (', Async4.UnitVerDate, ')');
{$IFDEF BProto}
WRITELN(
'* Using BProto version ', PBm.UnitVersion, ' (', PBm.UnitVerDate, ')');
{$ENDIF}
Open := false ;
DelayCount := 1 ;
TestPort := 1 ;
TestRate := bps1200 ;
TestWordLen := 8 ;
TestStopBits := 1 ;
TestParity := NoParity ;
CharMask := $7F ;

REPEAT
State := MenuMode ;
WRITE( 'S(et/change params, O(pen, T(est, E(nable, D(isable, C(lose or Q(uit ' ) ;
REPEAT
c := upcase( ReadKey ) ;
UNTIL c IN ['S', 'O', 'T', 'E', 'D', 'C', 'Q'] ;
WRITELN( c ) ;
CASE c OF
'S' : SetParams ;
'O' : OpenPort ;
'T' : TermTest ;
'E' : EnablePort ;
'D' : DisablePort ;
'C' : ClosePort ;
'Q' : State := Exitting
END ; { CASE }
UNTIL State = Exitting ;
IF Open THEN BEGIN
WRITELN( 'Closing async' ) ;
Async_Close
END
END { TTYDG } .


  3 Responses to “Category : Pascal Source Code
Archive   : ASYNC41.ZIP
Filename : TTY.PAS

  1. Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!

  2. This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.

  3. But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/