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-2019 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   1235 use strict;
  1         5  
  1         31  
13 1     1   7 use warnings;
  1         2  
  1         27  
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         446  
16 1     1   8 use HiPi::Interface::MAX7219;
  1         2  
  1         61  
17 1     1   473 use HiPi::Utils::BitBuffer;
  1         3  
  1         98  
18 1     1   473 use HiPi::Graphics::Font5x7 qw( :font );
  1         3  
  1         125  
19 1     1   9 use Try::Tiny;
  1         5  
  1         67  
20 1     1   7 use Carp;
  1         1  
  1         2026  
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 0           autoresize => 1,
66             );
67            
68 0 0         unless(defined($params{device})) {
69             $params{device} = HiPi::Interface::MAX7219->new(
70             speed => $params{speed},
71             delay => $params{delay},
72             devicename => $params{devicename},
73 0           );
74             }
75            
76 0           my $self = $class->SUPER::new(%params);
77            
78 0           HiPi->register_exit_method( $self, '_exit');
79            
80 0           for( my $segment = 0; $segment < $self->segments; $segment ++ ) {
81 0           $self->device->set_decode_mode( 0, $segment );
82 0           $self->device->set_scan_limit( 7, $segment );
83 0           $self->device->set_intensity( 2, $segment );
84 0           $self->device->set_display_test( 0, $segment );
85 0           $self->device->wake_up( $segment );
86             }
87            
88 0           return $self;
89             }
90              
91 0     0 0   sub width { $_[0]->buffer->width; }
92              
93 0     0 0   sub height { $_[0]->buffer->height; }
94              
95             sub clear {
96 0     0 0   my $self = shift;
97            
98 0           $self->buffer (
99             HiPi::Utils::BitBuffer->new(
100             width => $self->pixel_width,
101             height => $self->pixel_height,
102             autoresize => 1,
103             )
104             );
105            
106 0           $self->_scrollx(0);
107 0           $self->_scrolly(0);
108 0           return;
109             }
110              
111             sub fill {
112 0     0 0   my ( $self, $val ) = @_;
113 0           $self->buffer->fill( $val );
114             }
115              
116             sub set_rotate180 {
117 0     0 0   my($self, $value) = @_;
118 0 0         $self->_rotate180( $value ? 1 : 0 );
119             }
120              
121             sub set_mirror {
122 0     0 0   my($self, $value) = @_;
123 0 0         $self->_mirror( $value ? 1 : 0 );
124             }
125              
126             sub set_clear_on_exit {
127 0     0 0   my($self, $value) = @_;
128 0 0         $self->_clear_on_exit( $value ? 1 : 0 );
129             }
130              
131             sub set_intensity {
132 0     0 0   my($self, $val) = @_;
133 0   0       $val //= 0;
134 0           $val = int($val);
135 0 0 0       if( $val > 15 || $val < 0 ) {
136 0           carp q(intensity value must be between 0 and 15 );
137             }
138            
139 0           for ( my $maxc = 0; $maxc < $self->segments; $maxc ++ ) {
140 0           $self->device->set_intensity( $val, $maxc );
141             }
142            
143 0           return;
144             }
145              
146             sub set_col {
147 0     0 0   my($self, $x, $col) = @_;
148            
149 0           for (my $y = 0; $y < 7; $y++) {
150 0           $self->set_pixel($x, $y, ($col & (1 << $y)) > 0);
151             }
152             }
153              
154             sub set_pixel {
155 0     0 0   my($self, $x, $y, $c) = @_;
156 0 0         $c = $c ? 1 : 0;
157 0           $self->buffer->set_bit($x, $y, $c);
158             }
159              
160             sub _get_char {
161 0     0     my $char = shift;
162 0   0       $char //= ' ';
163 0           my $char_ordinal;
164              
165 0     0     try { $char_ordinal = ord($char); };
  0            
166            
167 0 0 0       unless( $char_ordinal && exists( font_5_x_7->{$char_ordinal}) ) {
168 0           carp qq(Unsupported char $char);
169 0           $char_ordinal = 32;
170             }
171            
172 0           return font_5_x_7->{$char_ordinal};
173             }
174              
175             sub _handle_write_string_and_extents {
176 0     0     my($self, $string, $offset_x, $offset_y, $dowrite ) = @_;
177 0   0       $string //= '';
178 0   0       $offset_x ||= 0;
179 0   0       $offset_y ||= 0;
180            
181 0           my $pixels = 0;
182 0           for my $char ( split(//, $string) ) {
183              
184 0           my $char_data = _get_char($char);
185            
186 0           my @pixelcols = ();
187 0           my ($maxX, $minX);
188            
189 0           for (my $x = 0; $x < 5; $x ++ ) {
190            
191 0           my @pixelrows = ();
192 0           for ( my $y = 0; $y < 8; $y++ ) {
193            
194 0 0         my $val = (($char_data->[$x] & (1 << $y)) > 0) ? 1 : 0;
195            
196 0 0         if( $val ) {
197 0 0         $minX = $x unless(defined($minX));
198 0           $maxX = $x;
199             }
200            
201 0           push @pixelrows, [ $offset_x + $x, $offset_y + $y, $val ];
202             }
203            
204 0           push @pixelcols, \@pixelrows;
205             }
206            
207            
208 0 0         if(defined($minX)) {
209 0           my $shiftcount = $minX;
210 0           for (my $x = 0; $x < $shiftcount; $x ++) {
211 0           shift @pixelcols;
212             }
213            
214 0           for (my $x = $maxX; $x < 4; $x++) {
215 0           pop @pixelcols;
216             }
217            
218             # adjust x values
219 0           for my $col( @pixelcols ) {
220 0           for my $row ( @$col ) {
221 0           $row->[0] -= $shiftcount;
222             }
223             }
224            
225             # add gap
226 0           my @pixelrows = ();
227 0           my $gapoffset = scalar @pixelcols;
228 0           for ( my $y = 0; $y < 8; $y++ ) {
229 0           push @pixelrows, [ $offset_x + $gapoffset + 1, $offset_y + $y, 0 ];
230             }
231 0           push @pixelcols, \@pixelrows;
232             } else {
233             # a space - 2 rows - get rid of final 3
234 0           pop @pixelcols;
235 0           pop @pixelcols;
236 0           pop @pixelcols;
237             }
238            
239            
240 0           my $charpixels = scalar @pixelcols;
241 0           $offset_x += $charpixels;
242 0           $pixels += $charpixels;
243            
244 0 0         if( $dowrite ) {
245 0           for my $col ( @pixelcols ) {
246 0           for my $row ( @$col ) {
247 0           $self->set_pixel( @$row );
248             }
249             }
250             }
251             }
252            
253 0           return $pixels;
254             }
255              
256             sub write_string {
257 0     0 0   my($self, $string, $offset_x, $offset_y ) = @_;
258 0           return $self->_handle_write_string_and_extents( $string, $offset_x, $offset_y, 1 );
259             }
260              
261             sub get_string_extents {
262 0     0 0   my($self, $string ) = @_;
263 0           return $self->_handle_write_string_and_extents( $string, 0, 0, 0 );
264             }
265              
266             sub show {
267 0     0 0   my $self = shift;
268            
269 0           my $databuf = $self->buffer->clone_buffer;
270            
271             # scroll it etc
272 0           $databuf->scroll_x_y( $self->_scrollx, $self->_scrolly);
273            
274 0 0         $databuf->mirror($self->pixel_width, $self->pixel_height) if $self->_mirror;
275            
276 0 0         $databuf->flip($self->pixel_width, $self->pixel_height) if $self->_rotate180;
277            
278 0           my @linebuffers = ([], [], [], [], [], [], [], []);
279            
280 0           my $maxsegment = $self->segments - 1;
281            
282 0           for (my $segment = 0; $segment < $self->segments; $segment ++) {
283 0           my $offset_x = ( $maxsegment - $segment ) * 8;
284            
285 0           my @buffer = ( 0 ) x 8;
286            
287 0           for ( my $x = 0; $x < 8; $x++) {
288 0           for ( my $y = 0; $y < 8; $y++) {
289 0           my $val = $databuf->get_bit( $offset_x + $x, $y );
290 0 0         if( $self->reverse_map ) {
291 0           $buffer[$y] += ( $val << $x );
292             } else {
293 0           $buffer[$y] += ( $val << ( 7 - $x ) );
294             }
295             }
296             }
297            
298 0           for (my $buffrow = 0; $buffrow < 8; $buffrow ++) {
299 0           unshift @{ $linebuffers[$buffrow] }, ( MAX7219_REG_DIGIT_0 + $buffrow, $buffer[$buffrow] );
  0            
300             }
301             }
302            
303 0           for ( my $y = 0; $y < 8; $y++) {
304 0           $self->device->send_raw_bytes( @{ $linebuffers[$y] } );
  0            
305             }
306             }
307              
308             sub scroll {
309 0     0 0   my($self, $amount_x, $amount_y) = @_;
310 0   0       $amount_x //= 0;
311 0   0       $amount_y //= 0;
312            
313 0 0 0       if($amount_x == 0 && $amount_y == 0 ) {
314 0           $amount_x = 1;
315             }
316            
317 0           my $scroll_x = $self->_scrollx;
318 0           my $scroll_y = $self->_scrolly;
319              
320 0           $scroll_x += $amount_x;
321 0           $scroll_y += $amount_y;
322            
323 0           $scroll_x = $scroll_x % $self->width;
324 0           $scroll_y = $scroll_y % $self->height;
325            
326 0           $self->_scrollx( $scroll_x );
327 0           $self->_scrolly( $scroll_y );
328 0           return;
329             }
330              
331             sub scroll_to {
332 0     0 0   my($self, $position_x, $position_y) = @_;
333 0   0       $position_x //= 0;
334 0   0       $position_y //= 0;
335            
336 0           my $scroll_x = $position_x % $self->width;
337 0           my $scroll_y = $position_y % $self->height;
338            
339 0           $self->_scrollx( $scroll_x );
340 0           $self->_scrolly( $scroll_y );
341            
342 0           return;
343             }
344              
345             sub scroll_horizontal {
346 0     0 0   my($self, $amount) = @_;
347 0   0       $amount //= 1;
348 0           $self->scroll( $amount, 0 );
349             }
350              
351             sub scroll_vertical {
352 0     0 0   my($self, $amount) = @_;
353 0   0       $amount //= 1;
354 0           $self->scroll( 0, $amount );
355             }
356              
357             sub _exit {
358 0     0     my $self = shift;
359 0 0         if( $self->_clear_on_exit ) {
360 0           for( my $segment = 0; $segment < $self->segments; $segment ++ ) {
361 0           $self->device->shutdown( $segment );
362             }
363             }
364             }
365              
366             1;
367              
368             __END__