← Back to branch summary

~ubuntu-branches/ubuntu/feisty/fpc/feisty

« back to all changes in this revision

Viewing changes to fpcdocs/olinuxex/serial.pp

  • Committer: Bazaar Package Importer
  • Author(s): Torsten Werner
  • Date: 2007-01-27 20:08:50 UTC
  • mfrom: (1.2.3 upstream)
  • Revision ID: james.westby@ubuntu.com-20070127200850-9mrptaqqjsx9nwa7
Tags: 2.0.4-5
* Fixed Build-Depends.
* Add myself to Uploaders in debian/control.
* Make sure that the sources are really patched before building them.
* Build unit 'libc' on powerpc too.

Show diffs side-by-side

added added

removed removed

Lines of Context:
fpcdocs/olinuxex/serial.pp
 
1
program Terminal_test;
 
2
{******************************************************************************
 
3
 * Really really budget attempt at Serial IO with Linux and FPC.
 
4
 * My first FPC program. Re-built and refined on 12/6/99
 
5
 * Written under X windows with nedit 5.0.2 (Not a bad editor)
 
6
 * This SHOULD work without including the CRT Unit, However it has problems
 
7
 * With reading from the keyboard unless the CRT unit is included ?!?
 
8
 *
 
9
 * Designed to talk to an RS485 Buss, using RTS as the Tx/Rx Select Pin
 
10
 * No Copyrights or warrantys.
 
11
 * Let me know if it's of some use to you.
 
12
 * Brad Campbell (bcampbel@omen.net.au)
 
13
 ******************************************************************************}
 
14
uses oldlinux, Crt;
 
15
 
 
16
Const DTR : Cardinal = TIOCM_DTR;
 
17
Const RTS : Cardinal = TIOCM_RTS;
 
18
 
 
19
Var     FD              : Longint;
 
20
        InChr           : String[1];
 
21
        InStr           : String[80];
 
22
        Quit            : Boolean;
 
23
        InLen, Loop     : Integer;
 
24
        tios            : Termios;
 
25
        fds             : FDSet;
 
26
 
 
27
 
 
28
Procedure DumpFlags;
 
29
begin
 
30
IOCtl(FD,TIOCMGET,@tios);
 
31
Writeln('Input   Flags    : $',hexstr(tios.c_iflag,8));
 
32
Writeln('Output  Flags    : $',hexstr(tios.c_oflag,8));
 
33
Writeln('Local   Flags    : $',hexstr(tios.c_lflag,8));
 
34
Writeln('Control Flags    : $',hexstr(tios.c_cflag,8));
 
35
End;
 
36
 
 
37
 
 
38
Procedure RS485RX;
 
39
Begin
 
40
IOCtl(FD,TIOCMBIS,@RTS);
 
41
End;
 
42
 
 
43
Procedure RS485TX;
 
44
Begin
 
45
IOCtl(FD,TIOCMBIC,@RTS);
 
46
End;
 
47
 
 
48
 
 
49
Procedure DtrOn;
 
50
Begin
 
51
IOCtl(FD,TIOCMBIS,@DTR);
 
52
End;
 
53
 
 
54
Procedure DtrOff;
 
55
Begin
 
56
IOCtl(FD,TIOCMBIC,@DTR);
 
57
End;
 
58
 
 
59
Procedure SendToRemote(OutString : String);
 
60
Begin
 
61
Rs485TX;        {Switch Buss to Transmit}
 
62
if fdWrite(FD,OutString[1],Length(OutString)) <> Length(OutString) then
 
63
        Writeln('Write Error');
 
64
{Write(OutString);} {Uncomment for Local Echo}
 
65
TCDrain(FD);    {Block Program until all data sent out port has left UART}
 
66
RS485RX;        {Switch Buss back to Recieve}
 
67
End;
 
