line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Linux::Joystick; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
7759
|
use Fcntl; # for O_RDONLY, O_NONBLOCK |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
2650
|
|
4
|
|
|
|
|
|
|
|
5
|
|
|
|
|
|
|
### global vars (not exported) |
6
|
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
our $VERSION = "0.0.1"; |
8
|
|
|
|
|
|
|
|
9
|
|
|
|
|
|
|
# List of device node prefixes where we might expect to find |
10
|
|
|
|
|
|
|
# joystick devices, used for probing. |
11
|
|
|
|
|
|
|
our @devlist = qw(/dev/input/js /dev/js); |
12
|
|
|
|
|
|
|
|
13
|
|
|
|
|
|
|
### constructor |
14
|
|
|
|
|
|
|
|
15
|
|
|
|
|
|
|
sub new { |
16
|
0
|
|
|
0
|
0
|
|
my $proto = shift; |
17
|
0
|
|
0
|
|
|
|
my $class = ref $proto || $proto; |
18
|
0
|
|
|
|
|
|
my $self; |
19
|
|
|
|
|
|
|
|
20
|
0
|
0
|
|
|
|
|
if( @_ == 1 ) { # if only 1 arg, it's the device |
21
|
0
|
|
|
|
|
|
$self->{device} = shift; |
22
|
|
|
|
|
|
|
} else { |
23
|
0
|
|
|
|
|
|
$self = { # defaults: |
24
|
|
|
|
|
|
|
device => 0, |
25
|
|
|
|
|
|
|
threshold => 1000, |
26
|
|
|
|
|
|
|
nonblocking => 0, |
27
|
|
|
|
|
|
|
fh => undef, |
28
|
|
|
|
|
|
|
@_ # override defaults |
29
|
|
|
|
|
|
|
}; |
30
|
|
|
|
|
|
|
} |
31
|
|
|
|
|
|
|
|
32
|
0
|
|
|
|
|
|
bless $self, $class; |
33
|
|
|
|
|
|
|
|
34
|
0
|
0
|
|
|
|
|
$self->_open_fh unless $self->{fh}; |
35
|
0
|
0
|
|
|
|
|
$self->_init if $self->{fh}; |
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
# return undef if couldn't open the file |
38
|
0
|
0
|
|
|
|
|
return $self->{fh} ? $self : undef; |
39
|
|
|
|
|
|
|
} |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
### public static methods (aka class methods) |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
sub version { |
44
|
0
|
|
|
0
|
1
|
|
return $VERSION; |
45
|
|
|
|
|
|
|
} |
46
|
|
|
|
|
|
|
|
47
|
|
|
|
|
|
|
### public methods (aka instance methods) |
48
|
|
|
|
|
|
|
|
49
|
|
|
|
|
|
|
# read & discard all pending events. |
50
|
|
|
|
|
|
|
# adapted from `perldoc -f select' |
51
|
|
|
|
|
|
|
sub flushEvents { |
52
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
53
|
0
|
|
|
|
|
|
my $rin = ''; |
54
|
0
|
|
|
|
|
|
vec($rin, fileno($self->{fh}), 1) = 1; |
55
|
|
|
|
|
|
|
|
56
|
0
|
|
|
|
|
|
while(select($rin, undef, undef, 0.2)) { |
57
|
0
|
|
|
|
|
|
$self->_read_event; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
} |
60
|
|
|
|
|
|
|
|
61
|
|
|
|
|
|
|
# How many axes are there on the current device? |
62
|
|
|
|
|
|
|
sub axisCount { |
63
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
64
|
0
|
|
|
|
|
|
return $self->{axes}; |
65
|
|
|
|
|
|
|
} |
66
|
|
|
|
|
|
|
|
67
|
|
|
|
|
|
|
# How many `sticks' (axis pairs) are on the current device? |
68
|
|
|
|
|
|
|
sub stickCount { |
69
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
70
|
0
|
|
|
|
|
|
return $self->{axes} >> 1; |
71
|
|
|
|
|
|
|
} |
72
|
|
|
|
|
|
|
|
73
|
|
|
|
|
|
|
# How many buttons are on the current device? |
74
|
|
|
|
|
|
|
sub buttonCount { |
75
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
76
|
0
|
|
|
|
|
|
return $self->{buttons}; |
77
|
|
|
|
|
|
|
} |
78
|
|
|
|
|
|
|
|
79
|
|
|
|
|
|
|
# Get the most recent error message, if any. We don't use this |
80
|
|
|
|
|
|
|
# in the current version, but we might want to someday |
81
|
|
|
|
|
|
|
sub errorString { |
82
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
83
|
0
|
|
|
|
|
|
return $self->{errorstring}; |
84
|
|
|
|
|
|
|
} |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
# Get the path to the device node we're reading from. Returns |
87
|
|
|
|
|
|
|
# something like `/dev/input/js0'. |
88
|
|
|
|
|
|
|
sub device { |
89
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
90
|
0
|
|
|
|
|
|
return $self->{device}; |
91
|
|
|
|
|
|
|
} |
92
|
|
|
|
|
|
|
|
93
|
|
|
|
|
|
|
# Get the filehandle we're reading from. This is a public method, |
94
|
|
|
|
|
|
|
# but user code that does I/O on this filehandle is responsible |
95
|
|
|
|
|
|
|
# for maintaining sync with the driver (which means, only read it |
96
|
|
|
|
|
|
|
# in 8-byte chunks if you're going to read it at all). I provide |
97
|
|
|
|
|
|
|
# this method for people who know what they're doing... |
98
|
|
|
|
|
|
|
sub fileHandle { |
99
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
100
|
0
|
|
|
|
|
|
return $self->{fh}; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# Return the next event from the device, as a Linux::Joystick::Event. |
104
|
|
|
|
|
|
|
# In blocking (default) mode, this method will block. In non-blocking |
105
|
|
|
|
|
|
|
# mode, it will return either a valid event if one was ready, or |
106
|
|
|
|
|
|
|
# undef if not. |
107
|
|
|
|
|
|
|
sub nextEvent { |
108
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
109
|
|
|
|
|
|
|
|
110
|
0
|
|
|
|
|
|
$self->_read_event; |
111
|
0
|
|
|
|
|
|
return Linux::Joystick::Event->new($self); |
112
|
|
|
|
|
|
|
} |
113
|
|
|
|
|
|
|
|
114
|
|
|
|
|
|
|
# set blocking/nonblocking mode without reopening the device |
115
|
|
|
|
|
|
|
sub setNonblocking { |
116
|
0
|
|
|
0
|
1
|
|
my $self = shift; |
117
|
0
|
|
|
|
|
|
my $nonbl = shift; |
118
|
0
|
|
|
|
|
|
my $buf = ""; # unused by F_GETFL but required? |
119
|
|
|
|
|
|
|
|
120
|
0
|
|
|
|
|
|
my $mode = fcntl($self->{fh}, F_GETFL, $buf); |
121
|
|
|
|
|
|
|
|
122
|
0
|
0
|
|
|
|
|
if($nonbl) { |
123
|
0
|
|
|
|
|
|
$mode |= O_NONBLOCK; |
124
|
|
|
|
|
|
|
} else { |
125
|
0
|
|
|
|
|
|
$mode &= ~O_NONBLOCK; |
126
|
|
|
|
|
|
|
} |
127
|
|
|
|
|
|
|
|
128
|
0
|
|
|
|
|
|
fcntl($self->{fh}, F_SETFL, $mode); |
129
|
0
|
|
|
|
|
|
$self->{nonblocking} = $nonbl; |
130
|
|
|
|
|
|
|
} |
131
|
|
|
|
|
|
|
|
132
|
|
|
|
|
|
|
### private methods |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
# _init reads any & all init events and sets the values returned by |
135
|
|
|
|
|
|
|
# buttonCount and axisCount. It uses select() with a timeout |
136
|
|
|
|
|
|
|
# of 0.2 seconds, so there's a slight pause when it's called. |
137
|
|
|
|
|
|
|
sub _init { |
138
|
0
|
|
|
0
|
|
|
my $self = shift; |
139
|
|
|
|
|
|
|
|
140
|
0
|
|
|
|
|
|
my($max_axes, $max_buttons) = (0, 0); |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
# adapted from `perldoc -f select' |
143
|
0
|
|
|
|
|
|
my $rin = ''; |
144
|
0
|
|
|
|
|
|
vec($rin, fileno($self->{fh}), 1) = 1; |
145
|
|
|
|
|
|
|
|
146
|
|
|
|
|
|
|
# this ought to work in either blocking or non |
147
|
0
|
|
|
|
|
|
while(select($rin, undef, undef, 0.2)) { |
148
|
0
|
|
|
|
|
|
$self->_read_event; |
149
|
0
|
|
|
|
|
|
my $ev = Linux::Joystick::Event->new($self); |
150
|
0
|
0
|
|
|
|
|
if($ev->_isInit) { |
151
|
0
|
0
|
|
|
|
|
if($ev->isAxis) { |
152
|
0
|
0
|
|
|
|
|
$max_axes = ($ev->axis) if ($ev->axis) > $max_axes; |
153
|
|
|
|
|
|
|
} |
154
|
|
|
|
|
|
|
|
155
|
0
|
0
|
|
|
|
|
if($ev->isButton) { |
156
|
0
|
0
|
|
|
|
|
$max_buttons = ($ev->button) if ($ev->button) > $max_buttons; |
157
|
|
|
|
|
|
|
} |
158
|
|
|
|
|
|
|
# This happens a lot, but appears to be harmless: |
159
|
|
|
|
|
|
|
## } else { |
160
|
|
|
|
|
|
|
## warn "Got non-init event during initialization: " . $ev->hexDump; |
161
|
|
|
|
|
|
|
} |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
|
164
|
0
|
|
|
|
|
|
$self->{buttons} = $max_buttons + 1; |
165
|
0
|
|
|
|
|
|
$self->{axes} = $max_axes + 1; |
166
|
|
|
|
|
|
|
} |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
# private method, read one event. Events are 8 bytes on all |
169
|
|
|
|
|
|
|
# architectures, or should be because the struct js is defined |
170
|
|
|
|
|
|
|
# in terms of uint8/uint16/etc, not platform-dependent types |
171
|
|
|
|
|
|
|
# like int. |
172
|
|
|
|
|
|
|
sub _read_event { |
173
|
0
|
|
|
0
|
|
|
my $self = shift; |
174
|
|
|
|
|
|
|
|
175
|
0
|
|
|
|
|
|
my $got; |
176
|
|
|
|
|
|
|
|
177
|
0
|
|
|
|
|
|
my $ret = sysread $self->{fh}, $got, 8; |
178
|
0
|
|
|
|
|
|
$self->{rawevent} = $got; |
179
|
|
|
|
|
|
|
|
180
|
0
|
|
|
|
|
|
return $ret; |
181
|
|
|
|
|
|
|
} |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
# Figure out which device node to open, open it, and return a |
184
|
|
|
|
|
|
|
# perl filehandle to it (undef on error). |
185
|
|
|
|
|
|
|
sub _open_fh { |
186
|
0
|
|
|
0
|
|
|
my $self = shift; |
187
|
|
|
|
|
|
|
|
188
|
0
|
|
|
|
|
|
my $fh; |
189
|
|
|
|
|
|
|
|
190
|
|
|
|
|
|
|
my $realdevice; |
191
|
|
|
|
|
|
|
|
192
|
|
|
|
|
|
|
# if user-specified device path, use it |
193
|
0
|
0
|
|
|
|
|
if($self->{device} =~ /\D/) { |
194
|
0
|
|
|
|
|
|
$realdevice = $self->{device}; |
195
|
|
|
|
|
|
|
} else { # otherwise, search using the device number |
196
|
0
|
|
|
|
|
|
for(@devlist) { |
197
|
0
|
|
|
|
|
|
my $test = $_ . $self->{device}; |
198
|
0
|
0
|
|
|
|
|
($realdevice = $test), last if -r $test; |
199
|
|
|
|
|
|
|
} |
200
|
|
|
|
|
|
|
} |
201
|
|
|
|
|
|
|
|
202
|
|
|
|
|
|
|
# $realdevice contains the path we want to use |
203
|
|
|
|
|
|
|
# if open() fails, leave $self->{fh} as it was (undefined) |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
# used to do this... |
206
|
|
|
|
|
|
|
#$self->{fh} = $fh if open $fh, "<$realdevice"; |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
# now we do this, to support non-blocking I/O |
209
|
0
|
|
|
|
|
|
my $flags = O_RDONLY; |
210
|
0
|
0
|
|
|
|
|
$flags |= O_NONBLOCK if $self->{nonblocking}; |
211
|
0
|
0
|
|
|
|
|
if(sysopen $fh, "$realdevice", $flags) { |
212
|
0
|
|
|
|
|
|
$self->{fh} = $fh; |
213
|
0
|
|
|
|
|
|
$self->{device} = $realdevice; |
214
|
|
|
|
|
|
|
} |
215
|
|
|
|
|
|
|
} |
216
|
|
|
|
|
|
|
|
217
|
|
|
|
|
|
|
|
218
|
|
|
|
|
|
|
### end of Linux::Joystick |
219
|
|
|
|
|
|
|
|
220
|
|
|
|
|
|
|
package Linux::Joystick::Event; |
221
|
|
|
|
|
|
|
|
222
|
|
|
|
|
|
|
### constructor |
223
|
|
|
|
|
|
|
sub new { |
224
|
0
|
|
|
0
|
|
|
my $proto = shift; |
225
|
0
|
|
0
|
|
|
|
my $class = ref $proto || $proto; |
226
|
|
|
|
|
|
|
|
227
|
0
|
|
|
|
|
|
my $parent = shift; |
228
|
0
|
|
|
|
|
|
my $self = { |
229
|
|
|
|
|
|
|
data => $parent->{rawevent}, |
230
|
|
|
|
|
|
|
threshold => $parent->{threshold}, |
231
|
|
|
|
|
|
|
nonblocking => $parent->{nonblocking}, |
232
|
|
|
|
|
|
|
}; |
233
|
|
|
|
|
|
|
|
234
|
0
|
|
|
|
|
|
bless $self, $class; |
235
|
|
|
|
|
|
|
|
236
|
0
|
0
|
|
|
|
|
return ($self->_parse) ? $self : undef; |
237
|
|
|
|
|
|
|
} |
238
|
|
|
|
|
|
|
|
239
|
|
|
|
|
|
|
### public methods |
240
|
|
|
|
|
|
|
|
241
|
|
|
|
|
|
|
# returns hex string of raw data bytes. |
242
|
|
|
|
|
|
|
sub hexDump { |
243
|
0
|
|
|
0
|
|
|
my $self = shift; |
244
|
|
|
|
|
|
|
|
245
|
0
|
|
|
|
|
|
return join(" ", unpack("H8", $self->{data})); |
246
|
|
|
|
|
|
|
} |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
# get timestamp. User code might use this to detect doubleclicks |
249
|
|
|
|
|
|
|
# of the buttons. |
250
|
|
|
|
|
|
|
sub timeStamp { |
251
|
0
|
|
|
0
|
|
|
my $self = shift; |
252
|
0
|
|
|
|
|
|
return $self->{stamp}; |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
|
255
|
|
|
|
|
|
|
# Which axis caused this event? |
256
|
|
|
|
|
|
|
# undef for non-axis events. |
257
|
|
|
|
|
|
|
sub axis { |
258
|
0
|
|
|
0
|
|
|
my $self = shift; |
259
|
0
|
|
|
|
|
|
return $self->{axis}; |
260
|
|
|
|
|
|
|
} |
261
|
|
|
|
|
|
|
|
262
|
|
|
|
|
|
|
# Which `stick' (axis pair) caused this event? See the explanation |
263
|
|
|
|
|
|
|
# of sticks in the pod. |
264
|
|
|
|
|
|
|
# undef for non-axis events. |
265
|
|
|
|
|
|
|
sub stick { |
266
|
0
|
|
|
0
|
|
|
my $self = shift; |
267
|
0
|
|
|
|
|
|
return $self->{axis} >> 1; |
268
|
|
|
|
|
|
|
} |
269
|
|
|
|
|
|
|
|
270
|
|
|
|
|
|
|
# Which button caused this event? |
271
|
|
|
|
|
|
|
# undef for non-button events. |
272
|
|
|
|
|
|
|
sub button { |
273
|
0
|
|
|
0
|
|
|
my $self = shift; |
274
|
0
|
|
|
|
|
|
return $self->{button}; |
275
|
|
|
|
|
|
|
} |
276
|
|
|
|
|
|
|
|
277
|
|
|
|
|
|
|
# boolean: is this an axis event? |
278
|
|
|
|
|
|
|
sub isAxis { |
279
|
0
|
|
|
0
|
|
|
my $self = shift; |
280
|
0
|
|
|
|
|
|
return defined($self->{axis}); |
281
|
|
|
|
|
|
|
} |
282
|
|
|
|
|
|
|
|
283
|
|
|
|
|
|
|
# boolean: is this a button event? |
284
|
|
|
|
|
|
|
sub isButton { |
285
|
0
|
|
|
0
|
|
|
my $self = shift; |
286
|
0
|
|
|
|
|
|
return defined($self->{button}); |
287
|
|
|
|
|
|
|
} |
288
|
|
|
|
|
|
|
|
289
|
|
|
|
|
|
|
# Return human-readable string version of the |
290
|
|
|
|
|
|
|
# event type. Probably best used for debugging. |
291
|
|
|
|
|
|
|
sub type { |
292
|
0
|
|
|
0
|
|
|
my $self = shift; |
293
|
0
|
0
|
|
|
|
|
return "BUTTON" if defined($self->{button}); |
294
|
0
|
0
|
|
|
|
|
return "AXIS" if defined($self->{axis}); |
295
|
0
|
|
|
|
|
|
return "UNKNOWN"; |
296
|
|
|
|
|
|
|
} |
297
|
|
|
|
|
|
|
|
298
|
|
|
|
|
|
|
# Return the value of the current axis, for axis events, or undef |
299
|
|
|
|
|
|
|
# for non-axis. Generally ranges from -32768 to 32767. |
300
|
|
|
|
|
|
|
sub axisValue { |
301
|
0
|
|
|
0
|
|
|
my $self = shift; |
302
|
0
|
0
|
|
|
|
|
if($self->isAxis) { |
303
|
0
|
|
|
|
|
|
return $self->{value}; |
304
|
|
|
|
|
|
|
} else { |
305
|
0
|
|
|
|
|
|
return undef; |
306
|
|
|
|
|
|
|
} |
307
|
|
|
|
|
|
|
} |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
# boolean: Was the stick moved left? |
310
|
|
|
|
|
|
|
sub stickLeft { |
311
|
0
|
|
|
0
|
|
|
my $self = shift; |
312
|
0
|
|
|
|
|
|
my $stick = shift; # may be undef |
313
|
|
|
|
|
|
|
|
314
|
0
|
|
|
0
|
|
|
return $self->_decodeAxis($stick, 0, sub { $self->{value} <= -$self->{threshold} }); |
|
0
|
|
|
|
|
|
|
315
|
|
|
|
|
|
|
} |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
# boolean: Was the stick moved up? |
318
|
|
|
|
|
|
|
sub stickUp { |
319
|
0
|
|
|
0
|
|
|
my $self = shift; |
320
|
0
|
|
|
|
|
|
my $stick = shift; # may be undef |
321
|
|
|
|
|
|
|
|
322
|
0
|
|
|
0
|
|
|
return $self->_decodeAxis($stick, 1, sub { $self->{value} <= -$self->{threshold} }); |
|
0
|
|
|
|
|
|
|
323
|
|
|
|
|
|
|
} |
324
|
|
|
|
|
|
|
|
325
|
|
|
|
|
|
|
# boolean: Was the stick moved right? |
326
|
|
|
|
|
|
|
sub stickRight { |
327
|
0
|
|
|
0
|
|
|
my $self = shift; |
328
|
0
|
|
|
|
|
|
my $stick = shift; # may be undef |
329
|
|
|
|
|
|
|
|
330
|
0
|
|
|
0
|
|
|
return $self->_decodeAxis($stick, 0, sub { $self->{value} >= $self->{threshold} }); |
|
0
|
|
|
|
|
|
|
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
# boolean: Was the stick moved down? |
334
|
|
|
|
|
|
|
sub stickDown { |
335
|
0
|
|
|
0
|
|
|
my $self = shift; |
336
|
0
|
|
|
|
|
|
my $stick = shift; # may be undef |
337
|
|
|
|
|
|
|
|
338
|
0
|
|
|
0
|
|
|
return $self->_decodeAxis($stick, 1, sub { $self->{value} >= $self->{threshold} }); |
|
0
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
} |
340
|
|
|
|
|
|
|
|
341
|
|
|
|
|
|
|
# boolean: was a button pressed? |
342
|
|
|
|
|
|
|
sub buttonDown { |
343
|
0
|
|
|
0
|
|
|
my $self = shift; |
344
|
0
|
|
|
|
|
|
my $but = shift; |
345
|
|
|
|
|
|
|
|
346
|
0
|
0
|
|
|
|
|
if(defined($self->{button})) { |
347
|
0
|
0
|
|
|
|
|
if(defined $but) { |
348
|
0
|
|
0
|
|
|
|
return ($self->{number} == $but) && $self->{value}; |
349
|
|
|
|
|
|
|
} else { |
350
|
0
|
|
|
|
|
|
return $self->{value}; |
351
|
|
|
|
|
|
|
} |
352
|
|
|
|
|
|
|
} else { |
353
|
0
|
|
|
|
|
|
return undef; |
354
|
|
|
|
|
|
|
} |
355
|
|
|
|
|
|
|
} |
356
|
|
|
|
|
|
|
|
357
|
|
|
|
|
|
|
# boolean: was a button released? |
358
|
|
|
|
|
|
|
sub buttonUp { |
359
|
0
|
|
|
0
|
|
|
my $self = shift; |
360
|
0
|
|
|
|
|
|
my $but = shift; |
361
|
|
|
|
|
|
|
|
362
|
0
|
0
|
|
|
|
|
if(defined($self->{button})) { |
363
|
0
|
0
|
|
|
|
|
if(defined $but) { |
364
|
0
|
|
0
|
|
|
|
return ($self->{number} == $but) && (!$self->{value}); |
365
|
|
|
|
|
|
|
} else { |
366
|
0
|
|
|
|
|
|
return !$self->{value}; |
367
|
|
|
|
|
|
|
} |
368
|
|
|
|
|
|
|
} else { |
369
|
0
|
|
|
|
|
|
return undef; |
370
|
|
|
|
|
|
|
} |
371
|
|
|
|
|
|
|
} |
372
|
|
|
|
|
|
|
|
373
|
|
|
|
|
|
|
### private methods |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
# private method. unpacks the raw data, stores as hash elements |
376
|
|
|
|
|
|
|
# in %$self. Most user programs won't directly access the hash |
377
|
|
|
|
|
|
|
# elements; they'll use the accessor methods (e.g. button() and |
378
|
|
|
|
|
|
|
# friends). |
379
|
|
|
|
|
|
|
sub _parse { |
380
|
0
|
|
|
0
|
|
|
my $self = shift; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
# return undef if no event was ready |
383
|
|
|
|
|
|
|
# (under what circumstances does this ever happen?) |
384
|
0
|
0
|
|
|
|
|
if(not defined $self->{data}) { |
385
|
0
|
|
|
|
|
|
return undef; |
386
|
|
|
|
|
|
|
} |
387
|
|
|
|
|
|
|
|
388
|
|
|
|
|
|
|
# do not spew `data length is 0' warnings in nonblocking mode. |
389
|
0
|
0
|
0
|
|
|
|
if( ($self->{nonblocking}) && (length($self->{data}) == 0)) { |
390
|
0
|
|
|
|
|
|
return undef; |
391
|
|
|
|
|
|
|
} |
392
|
|
|
|
|
|
|
|
393
|
0
|
0
|
|
|
|
|
if(length($self->{data}) != 8) { |
394
|
0
|
|
|
|
|
|
warn "event data length is " . length($self->{data}) . ", not 8!"; |
395
|
0
|
|
|
|
|
|
return undef; |
396
|
|
|
|
|
|
|
} |
397
|
|
|
|
|
|
|
|
398
|
0
|
|
|
|
|
|
my @got = unpack("LsCC", $self->{data}); |
399
|
0
|
|
|
|
|
|
$self->{stamp} = $got[0]; |
400
|
0
|
|
|
|
|
|
$self->{value} = $got[1]; |
401
|
0
|
|
|
|
|
|
$self->{type} = $got[2]; |
402
|
0
|
|
|
|
|
|
$self->{number} = $got[3]; |
403
|
|
|
|
|
|
|
|
404
|
0
|
0
|
|
|
|
|
if($self->{type} & 0x02) { |
405
|
0
|
|
|
|
|
|
$self->{axis} = $self->{number}; |
406
|
|
|
|
|
|
|
} |
407
|
|
|
|
|
|
|
|
408
|
0
|
0
|
|
|
|
|
if($self->{type} & 0x01) { |
409
|
0
|
|
|
|
|
|
$self->{button} = $self->{number}; |
410
|
|
|
|
|
|
|
} |
411
|
|
|
|
|
|
|
|
412
|
|
|
|
|
|
|
# paranoia: |
413
|
0
|
0
|
|
|
|
|
if(($self->{type} & 0x03) == 3) { |
414
|
0
|
|
|
|
|
|
warn "event is both axis and button, how did this happen?" . $self->hexDump; |
415
|
|
|
|
|
|
|
} |
416
|
|
|
|
|
|
|
|
417
|
0
|
|
|
|
|
|
return 1; |
418
|
|
|
|
|
|
|
} |
419
|
|
|
|
|
|
|
|
420
|
|
|
|
|
|
|
# private method, boolean: is this a synthetic init event (true), or a |
421
|
|
|
|
|
|
|
# real one (false) |
422
|
|
|
|
|
|
|
sub _isInit { |
423
|
0
|
|
|
0
|
|
|
my $self = shift; |
424
|
|
|
|
|
|
|
|
425
|
0
|
|
|
|
|
|
return $self->{type} & 0x80; |
426
|
|
|
|
|
|
|
} |
427
|
|
|
|
|
|
|
|
428
|
|
|
|
|
|
|
# private method, figures out whether the requested axis is moved |
429
|
|
|
|
|
|
|
# in the given direction. Used by stickLeft/Right/Up/Down. |
430
|
|
|
|
|
|
|
sub _decodeAxis { |
431
|
0
|
|
|
0
|
|
|
my $self = shift; |
432
|
0
|
|
|
|
|
|
my $stick = shift; |
433
|
|
|
|
|
|
|
|
434
|
0
|
0
|
|
|
|
|
return undef unless $self->isAxis; |
435
|
0
|
|
|
|
|
|
my $evenOdd = shift; |
436
|
0
|
|
|
|
|
|
my $compFunc = shift; |
437
|
|
|
|
|
|
|
|
438
|
0
|
0
|
|
|
|
|
if(defined $stick) { |
439
|
0
|
0
|
|
|
|
|
return undef unless ($self->axis) >> 1 == $stick; |
440
|
|
|
|
|
|
|
} |
441
|
|
|
|
|
|
|
|
442
|
0
|
0
|
|
|
|
|
if($self->axis % 2 == $evenOdd) { |
443
|
0
|
0
|
|
|
|
|
return 1 if $compFunc->(); |
444
|
0
|
|
|
|
|
|
return 0; |
445
|
|
|
|
|
|
|
} |
446
|
|
|
|
|
|
|
|
447
|
0
|
|
|
|
|
|
return undef; |
448
|
|
|
|
|
|
|
} |
449
|
|
|
|
|
|
|
|
450
|
|
|
|
|
|
|
|
451
|
|
|
|
|
|
|
# End of Linux::Joystick::Event |
452
|
|
|
|
|
|
|
|
453
|
|
|
|
|
|
|
=pod |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=head1 INTRODUCTION |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
|
458
|
|
|
|
|
|
|
Linux::Joystick is an object-oriented, pure Perl API for accessing |
459
|
|
|
|
|
|
|
joystick devices under Linux-based operating systems. It is capable |
460
|
|
|
|
|
|
|
of using either blocking or non-blocking I/O, and represents each axis |
461
|
|
|
|
|
|
|
change or button press as a Linux::Joystick::Event object. |
462
|
|
|
|
|
|
|
|
463
|
|
|
|
|
|
|
=head1 USAGE |
464
|
|
|
|
|
|
|
|
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
If you want your application to be driven by joystick events, |
467
|
|
|
|
|
|
|
use blocking I/O and an event loop: |
468
|
|
|
|
|
|
|
|
469
|
|
|
|
|
|
|
use Linux::Joystick; |
470
|
|
|
|
|
|
|
|
471
|
|
|
|
|
|
|
my $js = new Linux::Joystick; |
472
|
|
|
|
|
|
|
my $event; |
473
|
|
|
|
|
|
|
|
474
|
|
|
|
|
|
|
print "Joystick has " . $js->buttonCount() . " buttons ". |
475
|
|
|
|
|
|
|
"and " . $js->axisCount() . " axes.\n"; |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
# blocking reads: |
478
|
|
|
|
|
|
|
while( $event = $js->nextEvent ) { |
479
|
|
|
|
|
|
|
|
480
|
|
|
|
|
|
|
print "Event type: " . $event->type . ", "; |
481
|
|
|
|
|
|
|
if($event->isButton) { |
482
|
|
|
|
|
|
|
print "Button " . $event->button; |
483
|
|
|
|
|
|
|
if($event->buttonDown) { |
484
|
|
|
|
|
|
|
print " pressed"; |
485
|
|
|
|
|
|
|
} else { |
486
|
|
|
|
|
|
|
print " released"; |
487
|
|
|
|
|
|
|
} |
488
|
|
|
|
|
|
|
} elsif($event->isAxis) { |
489
|
|
|
|
|
|
|
print "Axis " . $event->axis . ", value " . $event->axisValue . ", "; |
490
|
|
|
|
|
|
|
print "UP" if $event->stickUp; |
491
|
|
|
|
|
|
|
print "DOWN" if $event->stickDown; |
492
|
|
|
|
|
|
|
print "LEFT" if $event->stickLeft; |
493
|
|
|
|
|
|
|
print "RIGHT" if $event->stickRight; |
494
|
|
|
|
|
|
|
} else { # should never happen |
495
|
|
|
|
|
|
|
print "Unknown event " . $event->hexDump; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
print "\n"; |
499
|
|
|
|
|
|
|
} |
500
|
|
|
|
|
|
|
|
501
|
|
|
|
|
|
|
# if the while loop terminates, we got a false (undefined) event: |
502
|
|
|
|
|
|
|
die "Error reading joystick: " . $js->errorString; |
503
|
|
|
|
|
|
|
|
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
You can also use non-blocking I/O, in which case nextEvent() returning |
506
|
|
|
|
|
|
|
undef just means there was no event to read: |
507
|
|
|
|
|
|
|
|
508
|
|
|
|
|
|
|
my $js = Linux::Joystick->new(nonblocking => 1); |
509
|
|
|
|
|
|
|
# use this to open 2nd joystick in nonblocking mode instead: |
510
|
|
|
|
|
|
|
# my $js = Linux::Joystick->new(device => 1, nonblocking => 1); |
511
|
|
|
|
|
|
|
|
512
|
|
|
|
|
|
|
while(1) { |
513
|
|
|
|
|
|
|
my $event = $js->nextEvent; |
514
|
|
|
|
|
|
|
|
515
|
|
|
|
|
|
|
if($event) { |
516
|
|
|
|
|
|
|
print "Got a joystick event\n"; |
517
|
|
|
|
|
|
|
# process the event here |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
# Do other processing here (graphics, sound, I/O, calculation) |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
} |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
It is possible to switch between blocking and non-blocking I/O without |
525
|
|
|
|
|
|
|
reopening the device (see the setNonblocking() method, below). |
526
|
|
|
|
|
|
|
|
527
|
|
|
|
|
|
|
=head1 CONSTRUCTORS |
528
|
|
|
|
|
|
|
|
529
|
|
|
|
|
|
|
|
530
|
|
|
|
|
|
|
Create a new Linux::Joystick object using the default joystick device |
531
|
|
|
|
|
|
|
(usually the first on the system): |
532
|
|
|
|
|
|
|
|
533
|
|
|
|
|
|
|
my $js = Linux::Joystick->new; # Default device, same as new(0) |
534
|
|
|
|
|
|
|
|
535
|
|
|
|
|
|
|
Same as above, but for a specific joystick (numbered starting with 0): |
536
|
|
|
|
|
|
|
|
537
|
|
|
|
|
|
|
# Default device (first joystick) |
538
|
|
|
|
|
|
|
my $js = Linux::Joystick->new(0); |
539
|
|
|
|
|
|
|
my $js = Linux::Joystick->new(device => 0); # same thing |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
# Second joystick (player 2?) |
542
|
|
|
|
|
|
|
my $js = Linux::Joystick->new(1); |
543
|
|
|
|
|
|
|
my $js = Linux::Joystick->new(device => 1); # same thing |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
By default, we search for joystick devices by prepending the string |
546
|
|
|
|
|
|
|
B to the device number, then falling back to B |
547
|
|
|
|
|
|
|
if that fails. Most modern Linux systems will have B as a |
548
|
|
|
|
|
|
|
symlink to B anyway. |
549
|
|
|
|
|
|
|
|
550
|
|
|
|
|
|
|
If you need to, you can also use a constructor like this: |
551
|
|
|
|
|
|
|
|
552
|
|
|
|
|
|
|
my $js = Linux::Joystick->new("/dev/js0"); |
553
|
|
|
|
|
|
|
my $js = Linux::Joystick->new(device => "/dev/js0"); # same thing |
554
|
|
|
|
|
|
|
|
555
|
|
|
|
|
|
|
...but this practice isn't recommended: if next year Red Hat decides |
556
|
|
|
|
|
|
|
to call their joystick device B, I (or someone) |
557
|
|
|
|
|
|
|
will update this Perl module to reflect that fact, and your perl scripts |
558
|
|
|
|
|
|
|
that use the numeric form will continue to work. |
559
|
|
|
|
|
|
|
|
560
|
|
|
|
|
|
|
Any of these constructors will return undef on failure. The $! variable |
561
|
|
|
|
|
|
|
might or might not contain a useful error message. Possible failure |
562
|
|
|
|
|
|
|
reasons include the usual suspects (no joystick plugged in, no driver |
563
|
|
|
|
|
|
|
loaded, no permission to read from the device node, cat chewed through |
564
|
|
|
|
|
|
|
the USB cable, etc). |
565
|
|
|
|
|
|
|
|
566
|
|
|
|
|
|
|
Creating multiple Linux::Joystick objects that read from the same device |
567
|
|
|
|
|
|
|
results in undefined behaviour, primarily because I haven't tested it, |
568
|
|
|
|
|
|
|
so I can't define it yet... but it's probably not a good idea (what |
569
|
|
|
|
|
|
|
happens will probably be dependent on what kernel version and kernel |
570
|
|
|
|
|
|
|
joystick driver you happen to be using). |
571
|
|
|
|
|
|
|
|
572
|
|
|
|
|
|
|
=head2 Constructor parameters |
573
|
|
|
|
|
|
|
|
574
|
|
|
|
|
|
|
|
575
|
|
|
|
|
|
|
The Linux::Joystick contructor uses named parameters, in the same way |
576
|
|
|
|
|
|
|
that IO::Socket and many other Perl modules do. Here is a constructor |
577
|
|
|
|
|
|
|
that sets all possible values to their defaults: |
578
|
|
|
|
|
|
|
|
579
|
|
|
|
|
|
|
# The following is exactly equivalent to just using |
580
|
|
|
|
|
|
|
# new() with no arguments: |
581
|
|
|
|
|
|
|
my $js = Linux::Joystick->new( |
582
|
|
|
|
|
|
|
device => 0, |
583
|
|
|
|
|
|
|
threshold => 1000, |
584
|
|
|
|
|
|
|
nonblocking => 0, |
585
|
|
|
|
|
|
|
fh => undef); |
586
|
|
|
|
|
|
|
|
587
|
|
|
|
|
|
|
Here are the descriptions of all these parameters: |
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
device |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
The device number to open. These are numbered starting from 0. Depending |
592
|
|
|
|
|
|
|
on your system configuration and how many joystick devices you have |
593
|
|
|
|
|
|
|
connected, you may have a large number of these to choose from. The |
594
|
|
|
|
|
|
|
default value is 0 (zero), which is the first joystick. If you specify |
595
|
|
|
|
|
|
|
a non-numeric parameter, it will be treated as the absolute path to |
596
|
|
|
|
|
|
|
a device node (such as B). There are I checks to make |
597
|
|
|
|
|
|
|
sure the path is actually a joystick device (or even a device node at |
598
|
|
|
|
|
|
|
all). Attempting to open a regular file or anything else other than a |
599
|
|
|
|
|
|
|
joystick device leads to unpredictable and generally useless behaviour. |
600
|
|
|
|
|
|
|
|
601
|
|
|
|
|
|
|
nonblocking |
602
|
|
|
|
|
|
|
|
603
|
|
|
|
|
|
|
Whether or not to use nonblocking I/O mode in the nextEvent method (1 |
604
|
|
|
|
|
|
|
or any true value for yes, 0 or any false value for no). This is off by |
605
|
|
|
|
|
|
|
default (0). Normally, in regular (blocking) mode, the nextEvent method |
606
|
|
|
|
|
|
|
blocks (waits) until a joystick event is received. With non-blocking I/O, |
607
|
|
|
|
|
|
|
nextEvent will return immediately. Its return value will be undef if there |
608
|
|
|
|
|
|
|
was no event ready (normally it always returns a valid event). Turning |
609
|
|
|
|
|
|
|
this on requires you to restructure your code somewhat (see examples |
610
|
|
|
|
|
|
|
above), but it allows your app to do other things while it's waiting |
611
|
|
|
|
|
|
|
for joystick movement. |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
threshold |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
How far the joystick must be moved from the center before it's registered |
616
|
|
|
|
|
|
|
as a directional movement. The default is 1000, which is appropriate |
617
|
|
|
|
|
|
|
for most (all?) digital controls, and for the analog thumb sticks on my |
618
|
|
|
|
|
|
|
`Axis Pad', but might be a bit too sensitive for a traditional analog |
619
|
|
|
|
|
|
|
`flight' stick. The bigger the threshold is, the bigger the `dead' zone |
620
|
|
|
|
|
|
|
will be, and the less `jitter' you'll experience. For digital (d-pad) |
621
|
|
|
|
|
|
|
style controls, there's no dead zone or jitter to worry about. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
fh |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
A Perl file handle reference (or glob). This is intended primarily for |
626
|
|
|
|
|
|
|
testing Linux::Joystick itself, but you could use it to e.g. read fake |
627
|
|
|
|
|
|
|
joystick events from a pipe or something. Use of this parameter causes |
628
|
|
|
|
|
|
|
the B parameter to be ignored. As with the B parameter, |
629
|
|
|
|
|
|
|
there is no check done to verify that the filehandle actually represents |
630
|
|
|
|
|
|
|
a joystick device. There is no default for this parameter. |
631
|
|
|
|
|
|
|
|
632
|
|
|
|
|
|
|
Any parameter may be omitted, which will give that parameter its default |
633
|
|
|
|
|
|
|
value. A constructor with no arguments will cause all parameters to be |
634
|
|
|
|
|
|
|
set to their defaults. |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
The one-argument constructor is a convenient shorthand for setting |
637
|
|
|
|
|
|
|
the device parameter. The following 2 lines are equivalent: |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
Linux::Joystick->new($dev); |
640
|
|
|
|
|
|
|
Linux::Joystick->new(device => $dev); |
641
|
|
|
|
|
|
|
|
642
|
|
|
|
|
|
|
If you want to set the device and specify other parameters at the same |
643
|
|
|
|
|
|
|
time, you'll have to use the full constructor with the I argument. |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
=head1 METHODS |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
These are the methods for the Linux::Joystick class itself. Event |
649
|
|
|
|
|
|
|
methods are described in the next section (Events). I<$js> is an |
650
|
|
|
|
|
|
|
object of class Linux::Joystick, in the descriptions below. |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
=head2 List of methods |
653
|
|
|
|
|
|
|
|
654
|
|
|
|
|
|
|
|
655
|
|
|
|
|
|
|
$js->version |
656
|
|
|
|
|
|
|
$js->nextEvent |
657
|
|
|
|
|
|
|
$js->flushEvents |
658
|
|
|
|
|
|
|
$js->buttonCount |
659
|
|
|
|
|
|
|
$js->axisCount |
660
|
|
|
|
|
|
|
$js->stickCount |
661
|
|
|
|
|
|
|
$js->errorString |
662
|
|
|
|
|
|
|
$js->device |
663
|
|
|
|
|
|
|
$js->fileHandle |
664
|
|
|
|
|
|
|
$js->setNonblocking |
665
|
|
|
|
|
|
|
|
666
|
|
|
|
|
|
|
=head2 $js->version |
667
|
|
|
|
|
|
|
|
668
|
|
|
|
|
|
|
|
669
|
|
|
|
|
|
|
Returns the version of the Linux::Joystick module. This method may |
670
|
|
|
|
|
|
|
be called as either an instance method (as shown above) or as a class |
671
|
|
|
|
|
|
|
method: my $ver = Linux::Joystick->version; |
672
|
|
|
|
|
|
|
|
673
|
|
|
|
|
|
|
=head2 $js->nextEvent |
674
|
|
|
|
|
|
|
|
675
|
|
|
|
|
|
|
|
676
|
|
|
|
|
|
|
Returns a joystick event, or undef if there is no event. |
677
|
|
|
|
|
|
|
|
678
|
|
|
|
|
|
|
Joystick events are Linux::Joystick::Event objects (see below). |
679
|
|
|
|
|
|
|
|
680
|
|
|
|
|
|
|
In blocking mode (the default), nextEvent waits until there is an event |
681
|
|
|
|
|
|
|
to return. This could mean it waits forever, if the user walks away |
682
|
|
|
|
|
|
|
from the joystick. If you don't like this, either use nonblocking mode |
683
|
|
|
|
|
|
|
or wrap in an eval/alarm block. |
684
|
|
|
|
|
|
|
|
685
|
|
|
|
|
|
|
nextEvent should never return undef in blocking mode, but you should |
686
|
|
|
|
|
|
|
check for it anyway. I don't know what circumstances could cause it to |
687
|
|
|
|
|
|
|
happen (user unplugs the joystick? Not for USB controllers at least), |
688
|
|
|
|
|
|
|
but it'd definitely count as an exceptional condition. I might be |
689
|
|
|
|
|
|
|
the appropriate response, but I defer that decision to you. |
690
|
|
|
|
|
|
|
|
691
|
|
|
|
|
|
|
In nonblocking mode (constructor with nonblocking => 1), nextEvent will |
692
|
|
|
|
|
|
|
return undef if there's no pending event ready to be read. This isn't |
693
|
|
|
|
|
|
|
an error or exception: B of the time there's no input. Nonblocking |
694
|
|
|
|
|
|
|
mode is what you'll want to use in all but the simplest applications. |
695
|
|
|
|
|
|
|
|
696
|
|
|
|
|
|
|
=head2 $js->flushEvents |
697
|
|
|
|
|
|
|
|
698
|
|
|
|
|
|
|
Flushes any pending events in the input buffer. This is most useful |
699
|
|
|
|
|
|
|
in blocking mode, when your program does some long calculation or time |
700
|
|
|
|
|
|
|
consuming I/O. The user might get restless and twiddle the joystick while |
701
|
|
|
|
|
|
|
waiting. Since the kernel joystick buffer is 64 events, this means your |
702
|
|
|
|
|
|
|
program would suddenly read up to 64 random joystick events when its |
703
|
|
|
|
|
|
|
time-consuming subroutine returns, which could cause all kinds of havoc. |
704
|
|
|
|
|
|
|
|
705
|
|
|
|
|
|
|
This method works in either blocking or non-blocking I/O mode, though |
706
|
|
|
|
|
|
|
it's most useful in blocking mode. Beware: calling flushEvents causes |
707
|
|
|
|
|
|
|
a 0.2 second delay in your program's execution. |
708
|
|
|
|
|
|
|
|
709
|
|
|
|
|
|
|
=head2 $js->buttonCount |
710
|
|
|
|
|
|
|
|
711
|
|
|
|
|
|
|
|
712
|
|
|
|
|
|
|
Returns the number of buttons on the joystick. |
713
|
|
|
|
|
|
|
|
714
|
|
|
|
|
|
|
Buttons are numbered starting with 0, so the highest-numbered button |
715
|
|
|
|
|
|
|
will be one less than buttonCount's return value. |
716
|
|
|
|
|
|
|
|
717
|
|
|
|
|
|
|
For USB joysticks, this count is almost always correct. For gameport |
718
|
|
|
|
|
|
|
joysticks, it's possible that a 2-button generic gamepad/stick will |
719
|
|
|
|
|
|
|
appear to have 4 buttons (I've seen this happen before, but it was |
720
|
|
|
|
|
|
|
a long time ago). It's also possible that you're using a device with |
721
|
|
|
|
|
|
|
the generic gameport joystick driver (which only supports 4 buttons), |
722
|
|
|
|
|
|
|
but that device has a more specific driver you could be using that |
723
|
|
|
|
|
|
|
supports all the buttons on the device. I've had this problem with a |
724
|
|
|
|
|
|
|
Gravis Gamepad Pro gameport controller in the past. |
725
|
|
|
|
|
|
|
|
726
|
|
|
|
|
|
|
It's possible for a joystick to have 0 buttons, but not very likely |
727
|
|
|
|
|
|
|
(who makes a joystick with no buttons?) |
728
|
|
|
|
|
|
|
|
729
|
|
|
|
|
|
|
It's also possible for a device to report more buttons than it |
730
|
|
|
|
|
|
|
physically has. I have an `Axis Pad' (manufacturer unknown, made |
731
|
|
|
|
|
|
|
in China) that claims to have 20 buttons, though it really has 11. |
732
|
|
|
|
|
|
|
Strangely enough, 10 of the buttons show up as buttons 0 through 9, |
733
|
|
|
|
|
|
|
and the 11th button (actually a `Game/Set' switch) shows up as number |
734
|
|
|
|
|
|
|
19! |
735
|
|
|
|
|
|
|
|
736
|
|
|
|
|
|
|
I've got a gameport to USB adaptor that I use to plug my old Gamepad |
737
|
|
|
|
|
|
|
Pro into my new (USB-only) PC. It supports 4 axes and 8 buttons, and |
738
|
|
|
|
|
|
|
I reports all the buttons and axes, regardless of what kind of |
739
|
|
|
|
|
|
|
gameport controller is plugged in (or not plugged in: the PC can't tell). |
740
|
|
|
|
|
|
|
This part was made by Radio Shack, but I bet other gameport/USB adaptors |
741
|
|
|
|
|
|
|
will exhibit the same behaviour. |
742
|
|
|
|
|
|
|
|
743
|
|
|
|
|
|
|
=head2 $js->axisCount |
744
|
|
|
|
|
|
|
|
745
|
|
|
|
|
|
|
|
746
|
|
|
|
|
|
|
Returns the number of axes on the device. |
747
|
|
|
|
|
|
|
|
748
|
|
|
|
|
|
|
Axes are numbered starting with 0, so the highest-numbered axis will |
749
|
|
|
|
|
|
|
be one less than axisCount's return value. |
750
|
|
|
|
|
|
|
|
751
|
|
|
|
|
|
|
It's theoretically possible to have a joystick device with no axes |
752
|
|
|
|
|
|
|
(buttons only), but I've never seen one. |
753
|
|
|
|
|
|
|
|
754
|
|
|
|
|
|
|
=head2 $js->stickCount |
755
|
|
|
|
|
|
|
|
756
|
|
|
|
|
|
|
|
757
|
|
|
|
|
|
|
Returns the number of `sticks' on the device. |
758
|
|
|
|
|
|
|
|
759
|
|
|
|
|
|
|
Sticks are numbered starting with 0, so the highest-numbered stick will |
760
|
|
|
|
|
|
|
be one less than stickCount's return value. |
761
|
|
|
|
|
|
|
|
762
|
|
|
|
|
|
|
This is equal to the number of axes divided by two (rounded down). A stick |
763
|
|
|
|
|
|
|
is equivalent to two axes (vert and horiz), although there's no guarantee |
764
|
|
|
|
|
|
|
that a stick actually represents a physical stick (or d-pad, or whatever): |
765
|
|
|
|
|
|
|
if you have a device with one d-pad, a spinner, and a throttle slider, |
766
|
|
|
|
|
|
|
stickCount will report that you have two sticks (the d-pad counts as one, |
767
|
|
|
|
|
|
|
and the two other single-axis devices together count as the other). |
768
|
|
|
|
|
|
|
|
769
|
|
|
|
|
|
|
If axisCount is 1 greater than stickCount*2, the leftover axis is a |
770
|
|
|
|
|
|
|
single-axis control. Most single-axis controls are analog, not digital |
771
|
|
|
|
|
|
|
(you can use the axisValue for proportional movement). |
772
|
|
|
|
|
|
|
|
773
|
|
|
|
|
|
|
The native Linux joystick API has no concept of sticks. I invented this |
774
|
|
|
|
|
|
|
for convenience, because I prefer to think of a d-pad or stick as a |
775
|
|
|
|
|
|
|
single stick, rather than two axes. You are free to treat them as sticks, |
776
|
|
|
|
|
|
|
or axes, or mix and match both forms of addressing. |
777
|
|
|
|
|
|
|
|
778
|
|
|
|
|
|
|
A few words about joystick axes, sticks, and buttons: |
779
|
|
|
|
|
|
|
|
780
|
|
|
|
|
|
|
There's no way to tell what axes or buttons correspond to which |
781
|
|
|
|
|
|
|
physical controls on a gamepad or joystick. This is not a limitation |
782
|
|
|
|
|
|
|
of Joystick::Linux, it's a limitation of the underlying kernel API. |
783
|
|
|
|
|
|
|
|
784
|
|
|
|
|
|
|
That said, there are conventions followed by (almost) all devices. |
785
|
|
|
|
|
|
|
|
786
|
|
|
|
|
|
|
Even-numbered axes (including 0) are horizontal (left/right) axes. |
787
|
|
|
|
|
|
|
Odd-numbered axes are vertical (up/down) axes. A pair of such axes |
788
|
|
|
|
|
|
|
constitures a `stick'. Even though I call it a stick, it might be a d-pad, |
789
|
|
|
|
|
|
|
or a trakball, or whatever. The important point is that a stick (usually) |
790
|
|
|
|
|
|
|
represents a single physical control that can be used to detect movement. |
791
|
|
|
|
|
|
|
|
792
|
|
|
|
|
|
|
For d-pads, sticks, hats, trakballs, and the like, there will be 2 |
793
|
|
|
|
|
|
|
sequentially-numbered axes per control. Typically axes 0 and 1 (stick 0) |
794
|
|
|
|
|
|
|
are the primary control (d-pad or stick), 2 and 3 (stick 1) are the hat |
795
|
|
|
|
|
|
|
or analog thumbstick, etc. |
796
|
|
|
|
|
|
|
|
797
|
|
|
|
|
|
|
If you have single-axis controls (throttles or spinners), they will be |
798
|
|
|
|
|
|
|
the highest-numbered axes, and will only have one axis each. A device |
799
|
|
|
|
|
|
|
with 5 axes might use 0/1 for the main stick control, 2/3 for the hat, |
800
|
|
|
|
|
|
|
and 4 for the throttle slider. Generally, any controller with an odd |
801
|
|
|
|
|
|
|
number of axes has a slider, throttle, knob, or whatever. You are of |
802
|
|
|
|
|
|
|
course free to ignore axes you don't care about (most apps, even games, |
803
|
|
|
|
|
|
|
won't need more than 2 axes (1 stick)). |
804
|
|
|
|
|
|
|
|
805
|
|
|
|
|
|
|
For buttons, usually the ones directly under the user's thumb will be the |
806
|
|
|
|
|
|
|
lowest-numbered ones (typically these are in a diamond-shaped cluster and |
807
|
|
|
|
|
|
|
labelled A, B, X, Y or A, B, C, D). Usually, but not always, the button |
808
|
|
|
|
|
|
|
numbers returned by $event->button will correspond to the alphabetical |
809
|
|
|
|
|
|
|
ordering of the buttons (button 0 is the A button, 1 is the B, etc.) |
810
|
|
|
|
|
|
|
|
811
|
|
|
|
|
|
|
`Shoulder' buttons (like the L and R on a SNES controller) will be next |
812
|
|
|
|
|
|
|
(left shoulder having a lower number than the right), and then any |
813
|
|
|
|
|
|
|
pause/select/start buttons. |
814
|
|
|
|
|
|
|
|
815
|
|
|
|
|
|
|
Turbo buttons are usually implemented in hardware, inside the controller. |
816
|
|
|
|
|
|
|
This means that they don't get their own button numbers. Instead, holding |
817
|
|
|
|
|
|
|
down the `turbo A' button will cause the joystick to send a stream of |
818
|
|
|
|
|
|
|
events (pressed A, released A, pressed A, etc) to the PC. It's impossible |
819
|
|
|
|
|
|
|
for the joystick driver to tell the difference, so the buttonCount method |
820
|
|
|
|
|
|
|
won't include turbo buttons in the count. |
821
|
|
|
|
|
|
|
|
822
|
|
|
|
|
|
|
(Historical note: Turbo buttons were originally implemented this way |
823
|
|
|
|
|
|
|
because early console games typically didn't have a `rapid fire' mode at |
824
|
|
|
|
|
|
|
all (since it would make a lot of the games really easy). Third party |
825
|
|
|
|
|
|
|
manufacturers would sell joysticks with turbo buttons as `cheating' |
826
|
|
|
|
|
|
|
devices, and they had to work with unmodified consoles and games, hence |
827
|
|
|
|
|
|
|
the transparent hardware implementation). |
828
|
|
|
|
|
|
|
|
829
|
|
|
|
|
|
|
Not all devices follow the rules. |
830
|
|
|
|
|
|
|
|
831
|
|
|
|
|
|
|
You need to decide how many buttons and axes you need in your application, |
832
|
|
|
|
|
|
|
keeping in mind that all you can *really* count on are 2 axes and 2 |
833
|
|
|
|
|
|
|
buttons (all PC controllers have at least 2 axes and 2 buttons). These |
834
|
|
|
|
|
|
|
days, it's fine to rely on there being 4 buttons: if anyone still owns |
835
|
|
|
|
|
|
|
a 2-button controller, it should be in a museum. |
836
|
|
|
|
|
|
|
|
837
|
|
|
|
|
|
|
One trick you can do to semi-support extra buttons/axes is to use the |
838
|
|
|
|
|
|
|
modulus operator: |
839
|
|
|
|
|
|
|
|
840
|
|
|
|
|
|
|
# we only have 2 possible actions, only care about 2 buttons |
841
|
|
|
|
|
|
|
if($event->isButton) { |
842
|
|
|
|
|
|
|
if($event->button % 2 == 0) { |
843
|
|
|
|
|
|
|
# all even-numbered buttons do one action... |
844
|
|
|
|
|
|
|
fire_lasers(); |
845
|
|
|
|
|
|
|
} else { |
846
|
|
|
|
|
|
|
# all odd-numbered buttons do the other action... |
847
|
|
|
|
|
|
|
engage_warp_drive(); |
848
|
|
|
|
|
|
|
} |
849
|
|
|
|
|
|
|
} |
850
|
|
|
|
|
|
|
|
851
|
|
|
|
|
|
|
This way, the user can use whichever two buttons are most comfortable to |
852
|
|
|
|
|
|
|
him. The same applies to axes: if you only care about up/down/left/right, |
853
|
|
|
|
|
|
|
why not let the user use either the d-pad or the analog thumbstick, |
854
|
|
|
|
|
|
|
his choice? |
855
|
|
|
|
|
|
|
|
856
|
|
|
|
|
|
|
=head2 $js->errorString |
857
|
|
|
|
|
|
|
|
858
|
|
|
|
|
|
|
|
859
|
|
|
|
|
|
|
In the unlikely event of an error reading from the joystick device, |
860
|
|
|
|
|
|
|
this method will give you a human-readable error message. If there |
861
|
|
|
|
|
|
|
was no error, errorSting returns undef. |
862
|
|
|
|
|
|
|
|
863
|
|
|
|
|
|
|
Currently (in version 0.0.1), no error strings are defined. |
864
|
|
|
|
|
|
|
|
865
|
|
|
|
|
|
|
=head2 $js->device |
866
|
|
|
|
|
|
|
|
867
|
|
|
|
|
|
|
|
868
|
|
|
|
|
|
|
Returns the path to the device node that was opened, e.g. /dev/js0, |
869
|
|
|
|
|
|
|
or undef if the device couldn't be opened. |
870
|
|
|
|
|
|
|
|
871
|
|
|
|
|
|
|
=head2 $js->fileHandle |
872
|
|
|
|
|
|
|
|
873
|
|
|
|
|
|
|
|
874
|
|
|
|
|
|
|
Returns the Perl filehandle that Linux::Joystick is reading events |
875
|
|
|
|
|
|
|
from. You could use this to do a select() on the filehandle (and any |
876
|
|
|
|
|
|
|
other filehandles you need to handle). |
877
|
|
|
|
|
|
|
|
878
|
|
|
|
|
|
|
Attempting to read from this filehandle will (at best) confuse the |
879
|
|
|
|
|
|
|
joystick driver temporarily, or (at worst) cause your read to block |
880
|
|
|
|
|
|
|
forever (particularly if you're trying to use buffered reads). You |
881
|
|
|
|
|
|
|
have been warned! If you want to use select(), here's one way to |
882
|
|
|
|
|
|
|
do it: |
883
|
|
|
|
|
|
|
|
884
|
|
|
|
|
|
|
# assume that $input represents some stream such as a keyboard |
885
|
|
|
|
|
|
|
# or network socket, and $js is our Linux::Joystick device. Further |
886
|
|
|
|
|
|
|
# assume that $input is opened in non-blocking mode (it shouldn't |
887
|
|
|
|
|
|
|
# matter for $js, since the kernel *always* returns 8 bytes per event). |
888
|
|
|
|
|
|
|
|
889
|
|
|
|
|
|
|
# adapted from `perldoc -f select', which see for details. |
890
|
|
|
|
|
|
|
|
891
|
|
|
|
|
|
|
while(1) { |
892
|
|
|
|
|
|
|
my $buf; # $input buffer |
893
|
|
|
|
|
|
|
my $BUFLEN = 1024; # size of $input buffer |
894
|
|
|
|
|
|
|
|
895
|
|
|
|
|
|
|
my $rin = ''; |
896
|
|
|
|
|
|
|
for($js->fileHandle, $input) { |
897
|
|
|
|
|
|
|
vec($rin, fileno($_), 1) = 1; |
898
|
|
|
|
|
|
|
} |
899
|
|
|
|
|
|
|
|
900
|
|
|
|
|
|
|
# 4th parameter is timeout. 0 means return immediately, |
901
|
|
|
|
|
|
|
# undef means block forever, anything else is number of |
902
|
|
|
|
|
|
|
# seconds to wait. $nfound will tell how many fd's had |
903
|
|
|
|
|
|
|
# input pending, which really isn't too useful... |
904
|
|
|
|
|
|
|
|
905
|
|
|
|
|
|
|
my $nfound = select($rin, undef, undef, undef); |
906
|
|
|
|
|
|
|
|
907
|
|
|
|
|
|
|
if( vec($rin, fileno($js->fileHandle), 1) == 1 ) { |
908
|
|
|
|
|
|
|
my $event = $js->nextEvent(); |
909
|
|
|
|
|
|
|
process_event($event); # or whatever |
910
|
|
|
|
|
|
|
} |
911
|
|
|
|
|
|
|
|
912
|
|
|
|
|
|
|
if( vec($rin, fileno($input), 1) == 1 ) { |
913
|
|
|
|
|
|
|
# GOTCHA: do NOT use <$input> here! (see select() perldoc) |
914
|
|
|
|
|
|
|
while( ($bytes = sysread($input, $buf, $BUFLEN) > 0) ) { |
915
|
|
|
|
|
|
|
# process $input data one buffer at a time |
916
|
|
|
|
|
|
|
process_input($buf); |
917
|
|
|
|
|
|
|
} |
918
|
|
|
|
|
|
|
} |
919
|
|
|
|
|
|
|
} |
920
|
|
|
|
|
|
|
|
921
|
|
|
|
|
|
|
Notice that the above routine doesn't read from the filehandle returned |
922
|
|
|
|
|
|
|
by $js->fileHandle. Instead it's just used in the select() call. |
923
|
|
|
|
|
|
|
|
924
|
|
|
|
|
|
|
You can make that a lot more readable by using the IO::Select module |
925
|
|
|
|
|
|
|
instead of all that mess with vec() and select(). |
926
|
|
|
|
|
|
|
|
927
|
|
|
|
|
|
|
Of course, variations on this theme are possible. You could use the |
928
|
|
|
|
|
|
|
Curses or IO::Stty modules to read one character at a time from STDIN, |
929
|
|
|
|
|
|
|
in which case you'd just process one keystroke per loop iteration... |
930
|
|
|
|
|
|
|
|
931
|
|
|
|
|
|
|
=head2 $js->setNonblocking |
932
|
|
|
|
|
|
|
|
933
|
|
|
|
|
|
|
|
934
|
|
|
|
|
|
|
Sets or clears non-blocking mode. Takes one scalar parameter, which |
935
|
|
|
|
|
|
|
is treated as a boolean: a true value turns on non-blocking I/O, and |
936
|
|
|
|
|
|
|
a false value turns it off. It doesn't hurt anything to attempt to set |
937
|
|
|
|
|
|
|
the same mode that's already in use, and you can switch between the I/O |
938
|
|
|
|
|
|
|
modes as many times as you want. |
939
|
|
|
|
|
|
|
|
940
|
|
|
|
|
|
|
setNonblocking uses an fcntl() call to change the file descriptor's mode, |
941
|
|
|
|
|
|
|
so it doesn't close and reopen the device. Remember that when you're in |
942
|
|
|
|
|
|
|
non-blocking mode, all calls to nextEvent immediately return. When there's |
943
|
|
|
|
|
|
|
no input, the event returned will be undef. Also remember not to busy-wait |
944
|
|
|
|
|
|
|
on events! If you find yourself using 99% of the CPU according to `top', |
945
|
|
|
|
|
|
|
you need to restructure your code so that it works in blocking mode. If |
946
|
|
|
|
|
|
|
you can't do this (e.g. because you're reading from a network socket as |
947
|
|
|
|
|
|
|
well as a joystick), at least use a call like select(undef, undef, undef, |
948
|
|
|
|
|
|
|
0.01) to yield the CPU so that other processes can run. An even better |
949
|
|
|
|
|
|
|
idea would be to stay in blocking mode, but use the fileHandle method |
950
|
|
|
|
|
|
|
to get the joystick's file handle, then select() on both the joystick |
951
|
|
|
|
|
|
|
and network filehandles. This way, the kernel will put your process to |
952
|
|
|
|
|
|
|
sleep until there's some input available on one stream or the other. |
953
|
|
|
|
|
|
|
|
954
|
|
|
|
|
|
|
Since setNonblocking uses fcntl(), it may behave strangely on really old |
955
|
|
|
|
|
|
|
(2.2 or earlier) kernels. I have only tested this module on Linux 2.4 |
956
|
|
|
|
|
|
|
and 2.6 kernels. |
957
|
|
|
|
|
|
|
|
958
|
|
|
|
|
|
|
=head1 Events |
959
|
|
|
|
|
|
|
|
960
|
|
|
|
|
|
|
|
961
|
|
|
|
|
|
|
$ev->isButton |
962
|
|
|
|
|
|
|
$ev->button |
963
|
|
|
|
|
|
|
$ev->buttonDown |
964
|
|
|
|
|
|
|
$ev->buttonUp |
965
|
|
|
|
|
|
|
$ev->isAxis |
966
|
|
|
|
|
|
|
$ev->axis |
967
|
|
|
|
|
|
|
$ev->axisValue |
968
|
|
|
|
|
|
|
$ev->stickLeft |
969
|
|
|
|
|
|
|
$ev->stickRight |
970
|
|
|
|
|
|
|
$ev->stickUp |
971
|
|
|
|
|
|
|
$ev->stickDown |
972
|
|
|
|
|
|
|
$ev->type |
973
|
|
|
|
|
|
|
$ev->hexDump |
974
|
|
|
|
|
|
|
$ev->timeStamp |
975
|
|
|
|
|
|
|
|
976
|
|
|
|
|
|
|
=head2 $ev->isButton |
977
|
|
|
|
|
|
|
|
978
|
|
|
|
|
|
|
|
979
|
|
|
|
|
|
|
Returns true if this event was caused by a button press, or false if not. |
980
|
|
|
|
|
|
|
|
981
|
|
|
|
|
|
|
The next 3 method calls are only valid for button events (e.g. when |
982
|
|
|
|
|
|
|
isButton returns true). If called on a non-button event, they will |
983
|
|
|
|
|
|
|
return undef. |
984
|
|
|
|
|
|
|
|
985
|
|
|
|
|
|
|
=head2 $ev->button |
986
|
|
|
|
|
|
|
|
987
|
|
|
|
|
|
|
|
988
|
|
|
|
|
|
|
Returns the number of the button that caused this event, if it was |
989
|
|
|
|
|
|
|
a button event, or undef it it wasn't a button event. Keep in mind that |
990
|
|
|
|
|
|
|
0 is a valid button (it's the first button), so you don't want to |
991
|
|
|
|
|
|
|
treat this as a boolean (use isButton instead). |
992
|
|
|
|
|
|
|
|
993
|
|
|
|
|
|
|
NOTE: In the Linux joystick API, each button is reported separately, |
994
|
|
|
|
|
|
|
even if more than one button was pressed or released simultaneously. For |
995
|
|
|
|
|
|
|
example, pressing 2 buttons at once on a gamepad results in 2 events: |
996
|
|
|
|
|
|
|
one for each button. This may sound like a problem, but in practice it |
997
|
|
|
|
|
|
|
works out just fine if you process each event as soon as it comes in. |
998
|
|
|
|
|
|
|
|
999
|
|
|
|
|
|
|
=head2 $ev->buttonDown |
1000
|
|
|
|
|
|
|
|
1001
|
|
|
|
|
|
|
=head2 $ev->buttonDown($b); |
1002
|
|
|
|
|
|
|
|
1003
|
|
|
|
|
|
|
|
1004
|
|
|
|
|
|
|
Returns true if this was a button press event, false if it was a |
1005
|
|
|
|
|
|
|
button release event, or undef if it was not a button event at all. |
1006
|
|
|
|
|
|
|
|
1007
|
|
|
|
|
|
|
With the optional $b parameter, returns true if this is a button |
1008
|
|
|
|
|
|
|
event B if the button $b was pressed. |
1009
|
|
|
|
|
|
|
|
1010
|
|
|
|
|
|
|
=head2 $ev->buttonUp; |
1011
|
|
|
|
|
|
|
|
1012
|
|
|
|
|
|
|
=head2 $ev->buttonUp($b); |
1013
|
|
|
|
|
|
|
|
1014
|
|
|
|
|
|
|
|
1015
|
|
|
|
|
|
|
Returns true if this was a button release event, false if it was a |
1016
|
|
|
|
|
|
|
button press event, or undef if it was not a button event at all. |
1017
|
|
|
|
|
|
|
|
1018
|
|
|
|
|
|
|
With the optional $b parameter, returns true if this is a button |
1019
|
|
|
|
|
|
|
event B if the button $b was pressed. |
1020
|
|
|
|
|
|
|
|
1021
|
|
|
|
|
|
|
For button events, buttonDown returns !buttonUp, and buttonUp returns |
1022
|
|
|
|
|
|
|
!buttonDown. Use whichever method makes your code most readable. For |
1023
|
|
|
|
|
|
|
non-button events, both methods return undef. |
1024
|
|
|
|
|
|
|
|
1025
|
|
|
|
|
|
|
=head2 $ev->isAxis |
1026
|
|
|
|
|
|
|
|
1027
|
|
|
|
|
|
|
|
1028
|
|
|
|
|
|
|
Returns true if this event was caused by joystick axis movement, false |
1029
|
|
|
|
|
|
|
otherwise. |
1030
|
|
|
|
|
|
|
|
1031
|
|
|
|
|
|
|
=head2 $ev->axis |
1032
|
|
|
|
|
|
|
|
1033
|
|
|
|
|
|
|
|
1034
|
|
|
|
|
|
|
Returns the axis number that caused this event, if it was an axis |
1035
|
|
|
|
|
|
|
event. Otherwise, returns undef. Remember, 0 is a valid axis number, |
1036
|
|
|
|
|
|
|
so don't treat this as a boolean value (use isAxis for that). |
1037
|
|
|
|
|
|
|
|
1038
|
|
|
|
|
|
|
NOTE: In the Linux joystick API, each axis is reported separately, |
1039
|
|
|
|
|
|
|
even if more than one axis changed simultaneously. For example, diagonal |
1040
|
|
|
|
|
|
|
movement on a gamepad results in 2 events: one for the vertical axis and |
1041
|
|
|
|
|
|
|
one for the horizontal. This may sound like a problem, but in practice |
1042
|
|
|
|
|
|
|
it works out just fine if you process each event as soon as it comes in. |
1043
|
|
|
|
|
|
|
However, it does mean that you can't test an individual event to |
1044
|
|
|
|
|
|
|
determine whether or not a stick is centered. |
1045
|
|
|
|
|
|
|
|
1046
|
|
|
|
|
|
|
=head2 $ev->stick |
1047
|
|
|
|
|
|
|
|
1048
|
|
|
|
|
|
|
|
1049
|
|
|
|
|
|
|
Returns the stick (or d-pad, or whatever) number that caused this |
1050
|
|
|
|
|
|
|
event. This is determined by which axis caused the movement: Axes 0 and |
1051
|
|
|
|
|
|
|
1 are considered to be stick 1, axes 2 and 3 are stick 2, etc. |
1052
|
|
|
|
|
|
|
|
1053
|
|
|
|
|
|
|
More formally, ($ev->stick == $ev->axis >> 1) is always true. |
1054
|
|
|
|
|
|
|
|
1055
|
|
|
|
|
|
|
This is the same logical stick number that you provide to the |
1056
|
|
|
|
|
|
|
stickUp/Down/Left/Right methods, below. |
1057
|
|
|
|
|
|
|
|
1058
|
|
|
|
|
|
|
The Linux joystick API does not include the concept of a stick number; |
1059
|
|
|
|
|
|
|
I invented this as a convenience for Perl programmers (to give you More |
1060
|
|
|
|
|
|
|
Than One Way To Do It(tm)). |
1061
|
|
|
|
|
|
|
|
1062
|
|
|
|
|
|
|
=head2 $ev->axisValue |
1063
|
|
|
|
|
|
|
|
1064
|
|
|
|
|
|
|
|
1065
|
|
|
|
|
|
|
Returns the current value of the axis, if this event was an axis event. |
1066
|
|
|
|
|
|
|
Returns undef for non-axis events. 0 is a valid value (it's the center |
1067
|
|
|
|
|
|
|
position), so don't use this as a boolean value (use isAxis for that). |
1068
|
|
|
|
|
|
|
|
1069
|
|
|
|
|
|
|
This is a signed 16-bit value. Negative values indicate movement to the |
1070
|
|
|
|
|
|
|
left (for horizontal axes) or up (for vertical axes). Positive values |
1071
|
|
|
|
|
|
|
indicate movement to the right or down. Zero is the center position. |
1072
|
|
|
|
|
|
|
|
1073
|
|
|
|
|
|
|
The axisValue method works for either analog or digital controls. In the |
1074
|
|
|
|
|
|
|
C API, B joystick devices are treated as analog devices. A digital |
1075
|
|
|
|
|
|
|
gamepad will typically return only -32768, 0, or 32767 for each axis, |
1076
|
|
|
|
|
|
|
while an analog stick will return values anywhere in the range of |
1077
|
|
|
|
|
|
|
-32768 to 32767, with 0 being the center. |
1078
|
|
|
|
|
|
|
|
1079
|
|
|
|
|
|
|
You should NOT rely on the values being exact, however: sometimes the |
1080
|
|
|
|
|
|
|
calibration is off, so the center value is something other than 0, or |
1081
|
|
|
|
|
|
|
the maximum range is less than usual. Typically, you'll want to ignore |
1082
|
|
|
|
|
|
|
values less than some threshold (possibly configurable by the user of |
1083
|
|
|
|
|
|
|
your app). This keeps `jiter' from affecting your app. If you're having |
1084
|
|
|
|
|
|
|
calibration issues, the B utility will help. |
1085
|
|
|
|
|
|
|
|
1086
|
|
|
|
|
|
|
Actually, you should only use axisValue if your app is using the |
1087
|
|
|
|
|
|
|
joystick's analog value to control something like a mouse pointer |
1088
|
|
|
|
|
|
|
(other examples would be: the paddles in a Pong/Breakout type game, |
1089
|
|
|
|
|
|
|
or the control yoke in a flight simulator). Keep in mind that a digital |
1090
|
|
|
|
|
|
|
gamepad-style controller will be useless for such applications. Also keep |
1091
|
|
|
|
|
|
|
in mind that the joystick API doesn't give us a way to know whether the |
1092
|
|
|
|
|
|
|
joystick we're reading is a digital gamepad or an analog stick. |
1093
|
|
|
|
|
|
|
|
1094
|
|
|
|
|
|
|
If you're only interested in I the stick is pressed, |
1095
|
|
|
|
|
|
|
use the stickLeft/Right/Up/Down methods, below. |
1096
|
|
|
|
|
|
|
|
1097
|
|
|
|
|
|
|
=head2 stickLeft |
1098
|
|
|
|
|
|
|
|
1099
|
|
|
|
|
|
|
=head2 stickLeft($stick) |
1100
|
|
|
|
|
|
|
|
1101
|
|
|
|
|
|
|
|
1102
|
|
|
|
|
|
|
Returns true if the event was caused by movement to the left, false |
1103
|
|
|
|
|
|
|
if otherwise, and undef if the event isn't an axis event. |
1104
|
|
|
|
|
|
|
|
1105
|
|
|
|
|
|
|
If no parameter is provided, a true result means B vertical axis |
1106
|
|
|
|
|
|
|
was moved left. If the optional I<$stick> parameter is given, it is used |
1107
|
|
|
|
|
|
|
to decide which axis-pair to check for movement. If $stick is 0, axes |
1108
|
|
|
|
|
|
|
(0,1) are checked. If $stick is 1, axes(2,3) are checked, etc. |
1109
|
|
|
|
|
|
|
|
1110
|
|
|
|
|
|
|
If your app doesn't need more than one pair of axes (one stick), it |
1111
|
|
|
|
|
|
|
is recommended that you use the no-argument forms of stickUp, stickDown, |
1112
|
|
|
|
|
|
|
stickLeft, and stickRight. |
1113
|
|
|
|
|
|
|
|
1114
|
|
|
|
|
|
|
=head2 stickRight |
1115
|
|
|
|
|
|
|
|
1116
|
|
|
|
|
|
|
=head2 stickRight($stick) |
1117
|
|
|
|
|
|
|
|
1118
|
|
|
|
|
|
|
|
1119
|
|
|
|
|
|
|
Returns true if the event was caused by movement to the right, false |
1120
|
|
|
|
|
|
|
if otherwise, and undef if the event isn't an axis event. |
1121
|
|
|
|
|
|
|
|
1122
|
|
|
|
|
|
|
I |
1123
|
|
|
|
|
|
|
|
1124
|
|
|
|
|
|
|
=head2 stickUp |
1125
|
|
|
|
|
|
|
|
1126
|
|
|
|
|
|
|
=head2 stickUp($stick) |
1127
|
|
|
|
|
|
|
|
1128
|
|
|
|
|
|
|
|
1129
|
|
|
|
|
|
|
Returns true if the event was caused by upwards movement, false |
1130
|
|
|
|
|
|
|
if otherwise, and undef if the event isn't an axis event. |
1131
|
|
|
|
|
|
|
|
1132
|
|
|
|
|
|
|
I |
1133
|
|
|
|
|
|
|
|
1134
|
|
|
|
|
|
|
=head2 stickDown |
1135
|
|
|
|
|
|
|
|
1136
|
|
|
|
|
|
|
=head2 stickDown($stick) |
1137
|
|
|
|
|
|
|
|
1138
|
|
|
|
|
|
|
|
1139
|
|
|
|
|
|
|
Returns true if the event was caused by downwards movement, false |
1140
|
|
|
|
|
|
|
if otherwise, and undef if the event isn't an axis event. |
1141
|
|
|
|
|
|
|
|
1142
|
|
|
|
|
|
|
I |
1143
|
|
|
|
|
|
|
|
1144
|
|
|
|
|
|
|
=cut |
1145
|
|
|
|
|
|
|
|
1146
|
|
|
|
|
|
|
## This method would require us to track state across multiple |
1147
|
|
|
|
|
|
|
## events, which I don't want to do: |
1148
|
|
|
|
|
|
|
|
1149
|
|
|
|
|
|
|
## =head2 stickCenter |
1150
|
|
|
|
|
|
|
## =head2 stickCenter($stick) |
1151
|
|
|
|
|
|
|
## |
1152
|
|
|
|
|
|
|
## Returns true if the event was caused by movement back to the center |
1153
|
|
|
|
|
|
|
## position, false if otherwise, and undef if the event isn't an axis event. |
1154
|
|
|
|
|
|
|
## |
1155
|
|
|
|
|
|
|
## $ev->axisCenter is exactly equivalent to: |
1156
|
|
|
|
|
|
|
## |
1157
|
|
|
|
|
|
|
## not (ev->stickLeft || $ev->stickRight || $ev->stickUp || $ev->stickDown) |
1158
|
|
|
|
|
|
|
## |
1159
|
|
|
|
|
|
|
## I |
1160
|
|
|
|
|
|
|
|
1161
|
|
|
|
|
|
|
=pod |
1162
|
|
|
|
|
|
|
|
1163
|
|
|
|
|
|
|
The stickLeft/Right/Up/Down methods are provided as a convenience for |
1164
|
|
|
|
|
|
|
applications that only care about which direction the stick was moved, |
1165
|
|
|
|
|
|
|
not how far it was moved. This includes digital controls like the d-pad |
1166
|
|
|
|
|
|
|
on a gamepad (which can only report all-or-nothing). |
1167
|
|
|
|
|
|
|
|
1168
|
|
|
|
|
|
|
These methods are a bit special in that they take into account which |
1169
|
|
|
|
|
|
|
axis was moved I whether it increased or decreased. Your app code |
1170
|
|
|
|
|
|
|
doesn't need to check e.g. whether the horizontal axis (even numbered) |
1171
|
|
|
|
|
|
|
was moved before it checks for left/right movement. |
1172
|
|
|
|
|
|
|
|
1173
|
|
|
|
|
|
|
Example use: |
1174
|
|
|
|
|
|
|
|
1175
|
|
|
|
|
|
|
# no-argument forms: |
1176
|
|
|
|
|
|
|
if($ev->isAxis) { |
1177
|
|
|
|
|
|
|
move_pacman_left() if $ev->stickLeft; |
1178
|
|
|
|
|
|
|
move_pacman_right() if $ev->stickRight; |
1179
|
|
|
|
|
|
|
move_pacman_up() if $ev->stickUp; |
1180
|
|
|
|
|
|
|
move_pacman_down() if $ev->stickDown; |
1181
|
|
|
|
|
|
|
} |
1182
|
|
|
|
|
|
|
|
1183
|
|
|
|
|
|
|
# use $stick to test two controls on same device: |
1184
|
|
|
|
|
|
|
if($ev->isAxis) { |
1185
|
|
|
|
|
|
|
print "Stick 0 (probably the D-Pad) moved left" if $ev->stickLeft(0); |
1186
|
|
|
|
|
|
|
print "Stick 1 (probably the analog) moved left" if $ev->stickLeft(1); |
1187
|
|
|
|
|
|
|
} |
1188
|
|
|
|
|
|
|
|
1189
|
|
|
|
|
|
|
The $ev->isAxis test is actually superfluous: all four methods will return |
1190
|
|
|
|
|
|
|
undef (a false value) for non-axis events. The snippets above would work |
1191
|
|
|
|
|
|
|
just as well (though just slightly slower) without the if() around them. |
1192
|
|
|
|
|
|
|
|
1193
|
|
|
|
|
|
|
Notice that there is B stickCenter method. This is due to the |
1194
|
|
|
|
|
|
|
fact that each event only reports movement for one axis. Since this |
1195
|
|
|
|
|
|
|
module doesn't save state between events, there's no way to tell (by |
1196
|
|
|
|
|
|
|
looking at just one event) the state of B axes. Future versions of |
1197
|
|
|
|
|
|
|
Linux::Joystick may address this issue. For now, if you need to detect |
1198
|
|
|
|
|
|
|
a centered stick, you'll need to remember the axis values of that stick |
1199
|
|
|
|
|
|
|
in your application code. |
1200
|
|
|
|
|
|
|
|
1201
|
|
|
|
|
|
|
=head2 $ev->type |
1202
|
|
|
|
|
|
|
|
1203
|
|
|
|
|
|
|
|
1204
|
|
|
|
|
|
|
Returns the string B |
1205
|
|
|
|
|
|
|
or B for unknown events. Primarily intended for debugging. You |
1206
|
|
|
|
|
|
|
shouldn't be comparing this string to determine event type (that's what |
1207
|
|
|
|
|
|
|
isAxis and isButton are for). |
1208
|
|
|
|
|
|
|
|
1209
|
|
|
|
|
|
|
There should I be any unknown events. If you're getting them, |
1210
|
|
|
|
|
|
|
it's because this module has a bug in it, or else the Linux kernel |
1211
|
|
|
|
|
|
|
developers have invented a new type of joystick event (not likely to |
1212
|
|
|
|
|
|
|
happen any time soon). |
1213
|
|
|
|
|
|
|
|
1214
|
|
|
|
|
|
|
=head2 $ev->hexDump |
1215
|
|
|
|
|
|
|
|
1216
|
|
|
|
|
|
|
|
1217
|
|
|
|
|
|
|
Returns a string consisting of hex representations of the raw bytes, |
1218
|
|
|
|
|
|
|
as read from the joystick device file descriptor. Only meant for |
1219
|
|
|
|
|
|
|
debugging. There is no information here that you can't get from one of |
1220
|
|
|
|
|
|
|
the other methods in a friendlier way. |
1221
|
|
|
|
|
|
|
|
1222
|
|
|
|
|
|
|
=head2 $ev->timeStamp |
1223
|
|
|
|
|
|
|
|
1224
|
|
|
|
|
|
|
|
1225
|
|
|
|
|
|
|
Returns the timestamp of this event. This is an integer number of |
1226
|
|
|
|
|
|
|
milliseconds. Linux::Joystick does not use or modify this value; it's |
1227
|
|
|
|
|
|
|
the js_event.time field from the C API. The kernel documentation doesn't |
1228
|
|
|
|
|
|
|
say a lot about this field. Here's what my copy of joystick-api.txt |
1229
|
|
|
|
|
|
|
says: |
1230
|
|
|
|
|
|
|
|
1231
|
|
|
|
|
|
|
The time an event was generated is stored in |
1232
|
|
|
|
|
|
|
``js_event.time''. It's a time in milliseconds since ... well, |
1233
|
|
|
|
|
|
|
since sometime in the past. This eases the task of detecting |
1234
|
|
|
|
|
|
|
double clicks, figuring out if movement of axis and button |
1235
|
|
|
|
|
|
|
presses happened at the same time, and similar. |
1236
|
|
|
|
|
|
|
|
1237
|
|
|
|
|
|
|
Use it for whatever you want, or ignore it. Future versions of this Perl |
1238
|
|
|
|
|
|
|
module might include support for detecting double-clicks, but if so, it'll |
1239
|
|
|
|
|
|
|
be something you have to enable (the default behaviour will not change). |
1240
|
|
|
|
|
|
|
|
1241
|
|
|
|
|
|
|
=head1 Alternatives to Linux::Joystick |
1242
|
|
|
|
|
|
|
|
1243
|
|
|
|
|
|
|
|
1244
|
|
|
|
|
|
|
You could always open /dev/js0 yourself and read from it (that's all this |
1245
|
|
|
|
|
|
|
module does). I've tried to make the code fairly readable, so you can |
1246
|
|
|
|
|
|
|
look at site_per/Linux/Joystick.pm in your perl lib directory and see |
1247
|
|
|
|
|
|
|
how it's done (well, one way to do it, anyway). Search for _read_event |
1248
|
|
|
|
|
|
|
as a starting point. |
1249
|
|
|
|
|
|
|
|
1250
|
|
|
|
|
|
|
You could also use the SDL module from CPAN, which provides lots of |
1251
|
|
|
|
|
|
|
other nice stuff besides joystick support, and is portable to lots of |
1252
|
|
|
|
|
|
|
other platforms (unlike Linux::Joystick, which only works on Linux). |
1253
|
|
|
|
|
|
|
|
1254
|
|
|
|
|
|
|
On the minus side, SDL I you to create an application window |
1255
|
|
|
|
|
|
|
(not necessarily an X11 window) before it can access the joysticks. If |
1256
|
|
|
|
|
|
|
you're trying to add joystick support to an existing non-SDL app, or |
1257
|
|
|
|
|
|
|
writing a textmode interface with joystick support, or using a joystick |
1258
|
|
|
|
|
|
|
as an alternate input for disabled people, or anything else that doesn't |
1259
|
|
|
|
|
|
|
benefit from SDL's graphics & sound capabilities, you probably want this |
1260
|
|
|
|
|
|
|
module instead of SDL. |
1261
|
|
|
|
|
|
|
|
1262
|
|
|
|
|
|
|
There also exist two CPAN modules you can use to support joysticks on |
1263
|
|
|
|
|
|
|
Windows platforms, if that's your goal. They are B |
1264
|
|
|
|
|
|
|
and B. I don't know anything about these |
1265
|
|
|
|
|
|
|
modules (not being a win32 programmer), and Linux::Joystick is not |
1266
|
|
|
|
|
|
|
compatible with either one. |
1267
|
|
|
|
|
|
|
|
1268
|
|
|
|
|
|
|
If you're using FreeBSD, NetBSD, or OpenBSD, you may be able to use |
1269
|
|
|
|
|
|
|
Linux::Joystick with your OS's Linux emulation package. I don't know |
1270
|
|
|
|
|
|
|
whether this is actually supported or not (send me your results and I'll |
1271
|
|
|
|
|
|
|
put them here in the next version). A cursory glance at the man page for |
1272
|
|
|
|
|
|
|
NetBSD's I driver shows that it's nothing like the Linux joystick |
1273
|
|
|
|
|
|
|
driver, so you'd definitely need Linux emulation there, assuming the |
1274
|
|
|
|
|
|
|
emulation emulates the Linux joystick API. |
1275
|
|
|
|
|
|
|
|
1276
|
|
|
|
|
|
|
=head1 C API |
1277
|
|
|
|
|
|
|
|
1278
|
|
|
|
|
|
|
|
1279
|
|
|
|
|
|
|
The C API is described in $srcdir/Documentation/input/joystick-api.txt in |
1280
|
|
|
|
|
|
|
the Linux kernel source. This Perl module only supports the new (1.2.x) |
1281
|
|
|
|
|
|
|
joystick API, not the old 0.x backwards compatibility API. This shouldn't |
1282
|
|
|
|
|
|
|
be a problem: I'm writing this in 2004, and the `new' API has been around |
1283
|
|
|
|
|
|
|
for something like 8 years now... if you're really still running an early |
1284
|
|
|
|
|
|
|
1.2.x Linux kernel, you presumably know what you're doing and don't need |
1285
|
|
|
|
|
|
|
my help. |
1286
|
|
|
|
|
|
|
|
1287
|
|
|
|
|
|
|
The C API sends synthetic JS_INIT events, one per axis or button, when |
1288
|
|
|
|
|
|
|
the device is first opened. You can ignore these in your perl scripts: |
1289
|
|
|
|
|
|
|
Linux::Joystick intercepts the synthetic events itself and counts how |
1290
|
|
|
|
|
|
|
many axes/buttons your device has. |
1291
|
|
|
|
|
|
|
|
1292
|
|
|
|
|
|
|
=head1 BUGS |
1293
|
|
|
|
|
|
|
|
1294
|
|
|
|
|
|
|
|
1295
|
|
|
|
|
|
|
Well, I haven't gone on an exhaustive bug-hunt yet, so that counts as |
1296
|
|
|
|
|
|
|
one bug right there :) |
1297
|
|
|
|
|
|
|
|
1298
|
|
|
|
|
|
|
I haven't tested this with a regular analog stick, because I don't own |
1299
|
|
|
|
|
|
|
one. The closest thing I have are the analog thumb-sticks on my Axis pad. |
1300
|
|
|
|
|
|
|
All that should need changing with a flight stick is the threshold. |
1301
|
|
|
|
|
|
|
|
1302
|
|
|
|
|
|
|
I need to test with lots of different devices. I own maybe 15 or 20 |
1303
|
|
|
|
|
|
|
different PC-compatible game pads, so this is just a matter of time. |
1304
|
|
|
|
|
|
|
|
1305
|
|
|
|
|
|
|
Someone needs to test this with some of the really oddball controllers out |
1306
|
|
|
|
|
|
|
there (like the homebrew hack that lets you plug a Sega Genesis controller |
1307
|
|
|
|
|
|
|
into your serial port). Given my hardware skills, that probably will be |
1308
|
|
|
|
|
|
|
someone other than me :) |
1309
|
|
|
|
|
|
|
|
1310
|
|
|
|
|
|
|
The lack of a stickCenter event (and more generally, the lack of state |
1311
|
|
|
|
|
|
|
across events) might count as a bug. |
1312
|
|
|
|
|
|
|
|
1313
|
|
|
|
|
|
|
Not really a bug, but a minor shortcoming: instantiating a |
1314
|
|
|
|
|
|
|
Linux::Joystick object causes a short (0.2 second) delay. |
1315
|
|
|
|
|
|
|
|
1316
|
|
|
|
|
|
|
The errorString method never returns an error string. Most of the time, |
1317
|
|
|
|
|
|
|
if there's an error, it's during the constructor (where we open the |
1318
|
|
|
|
|
|
|
device for reading), so we return undef and leave the error message in |
1319
|
|
|
|
|
|
|
$!. The only possible use for errorString would be if we got an error |
1320
|
|
|
|
|
|
|
in the nextEvent method (maybe an EOF), but I've never actually seen |
1321
|
|
|
|
|
|
|
any such error. |
1322
|
|
|
|
|
|
|
|
1323
|
|
|
|
|
|
|
If events are not read often enough, the kernel joystick driver will |
1324
|
|
|
|
|
|
|
fill up its event queue. According to joystick-api.txt, the queue has |
1325
|
|
|
|
|
|
|
room for 64 events, and if it overflows, the joystick driver resets |
1326
|
|
|
|
|
|
|
(starts sending synthetic init events again). This isn't likely with |
1327
|
|
|
|
|
|
|
a well-designed app, but it's possible (e.g. if pressing the 0 button |
1328
|
|
|
|
|
|
|
causes a long, involved process that takes a minute or two to complete, |
1329
|
|
|
|
|
|
|
and the impatient user keeps wiggling the d-pad while he waits). We |
1330
|
|
|
|
|
|
|
should be checking for synthetic events always, not just when we |
1331
|
|
|
|
|
|
|
first open the device. |
1332
|
|
|
|
|
|
|
|
1333
|
|
|
|
|
|
|
I don't know what happens if a joystick is unplugged while it's open |
1334
|
|
|
|
|
|
|
for reading, then plugged back in. On my test machine, unplugging the |
1335
|
|
|
|
|
|
|
USB joystick doesn't cause an error, but plugging it back in doesn't |
1336
|
|
|
|
|
|
|
bring it back to life. However, unplugging it & plugging it back in even |
1337
|
|
|
|
|
|
|
while it's NOT open, makes it disappear and never come back (I have to |
1338
|
|
|
|
|
|
|
`rmmod joydev; modprobe joydev' to get it to work). This isn't the normal |
1339
|
|
|
|
|
|
|
behviour for USB sticks: normally they can be unplugged and plugged back |
1340
|
|
|
|
|
|
|
in, and they'll still work (though I don't know whether user code that's |
1341
|
|
|
|
|
|
|
reading them will need to reopen the device or not). I've *no* idea |
1342
|
|
|
|
|
|
|
what happens if a gameport joystick is unplugged! |
1343
|
|
|
|
|
|
|
|
1344
|
|
|
|
|
|
|
=head1 AUTHOR |
1345
|
|
|
|
|
|
|
|
1346
|
|
|
|
|
|
|
|
1347
|
|
|
|
|
|
|
B. Watson, perljoystick@hardcoders.org |
1348
|
|
|
|
|
|
|
|
1349
|
|
|
|
|
|
|
Feel free to contact me with bug reports, suggestions for improvement, |
1350
|
|
|
|
|
|
|
or even success stories (hey, somebody besides me has got to find this |
1351
|
|
|
|
|
|
|
thing useful, right?) |
1352
|
|
|
|
|
|
|
|
1353
|
|
|
|
|
|
|
=head1 LICENSE |
1354
|
|
|
|
|
|
|
|
1355
|
|
|
|
|
|
|
|
1356
|
|
|
|
|
|
|
You may use and redistribute this Perl module under the same terms as |
1357
|
|
|
|
|
|
|
Perl itself (GPL or Artistic License, your choice). |
1358
|
|
|
|
|
|
|
|
1359
|
|
|
|
|
|
|
If you use this module in a commercial product, I'd appreciate it if |
1360
|
|
|
|
|
|
|
you let me know. This isn't a licensing requirement; it's just common |
1361
|
|
|
|
|
|
|
courtesy. |
1362
|
|
|
|
|
|
|
|
1363
|
|
|
|
|
|
|
Although I have made every effort to produce bug-free code, I am not |
1364
|
|
|
|
|
|
|
responsible for any loss or damages caused by the use of Linux::Joystick. |
1365
|
|
|
|
|
|
|
If it breaks, you get to keep both pieces :) |
1366
|
|
|
|
|
|
|
|
1367
|
|
|
|
|
|
|
=head1 COPYRIGHT |
1368
|
|
|
|
|
|
|
|
1369
|
|
|
|
|
|
|
|
1370
|
|
|
|
|
|
|
Copyright (c) 2004, B. Watson |
1371
|
|
|
|
|
|
|
|
1372
|
|
|
|
|
|
|
=cut |
1373
|
|
|
|
|
|
|
|