Przeglądaj źródła

+ Donated by Brad Campbell

michael 26 lat temu
rodzic
commit
7415e61f02
1 zmienionych plików z 167 dodań i 0 usunięć
  1. 167 0
      docs/linuxex/serial.pp

+ 167 - 0
docs/linuxex/serial.pp

@@ -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 ([email protected])
+ ******************************************************************************}
+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.