68
 
 
69
 
 
70
{ Not limited to baud selection I have here, it's just all I use }
 
71
Procedure SetBaudrate;
 
72
Var     NewBaud : LongInt;
 
73
Begin
 
74
Writeln;
 
75
Writeln('New Baud Rate (300,1200,2400,4800, 9600,19200,38400) ? ');
 
76
Readln(NewBaud);
 
77
Case NewBaud of
 
78
   300 : NewBaud := B300;
 
79
  1200 : NewBaud := B1200;
 
80
  2400 : NewBaud := B2400;
 
81
  4800 : NewBaud := B4800;
 
82
  9600 : NewBaud := B9600;
 
83
 19200 : NewBaud := B19200;
 
84
 38400 : NewBaud := B38400;
 
85
Else
 
86
        Begin
 
87
        Writeln('Invalid Baud Rate. Baud not Changed');
 
88
        Writeln;
 
89
        NewBaud := 0;
 
90
        End;
 
91
End;
 
92
 
 
93
{ Sets Baud Rate Here }
 
94
If NewBaud <> 0 then
 
95
        Begin
 
96
                IOCtl(FD,TCGETS,@tios);         {Get IOCTL TermIOS Settings}
 
97
                CFSetOSpeed(tios,NewBaud);      {Set Relevant Bits}
 
98
                IOCtl(FD,TCSETS,@tios);         {Put them back with IOCTL}
 
99
                Writeln('New Baudrate ',HexStr(NewBaud,2),' Set');
 
100
                {This line just prints what the constant equates to for
 
101
                 Information Only}
 
102
        End;
 
103
End;
 
104
 
 
105
 
 
106
Begin
 
107
Quit := False;
 
108
Writeln('Brad''s Dumb Terminal Test prog v0.2');
 
109
Writeln('Ctrl-C to exit program');
 
110
Writeln('Ctrl-D to set Baud Rate');
 
111
Writeln('Uses /dev/ttyS0 (Com 1)');
 
112
Writeln;
 
113
 
 
114
FD:=fdOpen('/dev/ttyS0',Open_RdWr or Open_NonBlock or Open_Excl);
 
115
{Open Port Read/Write, Not Blocking and Exclusive}
 
116
 
 
117
if FD > 0 then Begin
 
118
 
 
119
Writeln('Port Open');
 
120
 
 
121
FLock(FD,LOCK_EX);
 
122
{Attempt to Lock the port, I'm not sure this is strictly nessecary}
 
123
 
 
124
Writeln('Port Locked');
 
125
 
 
126
{Set Comms Parms, 9600 Baud, 8 Data Bits, Reciever Enabled,
 
127
 Modem Control Lines Ignored}
 
128
{Read man 3 termios for More options}
 
129
 
 
130
IOCtl(FD,TCGETS,@tios);
 
131
tios.c_cflag := B9600 Or CS8 Or CREAD Or CLOCAL;
 
132
tios.c_lflag := 0;
 
133
tios.c_oflag := 0;
 
134
tios.c_iflag := 0;
 
135
IOCtl(FD,TCSETS,@tios);
 
136
 
 
137
DumpFlags;      {This is for information only and dumps the contents of
 
138
                 the Termios registers}
 
139
 
 
140
Repeat
 
141
FD_Zero (FDS);          {Clear File Descriptors Array}
 
142
FD_Set (0,FDS);         {Input from Keyboard}
 
143
FD_SET (FD,FDS);        {Input from Serial Port}
 
144
 
 
145
Select(FD+1,@FDS,nil,nil,nil);  {Will Wait for input from above}
 
146
 
 
147
If FD_ISSET(0,FDS) then         {Has there been a key pressed ?}
 
148
        If fdRead(0,InChr[1],80) <> 0 then
 
149
                Begin
 
150
                if InChr[1] = Chr(3) then Quit := True;
 
151
                if InChr[1] = Chr(4) then SetBaudRate;
 
152
                SendToRemote(InChr[1]);
 
153
                End;
 
154
 
 
155
If FD_ISSET(FD,FDS) then        {Have we data waiting in UART ? }
 
156
        Begin
 
157
                InLen := fdRead(FD,InStr[1],80);
 
158
                If InLen > 0 then
 
159
                For Loop := 1 to Inlen do
 
160
                Write(InStr[Loop]);
 
161
        End;
 
162
Until Quit = True;      {Were Outa Here}
 
163
FLock(FD,LOCK_UN);      {Unlock Port}
 
164
fdClose(FD);            {Close Port}
 
165
End
 
166
Else Writeln('Open Port Error');        {We failed to Open/Lock the UART}
 
167
End.