← Back to branch summary

~ubuntu-branches/ubuntu/dapper/fpc/dapper

« back to all changes in this revision

Viewing changes to docs/linuxex/serial.pp

  • Committer: Bazaar Package Importer
  • Author(s): Carlos Laviola
  • Date: 2005-05-30 11:59:10 UTC
  • mfrom: (1.2.2 upstream)
  • Revision ID: james.westby@ubuntu.com-20050530115910-x5pbzm4qqta4i94h
Tags: 2.0.0-2
http://bugs.debian.org/310907
debian/fp-compiler.postinst.in: forgot to reapply the patch that
correctly creates the slave link to pc(1).  (Closes: #310907)

Show diffs side-by-side

added added

removed removed

Lines of Context:
docs/linuxex/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 Linux, 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.