File Coverage

blib/lib/Device/PiLite.pm
Criterion Covered Total %
statement 7 9 77.7
branch n/a
condition n/a
subroutine 3 3 100.0
pod n/a
total 10 12 83.3


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;