mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-04 14:59:37 +01:00
168 lines
4.2 KiB
ObjectPascal
168 lines
4.2 KiB
ObjectPascal
program Terminal_test;
|
|
{******************************************************************************
|
|
* Really really budget attempt at Serial IO with Linux and FPC.
|
|
* My first FPC program. Re-built and refined on 12/6/99
|
|
* Written under X windows with nedit 5.0.2 (Not a bad editor)
|
|
* This SHOULD work without including the CRT Unit, However it has problems
|
|
* With reading from the keyboard unless the CRT unit is included ?!?
|
|
*
|
|
* Designed to talk to an RS485 Buss, using RTS as the Tx/Rx Select Pin
|
|
* No Copyrights or warrantys.
|
|
* Let me know if it's of some use to you.
|
|
* Brad Campbell (bcampbel@omen.net.au)
|
|
******************************************************************************}
|
|
uses Linux, Crt;
|
|
|
|
Const DTR : Cardinal = TIOCM_DTR;
|
|
Const RTS : Cardinal = TIOCM_RTS;
|
|
|
|
Var FD : Longint;
|
|
InChr : String[1];
|
|
InStr : String[80];
|
|
Quit : Boolean;
|
|
InLen, Loop : Integer;
|
|
tios : Termios;
|
|
fds : FDSet;
|
|
|
|
|
|
Procedure DumpFlags;
|
|
begin
|
|
IOCtl(FD,TIOCMGET,@tios);
|
|
Writeln('Input Flags : $',hexstr(tios.c_iflag,8));
|
|
Writeln('Output Flags : $',hexstr(tios.c_oflag,8));
|
|
Writeln('Local Flags : $',hexstr(tios.c_lflag,8));
|
|
Writeln('Control Flags : $',hexstr(tios.c_cflag,8));
|
|
End;
|
|
|
|
|
|
Procedure RS485RX;
|
|
Begin
|
|
IOCtl(FD,TIOCMBIS,@RTS);
|
|
End;
|
|
|
|
Procedure RS485TX;
|
|
Begin
|
|
IOCtl(FD,TIOCMBIC,@RTS);
|
|
End;
|
|
|
|
|
|
Procedure DtrOn;
|
|
Begin
|
|
IOCtl(FD,TIOCMBIS,@DTR);
|
|
End;
|
|
|
|
Procedure DtrOff;
|
|
Begin
|
|
IOCtl(FD,TIOCMBIC,@DTR);
|
|
End;
|
|
|
|
Procedure SendToRemote(OutString : String);
|
|
Begin
|
|
Rs485TX; {Switch Buss to Transmit}
|
|
if fdWrite(FD,OutString[1],Length(OutString)) <> Length(OutString) then
|
|
Writeln('Write Error');
|
|
{Write(OutString);} {Uncomment for Local Echo}
|
|
TCDrain(FD); {Block Program until all data sent out port has left UART}
|
|
RS485RX; {Switch Buss back to Recieve}
|
|
End;
|
|
|
|
|
|
{ Not limited to baud selection I have here, it's just all I use }
|
|
Procedure SetBaudrate;
|
|
Var NewBaud : LongInt;
|
|
Begin
|
|
Writeln;
|
|
Writeln('New Baud Rate (300,1200,2400,4800, 9600,19200,38400) ? ');
|
|
Readln(NewBaud);
|
|
Case NewBaud of
|
|
300 : NewBaud := B300;
|
|
1200 : NewBaud := B1200;
|
|
2400 : NewBaud := B2400;
|
|
4800 : NewBaud := B4800;
|
|
9600 : NewBaud := B9600;
|
|
19200 : NewBaud := B19200;
|
|
38400 : NewBaud := B38400;
|
|
Else
|
|
Begin
|
|
Writeln('Invalid Baud Rate. Baud not Changed');
|
|
Writeln;
|
|
NewBaud := 0;
|
|
End;
|
|
End;
|
|
|
|
{ Sets Baud Rate Here }
|
|
If NewBaud <> 0 then
|
|
Begin
|
|
IOCtl(FD,TCGETS,@tios); {Get IOCTL TermIOS Settings}
|
|
CFSetOSpeed(tios,NewBaud); {Set Relevant Bits}
|
|
IOCtl(FD,TCSETS,@tios); {Put them back with IOCTL}
|
|
Writeln('New Baudrate ',HexStr(NewBaud,2),' Set');
|
|
{This line just prints what the constant equates to for
|
|
Information Only}
|
|
End;
|
|
End;
|
|
|
|
|
|
Begin
|
|
Quit := False;
|
|
Writeln('Brad''s Dumb Terminal Test prog v0.2');
|
|
Writeln('Ctrl-C to exit program');
|
|
Writeln('Ctrl-D to set Baud Rate');
|
|
Writeln('Uses /dev/ttyS0 (Com 1)');
|
|
Writeln;
|
|
|
|
FD:=fdOpen('/dev/ttyS0',Open_RdWr or Open_NonBlock or Open_Excl);
|
|
{Open Port Read/Write, Not Blocking and Exclusive}
|
|
|
|
if FD > 0 then Begin
|
|
|
|
Writeln('Port Open');
|
|
|
|
FLock(FD,LOCK_EX);
|
|
{Attempt to Lock the port, I'm not sure this is strictly nessecary}
|
|
|
|
Writeln('Port Locked');
|
|
|
|
{Set Comms Parms, 9600 Baud, 8 Data Bits, Reciever Enabled,
|
|
Modem Control Lines Ignored}
|
|
{Read man 3 termios for More options}
|
|
|
|
IOCtl(FD,TCGETS,@tios);
|
|
tios.c_cflag := B9600 Or CS8 Or CREAD Or CLOCAL;
|
|
tios.c_lflag := 0;
|
|
tios.c_oflag := 0;
|
|
tios.c_iflag := 0;
|
|
IOCtl(FD,TCSETS,@tios);
|
|
|
|
DumpFlags; {This is for information only and dumps the contents of
|
|
the Termios registers}
|
|
|
|
Repeat
|
|
FD_Zero (FDS); {Clear File Descriptors Array}
|
|
FD_Set (0,FDS); {Input from Keyboard}
|
|
FD_SET (FD,FDS); {Input from Serial Port}
|
|
|
|
Select(FD+1,@FDS,nil,nil,nil); {Will Wait for input from above}
|
|
|
|
If FD_ISSET(0,FDS) then {Has there been a key pressed ?}
|
|
If fdRead(0,InChr[1],80) <> 0 then
|
|
Begin
|
|
if InChr[1] = Chr(3) then Quit := True;
|
|
if InChr[1] = Chr(4) then SetBaudRate;
|
|
SendToRemote(InChr[1]);
|
|
End;
|
|
|
|
If FD_ISSET(FD,FDS) then {Have we data waiting in UART ? }
|
|
Begin
|
|
InLen := fdRead(FD,InStr[1],80);
|
|
If InLen > 0 then
|
|
For Loop := 1 to Inlen do
|
|
Write(InStr[Loop]);
|
|
End;
|
|
Until Quit = True; {Were Outa Here}
|
|
FLock(FD,LOCK_UN); {Unlock Port}
|
|
fdClose(FD); {Close Port}
|
|
End
|
|
Else Writeln('Open Port Error'); {We failed to Open/Lock the UART}
|
|
End.
|