mirror of
https://gitlab.com/freepascal.org/fpc/source.git
synced 2025-11-02 10:09:35 +01:00
+ Donated by Brad Campbell
This commit is contained in:
parent
3a0c0fb5ac
commit
7415e61f02
167
docs/linuxex/serial.pp
Normal file
167
docs/linuxex/serial.pp
Normal file
@ -0,0 +1,167 @@
|
||||
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.
|
||||
Loading…
Reference in New Issue
Block a user