line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Device::PiLite; |
2
|
|
|
|
|
|
|
|
3
|
1
|
|
|
1
|
|
16546
|
use strict; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
42
|
|
4
|
1
|
|
|
1
|
|
3
|
use warnings; |
|
1
|
|
|
|
|
2
|
|
|
1
|
|
|
|
|
21
|
|
5
|
|
|
|
|
|
|
|
6
|
1
|
|
|
1
|
|
218
|
use Moose; |
|
0
|
|
|
|
|
|
|
|
0
|
|
|
|
|
|
|
7
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
use Carp qw(croak); |
9
|
|
|
|
|
|
|
use Scalar::Util qw(looks_like_number); |
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
|
12
|
|
|
|
|
|
|
=head1 NAME |
13
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
Device::PiLite - Interface to Ciseco Pi-Lite for Raspberry Pi |
15
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
=cut |
17
|
|
|
|
|
|
|
|
18
|
|
|
|
|
|
|
our $VERSION = '0.01'; |
19
|
|
|
|
|
|
|
|
20
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
=head1 SYNOPSIS |
22
|
|
|
|
|
|
|
|
23
|
|
|
|
|
|
|
|
24
|
|
|
|
|
|
|
|
25
|
|
|
|
|
|
|
use Device::PiLite; |
26
|
|
|
|
|
|
|
|
27
|
|
|
|
|
|
|
my $pilite = Device::PiLite->new(); |
28
|
|
|
|
|
|
|
|
29
|
|
|
|
|
|
|
$p->all_off(); |
30
|
|
|
|
|
|
|
|
31
|
|
|
|
|
|
|
$p->text("This is a test"); |
32
|
|
|
|
|
|
|
|
33
|
|
|
|
|
|
|
$p->all_off(); |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
|
36
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
=cut |
38
|
|
|
|
|
|
|
|
39
|
|
|
|
|
|
|
=head2 DESCRIPTION |
40
|
|
|
|
|
|
|
|
41
|
|
|
|
|
|
|
This module provides an interface for the Ciseco Pi-Lite for the Raspberry Pi. |
42
|
|
|
|
|
|
|
|
43
|
|
|
|
|
|
|
The Pi-Lite has a 14 x 9 grid of LEDs controlled by an embedded ATMEL AVR |
44
|
|
|
|
|
|
|
microcontroller that itself can be programmed using the Arduino toolchain, |
45
|
|
|
|
|
|
|
however the default firmware provides a relatively simple mechanism to |
46
|
|
|
|
|
|
|
communicate with the board from the Raspberry Pi's TTL serial port. |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
Device::PiLite requires the default firmware and will not work if the Pi-Lite |
49
|
|
|
|
|
|
|
is loaded with some other sketch. |
50
|
|
|
|
|
|
|
|
51
|
|
|
|
|
|
|
=head2 CONFIGURING FOR THE PI-LITE |
52
|
|
|
|
|
|
|
|
53
|
|
|
|
|
|
|
By default most Linux distributions for the Raspberry Pi will use the serial |
54
|
|
|
|
|
|
|
port for a console, this will interfere with the functioning of the |
55
|
|
|
|
|
|
|
Pi-Lite. Before you try to use the device you will need to turn this off, and |
56
|
|
|
|
|
|
|
instructions for a Debian based distribution can be found at: |
57
|
|
|
|
|
|
|
|
58
|
|
|
|
|
|
|
http://openmicros.org/index.php/articles/94-ciseco-product-documentation/raspberry-pi/283-setting-up-my-raspberry-pi |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
If you are using a distribution with a different base (such as e.g. Pidora,) |
61
|
|
|
|
|
|
|
it may use C<systemd> rather than an inittab to start the console process and |
62
|
|
|
|
|
|
|
you will need to use C<systemctl> to disable the C<getty> service. You will |
63
|
|
|
|
|
|
|
still need to alter the C<cmdline.txt> as described in the above instructions. |
64
|
|
|
|
|
|
|
|
65
|
|
|
|
|
|
|
Any users that want to access the Pi-Lite will need to be in the C<dialout> |
66
|
|
|
|
|
|
|
group, which can be done by doing: |
67
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sudo usermod -a -G dialout username |
69
|
|
|
|
|
|
|
|
70
|
|
|
|
|
|
|
at the command line, where username is the user you want to add to the group. |
71
|
|
|
|
|
|
|
|
72
|
|
|
|
|
|
|
=head2 METHODS |
73
|
|
|
|
|
|
|
|
74
|
|
|
|
|
|
|
=cut |
75
|
|
|
|
|
|
|
|
76
|
|
|
|
|
|
|
=over 4 |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
=item serial_device |
79
|
|
|
|
|
|
|
|
80
|
|
|
|
|
|
|
This is the name of the serial device to be used. |
81
|
|
|
|
|
|
|
|
82
|
|
|
|
|
|
|
The default is "/dev/ttyAMA0". If it is to be |
83
|
|
|
|
|
|
|
set to another value this should be provided to the |
84
|
|
|
|
|
|
|
constructor. |
85
|
|
|
|
|
|
|
|
86
|
|
|
|
|
|
|
=cut |
87
|
|
|
|
|
|
|
|
88
|
|
|
|
|
|
|
has serial_device => ( |
89
|
|
|
|
|
|
|
is => 'rw', |
90
|
|
|
|
|
|
|
isa => 'Str', |
91
|
|
|
|
|
|
|
default => '/dev/ttyAMA0', |
92
|
|
|
|
|
|
|
); |
93
|
|
|
|
|
|
|
|
94
|
|
|
|
|
|
|
=item device_serialport |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
This is the L<Device::SerialPort> that will be used to perform the |
97
|
|
|
|
|
|
|
actual communication with the Pi-Lite, configured as appropriate. |
98
|
|
|
|
|
|
|
|
99
|
|
|
|
|
|
|
This delegates a number of methods and probably doesn't need to be |
100
|
|
|
|
|
|
|
used directly. |
101
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
=cut |
103
|
|
|
|
|
|
|
|
104
|
|
|
|
|
|
|
has device_serialport => ( |
105
|
|
|
|
|
|
|
is => 'rw', |
106
|
|
|
|
|
|
|
isa => 'Device::SerialPort', |
107
|
|
|
|
|
|
|
lazy => 1, |
108
|
|
|
|
|
|
|
builder => '_get_device_serialport', |
109
|
|
|
|
|
|
|
handles => { |
110
|
|
|
|
|
|
|
serial_write => 'write', |
111
|
|
|
|
|
|
|
serial_read => 'read', |
112
|
|
|
|
|
|
|
serial_input => 'input', |
113
|
|
|
|
|
|
|
serial_look => 'lookfor', |
114
|
|
|
|
|
|
|
write_done => 'write_done', |
115
|
|
|
|
|
|
|
lastlook => 'lastlook', |
116
|
|
|
|
|
|
|
}, |
117
|
|
|
|
|
|
|
); |
118
|
|
|
|
|
|
|
|
119
|
|
|
|
|
|
|
sub _get_device_serialport |
120
|
|
|
|
|
|
|
{ |
121
|
|
|
|
|
|
|
my ( $self ) = @_; |
122
|
|
|
|
|
|
|
|
123
|
|
|
|
|
|
|
require Device::SerialPort; |
124
|
|
|
|
|
|
|
|
125
|
|
|
|
|
|
|
my $dev = Device::SerialPort->new($self->serial_device()); |
126
|
|
|
|
|
|
|
$dev->baudrate(9600); |
127
|
|
|
|
|
|
|
$dev->databits(8); |
128
|
|
|
|
|
|
|
$dev->parity("none"); |
129
|
|
|
|
|
|
|
$dev->stopbits(1); |
130
|
|
|
|
|
|
|
$dev->datatype('raw'); |
131
|
|
|
|
|
|
|
$dev->write_settings(); |
132
|
|
|
|
|
|
|
$dev->are_match('-re', "\r\n"); |
133
|
|
|
|
|
|
|
|
134
|
|
|
|
|
|
|
return $dev; |
135
|
|
|
|
|
|
|
|
136
|
|
|
|
|
|
|
} |
137
|
|
|
|
|
|
|
|
138
|
|
|
|
|
|
|
=item all_on |
139
|
|
|
|
|
|
|
|
140
|
|
|
|
|
|
|
Turns all the LEDs on. |
141
|
|
|
|
|
|
|
|
142
|
|
|
|
|
|
|
=cut |
143
|
|
|
|
|
|
|
|
144
|
|
|
|
|
|
|
sub all_on |
145
|
|
|
|
|
|
|
{ |
146
|
|
|
|
|
|
|
my ( $self ) = @_; |
147
|
|
|
|
|
|
|
return $self->_on_off(1); |
148
|
|
|
|
|
|
|
} |
149
|
|
|
|
|
|
|
|
150
|
|
|
|
|
|
|
=item all_off |
151
|
|
|
|
|
|
|
|
152
|
|
|
|
|
|
|
Turns all the LEDs off. |
153
|
|
|
|
|
|
|
|
154
|
|
|
|
|
|
|
=cut |
155
|
|
|
|
|
|
|
|
156
|
|
|
|
|
|
|
sub all_off |
157
|
|
|
|
|
|
|
{ |
158
|
|
|
|
|
|
|
my ( $self ) = @_; |
159
|
|
|
|
|
|
|
return $self->_on_off(0); |
160
|
|
|
|
|
|
|
} |
161
|
|
|
|
|
|
|
|
162
|
|
|
|
|
|
|
=item _on_off |
163
|
|
|
|
|
|
|
|
164
|
|
|
|
|
|
|
Turns the pixels on or off depending on the boolean supplied. |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
=cut |
167
|
|
|
|
|
|
|
|
168
|
|
|
|
|
|
|
sub _on_off |
169
|
|
|
|
|
|
|
{ |
170
|
|
|
|
|
|
|
my ( $self, $switch ) = @_; |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
my $state = 'OFF'; |
173
|
|
|
|
|
|
|
|
174
|
|
|
|
|
|
|
if ( $switch ) |
175
|
|
|
|
|
|
|
{ |
176
|
|
|
|
|
|
|
$state = 'ON'; |
177
|
|
|
|
|
|
|
} |
178
|
|
|
|
|
|
|
return $self->send_command("ALL,%s", $state); |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
|
|
|
|
|
|
=item set_scroll |
182
|
|
|
|
|
|
|
|
183
|
|
|
|
|
|
|
This sets the scroll delay in milliseconds per pixel. The default is |
184
|
|
|
|
|
|
|
80 (that is to say it will take 1.120 seconds to scroll the entire width |
185
|
|
|
|
|
|
|
of the screen.) |
186
|
|
|
|
|
|
|
|
187
|
|
|
|
|
|
|
=cut |
188
|
|
|
|
|
|
|
|
189
|
|
|
|
|
|
|
sub set_scroll |
190
|
|
|
|
|
|
|
{ |
191
|
|
|
|
|
|
|
my ( $self, $rate ) = @_; |
192
|
|
|
|
|
|
|
if ( defined $rate ) |
193
|
|
|
|
|
|
|
{ |
194
|
|
|
|
|
|
|
$self->send_command("SPEED%d", $rate ); |
195
|
|
|
|
|
|
|
$self->_scroll_rate($rate); |
196
|
|
|
|
|
|
|
} |
197
|
|
|
|
|
|
|
} |
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
has _scroll_rate => ( |
200
|
|
|
|
|
|
|
is => 'rw', |
201
|
|
|
|
|
|
|
isa => 'Int', |
202
|
|
|
|
|
|
|
default => 80, |
203
|
|
|
|
|
|
|
); |
204
|
|
|
|
|
|
|
|
205
|
|
|
|
|
|
|
|
206
|
|
|
|
|
|
|
=item text |
207
|
|
|
|
|
|
|
|
208
|
|
|
|
|
|
|
This writes the provided test to the Pi-Lite. Scrolling as necessary |
209
|
|
|
|
|
|
|
at the configured rate. |
210
|
|
|
|
|
|
|
|
211
|
|
|
|
|
|
|
It won't return until all the text has been displayed, but you may want to |
212
|
|
|
|
|
|
|
pause for $columns * $scroll_rate milliseconds before doing anything else |
213
|
|
|
|
|
|
|
if you want the text to completely scroll off the screen. |
214
|
|
|
|
|
|
|
|
215
|
|
|
|
|
|
|
The ability or otherwise to display non-ASCII characters is entirely the |
216
|
|
|
|
|
|
|
responsibility of the firmware on the Pi-Lite (it uses a character to pixel |
217
|
|
|
|
|
|
|
map to draw the characters.) |
218
|
|
|
|
|
|
|
|
219
|
|
|
|
|
|
|
=cut |
220
|
|
|
|
|
|
|
|
221
|
|
|
|
|
|
|
sub text |
222
|
|
|
|
|
|
|
{ |
223
|
|
|
|
|
|
|
my ( $self, $text ) = @_; |
224
|
|
|
|
|
|
|
|
225
|
|
|
|
|
|
|
my $rc; |
226
|
|
|
|
|
|
|
|
227
|
|
|
|
|
|
|
if ( $text ) |
228
|
|
|
|
|
|
|
{ |
229
|
|
|
|
|
|
|
$rc = $self->serial_write( $text . "\r"); |
230
|
|
|
|
|
|
|
} |
231
|
|
|
|
|
|
|
|
232
|
|
|
|
|
|
|
return $rc; |
233
|
|
|
|
|
|
|
} |
234
|
|
|
|
|
|
|
|
235
|
|
|
|
|
|
|
=item frame_buffer |
236
|
|
|
|
|
|
|
|
237
|
|
|
|
|
|
|
This writes every pixel in the Pi-Lite in one go, the argument is a |
238
|
|
|
|
|
|
|
126 character string where each character is a 1 or 0 that indicates |
239
|
|
|
|
|
|
|
the state of a pixel, starting from 1,1 (i.e. top left) to 14,9 |
240
|
|
|
|
|
|
|
(bottom right.) |
241
|
|
|
|
|
|
|
|
242
|
|
|
|
|
|
|
=cut |
243
|
|
|
|
|
|
|
|
244
|
|
|
|
|
|
|
sub frame_buffer |
245
|
|
|
|
|
|
|
{ |
246
|
|
|
|
|
|
|
my ( $self, $frame ) = @_; |
247
|
|
|
|
|
|
|
|
248
|
|
|
|
|
|
|
my $rc; |
249
|
|
|
|
|
|
|
|
250
|
|
|
|
|
|
|
if ( defined $frame ) |
251
|
|
|
|
|
|
|
{ |
252
|
|
|
|
|
|
|
$rc = $self->send_command("F%s", $frame); |
253
|
|
|
|
|
|
|
} |
254
|
|
|
|
|
|
|
return $rc; |
255
|
|
|
|
|
|
|
} |
256
|
|
|
|
|
|
|
|
257
|
|
|
|
|
|
|
=item bargraph |
258
|
|
|
|
|
|
|
|
259
|
|
|
|
|
|
|
The bargraph comprises 14 columns with values expressed as 0-100% (the |
260
|
|
|
|
|
|
|
resolution is only 9 rows however,) The takes the column number (1-14) |
261
|
|
|
|
|
|
|
and the value as arguments and sets the appropriate column. |
262
|
|
|
|
|
|
|
|
263
|
|
|
|
|
|
|
=cut |
264
|
|
|
|
|
|
|
|
265
|
|
|
|
|
|
|
sub bargraph |
266
|
|
|
|
|
|
|
{ |
267
|
|
|
|
|
|
|
my ( $self, $column, $value ) = @_; |
268
|
|
|
|
|
|
|
|
269
|
|
|
|
|
|
|
my $rc; |
270
|
|
|
|
|
|
|
|
271
|
|
|
|
|
|
|
if ( defined $value ) |
272
|
|
|
|
|
|
|
{ |
273
|
|
|
|
|
|
|
if ( $self->valid_column($column) ) |
274
|
|
|
|
|
|
|
{ |
275
|
|
|
|
|
|
|
$rc = $self->send_command("B%i,%i", $column, $value); |
276
|
|
|
|
|
|
|
} |
277
|
|
|
|
|
|
|
} |
278
|
|
|
|
|
|
|
|
279
|
|
|
|
|
|
|
return $rc; |
280
|
|
|
|
|
|
|
} |
281
|
|
|
|
|
|
|
|
282
|
|
|
|
|
|
|
=item vu_meter |
283
|
|
|
|
|
|
|
|
284
|
|
|
|
|
|
|
This sets one channel of the "vu meter" which is a horizontal two bar |
285
|
|
|
|
|
|
|
graph, with values expressed 1-100%. The arguments are the channel number |
286
|
|
|
|
|
|
|
1 or 2 and the value. |
287
|
|
|
|
|
|
|
|
288
|
|
|
|
|
|
|
=cut |
289
|
|
|
|
|
|
|
|
290
|
|
|
|
|
|
|
sub vu_meter |
291
|
|
|
|
|
|
|
{ |
292
|
|
|
|
|
|
|
my ( $self, $channel, $value ) = @_; |
293
|
|
|
|
|
|
|
|
294
|
|
|
|
|
|
|
my $rc; |
295
|
|
|
|
|
|
|
|
296
|
|
|
|
|
|
|
if ( defined $value ) |
297
|
|
|
|
|
|
|
{ |
298
|
|
|
|
|
|
|
if ( $self->valid_axis($channel,2)) |
299
|
|
|
|
|
|
|
{ |
300
|
|
|
|
|
|
|
$rc = $self->send_command("V%i,%i", $channel, $value); |
301
|
|
|
|
|
|
|
} |
302
|
|
|
|
|
|
|
} |
303
|
|
|
|
|
|
|
|
304
|
|
|
|
|
|
|
return $rc; |
305
|
|
|
|
|
|
|
} |
306
|
|
|
|
|
|
|
|
307
|
|
|
|
|
|
|
=item pixel_on |
308
|
|
|
|
|
|
|
|
309
|
|
|
|
|
|
|
Turns the pixel specified by $column, $row on. |
310
|
|
|
|
|
|
|
|
311
|
|
|
|
|
|
|
=cut |
312
|
|
|
|
|
|
|
|
313
|
|
|
|
|
|
|
sub pixel_on |
314
|
|
|
|
|
|
|
{ |
315
|
|
|
|
|
|
|
my ( $self, $column, $row ) = @_; |
316
|
|
|
|
|
|
|
|
317
|
|
|
|
|
|
|
return $self->pixel_action(1, $column, $row); |
318
|
|
|
|
|
|
|
} |
319
|
|
|
|
|
|
|
|
320
|
|
|
|
|
|
|
=item pixel_off |
321
|
|
|
|
|
|
|
|
322
|
|
|
|
|
|
|
Turns the pixel specified by $column, $row off. |
323
|
|
|
|
|
|
|
|
324
|
|
|
|
|
|
|
=cut |
325
|
|
|
|
|
|
|
|
326
|
|
|
|
|
|
|
sub pixel_off |
327
|
|
|
|
|
|
|
{ |
328
|
|
|
|
|
|
|
my ( $self, $column, $row ) = @_; |
329
|
|
|
|
|
|
|
|
330
|
|
|
|
|
|
|
return $self->pixel_action(0, $column, $row); |
331
|
|
|
|
|
|
|
} |
332
|
|
|
|
|
|
|
|
333
|
|
|
|
|
|
|
=item pixel_toggle |
334
|
|
|
|
|
|
|
|
335
|
|
|
|
|
|
|
Toggles the pixel specified by $column, $row . |
336
|
|
|
|
|
|
|
|
337
|
|
|
|
|
|
|
=cut |
338
|
|
|
|
|
|
|
|
339
|
|
|
|
|
|
|
sub pixel_toggle |
340
|
|
|
|
|
|
|
{ |
341
|
|
|
|
|
|
|
my ( $self, $column, $row ) = @_; |
342
|
|
|
|
|
|
|
|
343
|
|
|
|
|
|
|
return $self->pixel_action(2, $column, $row); |
344
|
|
|
|
|
|
|
} |
345
|
|
|
|
|
|
|
|
346
|
|
|
|
|
|
|
=item pixel_action |
347
|
|
|
|
|
|
|
|
348
|
|
|
|
|
|
|
This performs the specified action 'ON' (1), 'OFF' (0), 'TOGGLE' (2) |
349
|
|
|
|
|
|
|
on the pixel specified by column and row. This is used by C<pixel_on>, |
350
|
|
|
|
|
|
|
C<pixel_off> and C<pixel_toggle> internally but may be useful if the |
351
|
|
|
|
|
|
|
state is to be computed. |
352
|
|
|
|
|
|
|
|
353
|
|
|
|
|
|
|
=cut |
354
|
|
|
|
|
|
|
|
355
|
|
|
|
|
|
|
sub pixel_action |
356
|
|
|
|
|
|
|
{ |
357
|
|
|
|
|
|
|
my ( $self, $action, $column, $row ) = @_; |
358
|
|
|
|
|
|
|
|
359
|
|
|
|
|
|
|
my $rc; |
360
|
|
|
|
|
|
|
if (defined(my $verb = $self->_get_action($action))) |
361
|
|
|
|
|
|
|
{ |
362
|
|
|
|
|
|
|
if ( $self->valid_column($column) && $self->valid_row($row) ) |
363
|
|
|
|
|
|
|
{ |
364
|
|
|
|
|
|
|
$rc = $self->send_command("P%i,%i,%s", $column, $row, $verb); |
365
|
|
|
|
|
|
|
} |
366
|
|
|
|
|
|
|
} |
367
|
|
|
|
|
|
|
return $rc; |
368
|
|
|
|
|
|
|
} |
369
|
|
|
|
|
|
|
|
370
|
|
|
|
|
|
|
|
371
|
|
|
|
|
|
|
sub _get_action |
372
|
|
|
|
|
|
|
{ |
373
|
|
|
|
|
|
|
my ( $self, $action ) = @_; |
374
|
|
|
|
|
|
|
|
375
|
|
|
|
|
|
|
my $rc; |
376
|
|
|
|
|
|
|
if ( defined $action ) |
377
|
|
|
|
|
|
|
{ |
378
|
|
|
|
|
|
|
$rc = $self->_actions()->[$action]; |
379
|
|
|
|
|
|
|
} |
380
|
|
|
|
|
|
|
return $rc; |
381
|
|
|
|
|
|
|
|
382
|
|
|
|
|
|
|
|
383
|
|
|
|
|
|
|
} |
384
|
|
|
|
|
|
|
|
385
|
|
|
|
|
|
|
has _actions => ( |
386
|
|
|
|
|
|
|
is => 'ro', |
387
|
|
|
|
|
|
|
isa => 'ArrayRef', |
388
|
|
|
|
|
|
|
default => sub { [qw(OFF ON TOGGLE)] }, |
389
|
|
|
|
|
|
|
); |
390
|
|
|
|
|
|
|
|
391
|
|
|
|
|
|
|
|
392
|
|
|
|
|
|
|
=item scroll |
393
|
|
|
|
|
|
|
|
394
|
|
|
|
|
|
|
This scrolls by the number of columns left or right, a negative |
395
|
|
|
|
|
|
|
value will shift to the right, positive shift to the left. |
396
|
|
|
|
|
|
|
|
397
|
|
|
|
|
|
|
Once a pixel is off the display it won't come back when you scroll |
398
|
|
|
|
|
|
|
it back as there is no buffer. |
399
|
|
|
|
|
|
|
|
400
|
|
|
|
|
|
|
|
401
|
|
|
|
|
|
|
=cut |
402
|
|
|
|
|
|
|
|
403
|
|
|
|
|
|
|
sub scroll |
404
|
|
|
|
|
|
|
{ |
405
|
|
|
|
|
|
|
my ( $self, $cols ) = @_; |
406
|
|
|
|
|
|
|
|
407
|
|
|
|
|
|
|
my $rc; |
408
|
|
|
|
|
|
|
if (looks_like_number($cols) && $self->valid_column(abs($cols))) |
409
|
|
|
|
|
|
|
{ |
410
|
|
|
|
|
|
|
$rc = $self->send_command("SCROLL%i", $cols); |
411
|
|
|
|
|
|
|
} |
412
|
|
|
|
|
|
|
return $rc; |
413
|
|
|
|
|
|
|
} |
414
|
|
|
|
|
|
|
|
415
|
|
|
|
|
|
|
=item character |
416
|
|
|
|
|
|
|
|
417
|
|
|
|
|
|
|
This displays the specified single character at $column, $row. |
418
|
|
|
|
|
|
|
|
419
|
|
|
|
|
|
|
If the character would be partially off the screen it won't be displayed. |
420
|
|
|
|
|
|
|
|
421
|
|
|
|
|
|
|
As with C<text()> above, this is unlikely to work well with non-ASCII |
422
|
|
|
|
|
|
|
characters. |
423
|
|
|
|
|
|
|
|
424
|
|
|
|
|
|
|
=cut |
425
|
|
|
|
|
|
|
|
426
|
|
|
|
|
|
|
sub character |
427
|
|
|
|
|
|
|
{ |
428
|
|
|
|
|
|
|
my ( $self, $column, $row, $char ) = @_; |
429
|
|
|
|
|
|
|
|
430
|
|
|
|
|
|
|
my $rc; |
431
|
|
|
|
|
|
|
if (defined $char && length $char ) |
432
|
|
|
|
|
|
|
{ |
433
|
|
|
|
|
|
|
if ( $self->valid_column($column) && $self->valid_row($row)) |
434
|
|
|
|
|
|
|
{ |
435
|
|
|
|
|
|
|
$rc = $self->send_command("T%i,%i,%s", $column, $row, $char); |
436
|
|
|
|
|
|
|
} |
437
|
|
|
|
|
|
|
} |
438
|
|
|
|
|
|
|
return $rc; |
439
|
|
|
|
|
|
|
} |
440
|
|
|
|
|
|
|
|
441
|
|
|
|
|
|
|
|
442
|
|
|
|
|
|
|
=item columns |
443
|
|
|
|
|
|
|
|
444
|
|
|
|
|
|
|
This is the number of columns on the Pi-Lite. This is almost |
445
|
|
|
|
|
|
|
certainly 14. |
446
|
|
|
|
|
|
|
|
447
|
|
|
|
|
|
|
=cut |
448
|
|
|
|
|
|
|
|
449
|
|
|
|
|
|
|
has columns => ( |
450
|
|
|
|
|
|
|
is => 'rw', |
451
|
|
|
|
|
|
|
isa => 'Int', |
452
|
|
|
|
|
|
|
default => 14, |
453
|
|
|
|
|
|
|
); |
454
|
|
|
|
|
|
|
|
455
|
|
|
|
|
|
|
=item valid_column |
456
|
|
|
|
|
|
|
|
457
|
|
|
|
|
|
|
Returns a boolean to indicate whether it is an integer between 1 and |
458
|
|
|
|
|
|
|
C<columns>. |
459
|
|
|
|
|
|
|
|
460
|
|
|
|
|
|
|
=cut |
461
|
|
|
|
|
|
|
|
462
|
|
|
|
|
|
|
sub valid_column |
463
|
|
|
|
|
|
|
{ |
464
|
|
|
|
|
|
|
my ( $self, $column ) = @_; |
465
|
|
|
|
|
|
|
|
466
|
|
|
|
|
|
|
my $rc = $self->valid_axis($column, $self->columns()); |
467
|
|
|
|
|
|
|
return $rc ; |
468
|
|
|
|
|
|
|
} |
469
|
|
|
|
|
|
|
|
470
|
|
|
|
|
|
|
=item rows |
471
|
|
|
|
|
|
|
|
472
|
|
|
|
|
|
|
This is the number of rows on the Pi-Lite. This is almost |
473
|
|
|
|
|
|
|
certainly 9. |
474
|
|
|
|
|
|
|
|
475
|
|
|
|
|
|
|
=cut |
476
|
|
|
|
|
|
|
|
477
|
|
|
|
|
|
|
has rows => ( |
478
|
|
|
|
|
|
|
is => 'rw', |
479
|
|
|
|
|
|
|
isa => 'Int', |
480
|
|
|
|
|
|
|
default => 9, |
481
|
|
|
|
|
|
|
); |
482
|
|
|
|
|
|
|
|
483
|
|
|
|
|
|
|
=item valid_row |
484
|
|
|
|
|
|
|
|
485
|
|
|
|
|
|
|
Returns a boolean to indicate whether it is an integer between 1 and |
486
|
|
|
|
|
|
|
C<rows>. |
487
|
|
|
|
|
|
|
|
488
|
|
|
|
|
|
|
=cut |
489
|
|
|
|
|
|
|
|
490
|
|
|
|
|
|
|
sub valid_row |
491
|
|
|
|
|
|
|
{ |
492
|
|
|
|
|
|
|
my ( $self, $row ) = @_; |
493
|
|
|
|
|
|
|
|
494
|
|
|
|
|
|
|
my $rc = $self->valid_axis($row, $self->rows()); |
495
|
|
|
|
|
|
|
return $rc ; |
496
|
|
|
|
|
|
|
} |
497
|
|
|
|
|
|
|
|
498
|
|
|
|
|
|
|
=item valid_axis |
499
|
|
|
|
|
|
|
|
500
|
|
|
|
|
|
|
Return a boolean to indicate $value is greater ot equal to 1 |
501
|
|
|
|
|
|
|
and smaller or equal to $bound. |
502
|
|
|
|
|
|
|
|
503
|
|
|
|
|
|
|
=cut |
504
|
|
|
|
|
|
|
|
505
|
|
|
|
|
|
|
sub valid_axis |
506
|
|
|
|
|
|
|
{ |
507
|
|
|
|
|
|
|
my ( $self, $value, $bound ) = @_; |
508
|
|
|
|
|
|
|
|
509
|
|
|
|
|
|
|
my $rc = 0; |
510
|
|
|
|
|
|
|
if ( looks_like_number($value) && looks_like_number($bound)) |
511
|
|
|
|
|
|
|
{ |
512
|
|
|
|
|
|
|
if ($value >= 1 && $value <= $bound) |
513
|
|
|
|
|
|
|
{ |
514
|
|
|
|
|
|
|
$rc = 1; |
515
|
|
|
|
|
|
|
} |
516
|
|
|
|
|
|
|
} |
517
|
|
|
|
|
|
|
return $rc ; |
518
|
|
|
|
|
|
|
} |
519
|
|
|
|
|
|
|
|
520
|
|
|
|
|
|
|
=item cmd_prefix |
521
|
|
|
|
|
|
|
|
522
|
|
|
|
|
|
|
A Pi-Lite serial command sequenced is introduced by sending '$$$'. |
523
|
|
|
|
|
|
|
|
524
|
|
|
|
|
|
|
=cut |
525
|
|
|
|
|
|
|
|
526
|
|
|
|
|
|
|
has cmd_prefix => ( |
527
|
|
|
|
|
|
|
is => 'rw', |
528
|
|
|
|
|
|
|
isa => 'Str', |
529
|
|
|
|
|
|
|
default => '$$$', |
530
|
|
|
|
|
|
|
); |
531
|
|
|
|
|
|
|
|
532
|
|
|
|
|
|
|
=item send_prefix |
533
|
|
|
|
|
|
|
|
534
|
|
|
|
|
|
|
Write the prefix to the device. And wait for the response 'OK'. |
535
|
|
|
|
|
|
|
|
536
|
|
|
|
|
|
|
It will return a boolean value to indicate the success or |
537
|
|
|
|
|
|
|
otherwise of the write. |
538
|
|
|
|
|
|
|
|
539
|
|
|
|
|
|
|
=cut |
540
|
|
|
|
|
|
|
|
541
|
|
|
|
|
|
|
sub send_prefix |
542
|
|
|
|
|
|
|
{ |
543
|
|
|
|
|
|
|
my ( $self ) = @_; |
544
|
|
|
|
|
|
|
|
545
|
|
|
|
|
|
|
my $rc = 0; |
546
|
|
|
|
|
|
|
my $count = $self->serial_write($self->cmd_prefix()); |
547
|
|
|
|
|
|
|
$self->write_done(1); |
548
|
|
|
|
|
|
|
|
549
|
|
|
|
|
|
|
if ( $count == length($self->cmd_prefix())) |
550
|
|
|
|
|
|
|
{ |
551
|
|
|
|
|
|
|
my $string = ""; |
552
|
|
|
|
|
|
|
while ( !$string ) |
553
|
|
|
|
|
|
|
{ |
554
|
|
|
|
|
|
|
if (!defined($string = $self->serial_look() )) |
555
|
|
|
|
|
|
|
{ |
556
|
|
|
|
|
|
|
croak "Read abort without input\n"; |
557
|
|
|
|
|
|
|
} |
558
|
|
|
|
|
|
|
} |
559
|
|
|
|
|
|
|
$rc = 1; |
560
|
|
|
|
|
|
|
} |
561
|
|
|
|
|
|
|
|
562
|
|
|
|
|
|
|
return $rc; |
563
|
|
|
|
|
|
|
} |
564
|
|
|
|
|
|
|
|
565
|
|
|
|
|
|
|
=item send_command |
566
|
|
|
|
|
|
|
|
567
|
|
|
|
|
|
|
This sends a command to the Pi-Lite, sending the command prefix and the |
568
|
|
|
|
|
|
|
command constructed by $format and @arguments which are dealt with by |
569
|
|
|
|
|
|
|
C<_build_command>. |
570
|
|
|
|
|
|
|
|
571
|
|
|
|
|
|
|
=cut |
572
|
|
|
|
|
|
|
|
573
|
|
|
|
|
|
|
sub send_command |
574
|
|
|
|
|
|
|
{ |
575
|
|
|
|
|
|
|
my ( $self, $format, @arguments ) = @_; |
576
|
|
|
|
|
|
|
|
577
|
|
|
|
|
|
|
my $rc; |
578
|
|
|
|
|
|
|
if ( my $cmd_str = $self->_build_command($format, @arguments )) |
579
|
|
|
|
|
|
|
{ |
580
|
|
|
|
|
|
|
if ( $self->send_prefix() ) |
581
|
|
|
|
|
|
|
{ |
582
|
|
|
|
|
|
|
$rc = $self->serial_write($cmd_str); |
583
|
|
|
|
|
|
|
} |
584
|
|
|
|
|
|
|
} |
585
|
|
|
|
|
|
|
return $rc; |
586
|
|
|
|
|
|
|
} |
587
|
|
|
|
|
|
|
|
588
|
|
|
|
|
|
|
|
589
|
|
|
|
|
|
|
=item _build_command |
590
|
|
|
|
|
|
|
|
591
|
|
|
|
|
|
|
This returns the command string constructed from the sprintf format |
592
|
|
|
|
|
|
|
specified by $format and the set of replacements in @arguments. |
593
|
|
|
|
|
|
|
|
594
|
|
|
|
|
|
|
=cut |
595
|
|
|
|
|
|
|
|
596
|
|
|
|
|
|
|
sub _build_command |
597
|
|
|
|
|
|
|
{ |
598
|
|
|
|
|
|
|
my ( $self, $format, @arguments ) = @_; |
599
|
|
|
|
|
|
|
|
600
|
|
|
|
|
|
|
my $command; |
601
|
|
|
|
|
|
|
if ( $format && @arguments ) |
602
|
|
|
|
|
|
|
{ |
603
|
|
|
|
|
|
|
$format .= "\r"; |
604
|
|
|
|
|
|
|
$command = sprintf $format, @arguments; |
605
|
|
|
|
|
|
|
} |
606
|
|
|
|
|
|
|
return $command; |
607
|
|
|
|
|
|
|
} |
608
|
|
|
|
|
|
|
|
609
|
|
|
|
|
|
|
=back |
610
|
|
|
|
|
|
|
|
611
|
|
|
|
|
|
|
=head1 AUTHOR |
612
|
|
|
|
|
|
|
|
613
|
|
|
|
|
|
|
Jonathan Stowe, C<< <jns at gellyfish.co.uk> >> |
614
|
|
|
|
|
|
|
|
615
|
|
|
|
|
|
|
=head1 BUGS |
616
|
|
|
|
|
|
|
|
617
|
|
|
|
|
|
|
This appears to work as documented but it is difficult to test that the |
618
|
|
|
|
|
|
|
device behaves as expected in all cases automatically. |
619
|
|
|
|
|
|
|
|
620
|
|
|
|
|
|
|
Automated test reports indicating failure will be largely ignored unless |
621
|
|
|
|
|
|
|
they indicate a problem with the tests themselves. |
622
|
|
|
|
|
|
|
|
623
|
|
|
|
|
|
|
Please feel free to suggest any features with a pull request at: |
624
|
|
|
|
|
|
|
|
625
|
|
|
|
|
|
|
https://github.com/jonathanstowe/Device-PiLite |
626
|
|
|
|
|
|
|
|
627
|
|
|
|
|
|
|
though I'd be disinclined to include anything that would require a change |
628
|
|
|
|
|
|
|
to the device's firmware as this is somewhat tricky to deploy. |
629
|
|
|
|
|
|
|
|
630
|
|
|
|
|
|
|
You can report bugs to C<bug-device-pilite@rt.cpan.org> but you should |
631
|
|
|
|
|
|
|
consider whether it is actually a bug in this code or that of the device, |
632
|
|
|
|
|
|
|
you can find the source for the firmware at: |
633
|
|
|
|
|
|
|
|
634
|
|
|
|
|
|
|
https://github.com/CisecoPlc/PiLite |
635
|
|
|
|
|
|
|
|
636
|
|
|
|
|
|
|
|
637
|
|
|
|
|
|
|
=head1 SUPPORT |
638
|
|
|
|
|
|
|
|
639
|
|
|
|
|
|
|
You can find documentation for this module with the perldoc command. |
640
|
|
|
|
|
|
|
|
641
|
|
|
|
|
|
|
perldoc Device::PiLite |
642
|
|
|
|
|
|
|
|
643
|
|
|
|
|
|
|
=head1 SEE ALSO |
644
|
|
|
|
|
|
|
|
645
|
|
|
|
|
|
|
L<Device::SerialPort> |
646
|
|
|
|
|
|
|
|
647
|
|
|
|
|
|
|
|
648
|
|
|
|
|
|
|
=head1 LICENSE AND COPYRIGHT |
649
|
|
|
|
|
|
|
|
650
|
|
|
|
|
|
|
Copyright 2014 Jonathan Stowe. |
651
|
|
|
|
|
|
|
|
652
|
|
|
|
|
|
|
This program is free software; you can redistribute it and/or modify it |
653
|
|
|
|
|
|
|
under the terms of either: the GNU General Public License as published |
654
|
|
|
|
|
|
|
by the Free Software Foundation; or the Artistic License. |
655
|
|
|
|
|
|
|
|
656
|
|
|
|
|
|
|
See L<http://dev.perl.org/licenses/> for more information. |
657
|
|
|
|
|
|
|
|
658
|
|
|
|
|
|
|
|
659
|
|
|
|
|
|
|
=cut |
660
|
|
|
|
|
|
|
|
661
|
|
|
|
|
|
|
1; |