File Coverage

blib/lib/HiPi/Interface/MAX7219LEDStrip.pm
Criterion Covered Total %
statement 27 186 14.5
branch 0 34 0.0
condition 0 31 0.0
subroutine 9 31 29.0
pod 0 18 0.0
total 36 300 12.0


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::MAX7219LEDStrip
3             # Description : Interface to strip of MAX7219 driven LEDs
4             # Copyright : (c) 2018-2020 Mark Dootson
5             # License : This is free software; you can redistribute it and/or modify it under
6             # the same terms as the Perl 5 programming language system itself.
7             #########################################################################################
8              
9             package HiPi::Interface::MAX7219LEDStrip;
10              
11             #########################################################################################
12 1     1   1042 use strict;
  1         2  
  1         31  
13 1     1   5 use warnings;
  1         164  
  1         40  
14 1     1   7 use parent qw( HiPi::Interface );
  1         2  
  1         5  
15 1     1   61 use HiPi qw( :spi :rpi :max7219 );
  1         2  
  1         362  
16 1     1   8 use HiPi::Interface::MAX7219;
  1         1  
  1         51  
17 1     1   444 use HiPi::Utils::BitBuffer;
  1         3  
  1         47  
18 1     1   445 use HiPi::Graphics::Font5x7 qw( :font );
  1         3  
  1         128  
19 1     1   8 use Try::Tiny;
  1         3  
  1         50  
20 1     1   6 use Carp;
  1         2  
  1         2473  
21              
22             our $VERSION ='0.81';
23              
24             __PACKAGE__->create_ro_accessors( qw( segments pixel_width pixel_height reverse_map ) );
25              
26             __PACKAGE__->create_accessors( qw(
27             buffer
28             _rotate180
29             _scrollx
30             _scrolly
31             _mirror
32             _clear_on_exit
33             ) );
34              
35             sub new {
36 0     0 0   my ($class, %userparams) = @_;
37            
38 0           my %params = (
39             segments => 4,
40             _rotate180 => 0,
41             _scrollx => 0,
42             _scrolly => 0,
43             _mirror => 0,
44             _clear_on_exit => 1,
45             # SPI
46             devicename => '/dev/spidev0.0',
47             speed => 2000000,
48             delay => 0,
49             reverse_map => 0,
50             );
51            
52             # get user params
53 0           foreach my $key( keys (%userparams) ) {
54 0           my $paramkey = $key;
55 0           $paramkey =~ s/^_+//;
56 0           $params{$paramkey} = $userparams{$key};
57             }
58            
59 0           $params{pixel_width} = $params{segments} * 8;
60 0           $params{pixel_height} = 8;
61            
62             $params{buffer} = HiPi::Utils::BitBuffer->new(
63             width => $params{pixel_width},
64             height => $params{pixel_height},
65             autoresize => 1,
66 0           autoincrement => $params{segments} * 8,
67             );
68            
69 0 0         unless(defined($params{device})) {
70             $params{device} = HiPi::Interface::MAX7219->new(
71             speed => $params{speed},
72             delay => $params{delay},
73             devicename => $params{devicename},
74 0           );
75             }
76            
77 0           my $self = $class->SUPER::new(%params);
78            
79 0           HiPi->register_exit_method( $self, '_exit');
80            
81 0           for( my $segment = 0; $segment < $self->segments; $segment ++ ) {
82 0           $self->device->set_decode_mode( 0, $segment );
83 0           $self->device->set_scan_limit( 7, $segment );
84 0           $self->device->set_intensity( 2, $segment );
85 0           $self->device->set_display_test( 0, $segment );
86 0           $self->device->wake_up( $segment );
87             }
88            
89 0           return $self;
90             }
91              
92 0     0 0   sub width { $_[0]->buffer->width; }
93              
94 0     0 0   sub height { $_[0]->buffer->height; }
95              
96             sub clear {
97 0     0 0   my $self = shift;
98            
99 0           $self->buffer (
100             HiPi::Utils::BitBuffer->new(
101             width => $self->pixel_width,
102             height => $self->pixel_height,
103             autoresize => 1,
104             autoincrement => $self->pixel_width * 8,
105             )
106             );
107            
108 0           $self->_scrollx(0);
109 0           $self->_scrolly(0);
110 0           return;
111             }
112              
113             sub fill {
114 0     0 0   my ( $self, $val ) = @_;
115 0           $self->buffer->fill( $val );
116             }
117              
118             sub set_rotate180 {
119 0     0 0   my($self, $value) = @_;
120 0 0         $self->_rotate180( $value ? 1 : 0 );
121             }
122              
123             sub set_mirror {
124 0     0 0   my($self, $value) = @_;
125 0 0         $self->_mirror( $value ? 1 : 0 );
126             }
127              
128             sub set_clear_on_exit {
129 0     0 0   my($self, $value) = @_;
130 0 0         $self->_clear_on_exit( $value ? 1 : 0 );
131             }
132              
133             sub set_intensity {
134 0     0 0   my($self, $val) = @_;
135 0   0       $val //= 0;
136 0           $val = int($val);
137 0 0 0       if( $val > 15 || $val < 0 ) {
138 0           carp q(intensity value must be between 0 and 15 );
139             }
140            
141 0           for ( my $maxc = 0; $maxc < $self->segments; $maxc ++ ) {
142 0           $self->device->set_intensity( $val, $maxc );
143             }
144            
145 0           return;
146             }
147              
148             sub set_col {
149 0     0 0   my($self, $x, $col) = @_;
150            
151 0           for (my $y = 0; $y < 7; $y++) {
152 0           $self->set_pixel($x, $y, ($col & (1 << $y)) > 0);
153             }
154             }
155              
156             sub set_pixel {
157 0     0 0   my($self, $x, $y, $c) = @_;
158 0 0         $c = $c ? 1 : 0;
159 0           $self->buffer->set_bit($x, $y, $c);
160             }
161              
162             sub _get_char {
163 0     0     my $char = shift;
164 0   0       $char //= ' ';
165 0           my $char_ordinal;
166              
167 0     0     try { $char_ordinal = ord($char); };
  0            
168            
169 0 0 0       unless( $char_ordinal && exists( font_5_x_7->{$char_ordinal}) ) {
170 0           carp qq(Unsupported char $char);
171 0           $char_ordinal = 32;
172             }
173            
174 0           return font_5_x_7->{$char_ordinal};
175             }
176              
177             sub _handle_write_string_and_extents {
178 0     0     my($self, $string, $offset_x, $offset_y, $dowrite ) = @_;
179 0   0       $string //= '';
180 0   0       $offset_x ||= 0;
181 0   0       $offset_y ||= 0;
182            
183 0           my $pixels = 0;
184 0           for my $char ( split(//, $string) ) {
185              
186 0           my $char_data = _get_char($char);
187            
188 0           my @pixelcols = ();
189 0           my ($maxX, $minX);
190            
191 0           for (my $x = 0; $x < 5; $x ++ ) {
192            
193 0           my @pixelrows = ();
194 0           for ( my $y = 0; $y < 8; $y++ ) {
195            
196 0 0         my $val = (($char_data->[$x] & (1 << $y)) > 0) ? 1 : 0;
197            
198 0 0         if( $val ) {
199 0 0         $minX = $x unless(defined($minX));
200 0           $maxX = $x;
201             }
202            
203 0           push @pixelrows, [ $offset_x + $x, $offset_y + $y, $val ];
204             }
205            
206 0           push @pixelcols, \@pixelrows;
207             }
208            
209            
210 0 0         if(defined($minX)) {
211 0           my $shiftcount = $minX;
212 0           for (my $x = 0; $x < $shiftcount; $x ++) {
213 0           shift @pixelcols;
214             }
215            
216 0           for (my $x = $maxX; $x < 4; $x++) {
217 0           pop @pixelcols;
218             }
219            
220             # adjust x values
221 0           for my $col( @pixelcols ) {
222 0           for my $row ( @$col ) {
223 0           $row->[0] -= $shiftcount;
224             }
225             }
226            
227             # add gap
228 0           my @pixelrows = ();
229 0           my $gapoffset = scalar @pixelcols;
230 0           for ( my $y = 0; $y < 8; $y++ ) {
231 0           push @pixelrows, [ $offset_x + $gapoffset + 1, $offset_y + $y, 0 ];
232             }
233 0           push @pixelcols, \@pixelrows;
234             } else {
235             # a space - 2 rows - get rid of final 3
236 0           pop @pixelcols;
237 0           pop @pixelcols;
238 0           pop @pixelcols;
239             }
240            
241            
242 0           my $charpixels = scalar @pixelcols;
243 0           $offset_x += $charpixels;
244 0           $pixels += $charpixels;
245            
246 0 0         if( $dowrite ) {
247 0           for my $col ( @pixelcols ) {
248 0           for my $row ( @$col ) {
249 0           $self->set_pixel( @$row );
250             }
251             }
252             }
253             }
254            
255 0           return $pixels;
256             }
257              
258             sub write_string {
259 0     0 0   my($self, $string, $offset_x, $offset_y ) = @_;
260 0           return $self->_handle_write_string_and_extents( $string, $offset_x, $offset_y, 1 );
261             }
262              
263             sub get_string_extents {
264 0     0 0   my($self, $string ) = @_;
265 0           return $self->_handle_write_string_and_extents( $string, 0, 0, 0 );
266             }
267              
268             sub show {
269 0     0 0   my $self = shift;
270            
271 0           my $databuf = $self->buffer->clone_buffer;
272            
273             # scroll it etc
274 0           $databuf->scroll_x_y( $self->_scrollx, $self->_scrolly);
275            
276 0 0         $databuf->mirror($self->pixel_width, $self->pixel_height) if $self->_mirror;
277            
278 0 0         $databuf->flip($self->pixel_width, $self->pixel_height) if $self->_rotate180;
279            
280 0           my @linebuffers = ([], [], [], [], [], [], [], []);
281            
282 0           my $maxsegment = $self->segments - 1;
283            
284 0           for (my $segment = 0; $segment < $self->segments; $segment ++) {
285 0           my $offset_x = ( $maxsegment - $segment ) * 8;
286            
287 0           my @buffer = ( 0 ) x 8;
288            
289 0           for ( my $x = 0; $x < 8; $x++) {
290 0           for ( my $y = 0; $y < 8; $y++) {
291 0           my $val = $databuf->get_bit( $offset_x + $x, $y );
292 0 0         if( $self->reverse_map ) {
293 0           $buffer[$y] += ( $val << $x );
294             } else {
295 0           $buffer[$y] += ( $val << ( 7 - $x ) );
296             }
297             }
298             }
299            
300 0           for (my $buffrow = 0; $buffrow < 8; $buffrow ++) {
301 0           unshift @{ $linebuffers[$buffrow] }, ( MAX7219_REG_DIGIT_0 + $buffrow, $buffer[$buffrow] );
  0            
302             }
303             }
304            
305 0           for ( my $y = 0; $y < 8; $y++) {
306 0           $self->device->send_raw_bytes( @{ $linebuffers[$y] } );
  0            
307             }
308             }
309              
310             sub scroll {
311 0     0 0   my($self, $amount_x, $amount_y) = @_;
312 0   0       $amount_x //= 0;
313 0   0       $amount_y //= 0;
314            
315 0 0 0       if($amount_x == 0 && $amount_y == 0 ) {
316 0           $amount_x = 1;
317             }
318            
319 0           my $scroll_x = $self->_scrollx;
320 0           my $scroll_y = $self->_scrolly;
321              
322 0           $scroll_x += $amount_x;
323 0           $scroll_y += $amount_y;
324            
325 0           $scroll_x = $scroll_x % $self->width;
326 0           $scroll_y = $scroll_y % $self->height;
327            
328 0           $self->_scrollx( $scroll_x );
329 0           $self->_scrolly( $scroll_y );
330 0           return;
331             }
332              
333             sub scroll_to {
334 0     0 0   my($self, $position_x, $position_y) = @_;
335 0   0       $position_x //= 0;
336 0   0       $position_y //= 0;
337            
338 0           my $scroll_x = $position_x % $self->width;
339 0           my $scroll_y = $position_y % $self->height;
340            
341 0           $self->_scrollx( $scroll_x );
342 0           $self->_scrolly( $scroll_y );
343            
344 0           return;
345             }
346              
347             sub scroll_horizontal {
348 0     0 0   my($self, $amount) = @_;
349 0   0       $amount //= 1;
350 0           $self->scroll( $amount, 0 );
351             }
352              
353             sub scroll_vertical {
354 0     0 0   my($self, $amount) = @_;
355 0   0       $amount //= 1;
356 0           $self->scroll( 0, $amount );
357             }
358              
359             sub _exit {
360 0     0     my $self = shift;
361 0 0         if( $self->_clear_on_exit ) {
362 0           for( my $segment = 0; $segment < $self->segments; $segment ++ ) {
363 0           $self->device->shutdown( $segment );
364             }
365             }
366             }
367              
368             1;
369              
370             __END__