File Coverage

blib/lib/HiPi/Interface/ZeroSeg.pm
Criterion Covered Total %
statement 15 154 9.7
branch 0 46 0.0
condition 0 10 0.0
subroutine 5 24 20.8
pod 0 17 0.0
total 20 251 7.9


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::ZeroSeg
3             # Description : Interface to Pi Hut ZeroSeg pHAT
4             # Copyright : Copyright (c) 2018 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::ZeroSeg;
10              
11             #########################################################################################
12              
13 1     1   1382 use strict;
  1         2  
  1         29  
14 1     1   6 use warnings;
  1         2  
  1         43  
15 1     1   5 use parent qw( HiPi::Interface );
  1         2  
  1         6  
16 1     1   65 use HiPi qw( :max7219 );
  1         2  
  1         171  
17 1     1   6 use HiPi::Interface::MAX7219;
  1         2  
  1         1904  
18              
19             our $VERSION ='0.80';
20              
21             __PACKAGE__->create_accessors( qw( buffer writeflags flipped _decimals _shutdown_on_exit segmentfont ) );
22              
23             my $defaultsegmentfont = {
24             ' ' => 0x00,
25             '-' => 0x01,
26             '_' => 0x08,
27             '>' => 0b00000111,
28             '<' => 0b00110001,
29             '=' => 0b00001001,
30             '0' => 0x7e,
31             '1' => 0x30,
32             '2' => 0x6d,
33             '3' => 0x79,
34             '4' => 0x33,
35             '5' => 0x5b,
36             '6' => 0x5f,
37             '7' => 0x70,
38             '8' => 0x7f,
39             '9' => 0x7b,
40             'a' => 0x7d,
41             'b' => 0x1f,
42             'c' => 0x0d,
43             'd' => 0x3d,
44             'e' => 0x6f,
45             'f' => 0x47,
46             'g' => 0x7b,
47             'h' => 0x17,
48             'i' => 0x10,
49             'j' => 0x18,
50             'k' => 0b00000111,
51             'l' => 0x06,
52             'm' => 0b01000001,
53             'n' => 0x15,
54             'o' => 0x1d,
55             'p' => 0x67,
56             'q' => 0x73,
57             'r' => 0x05,
58             's' => 0x5b,
59             't' => 0x0f,
60             'u' => 0x1c,
61             'v' => 0x1c,
62             'w' => 0b00010100,
63             'x' => 0b00100101,
64             'y' => 0x3b,
65             'z' => 0x6d,
66             'A' => 0x77,
67             'B' => 0x7f,
68             'C' => 0x4e,
69             'D' => 0x7e,
70             'E' => 0x4f,
71             'F' => 0x47,
72             'G' => 0x5e,
73             'H' => 0x37,
74             'I' => 0x30,
75             'J' => 0x38,
76             'K' => 0b00110001,
77             'L' => 0x0e,
78             'M' => 0b01001001,
79             'N' => 0x76,
80             'O' => 0b01100011,
81             'P' => 0x67,
82             'Q' => 0x73,
83             'R' => 0x46,
84             'S' => 0x5b,
85             'T' => 0x0f,
86             'U' => 0x3e,
87             'V' => 0x3e,
88             'W' => 0b00110110,
89             'X' => 0b00010011,
90             'Y' => 0x3b,
91             'Z' => 0x6d,
92             ',' => 0x80,
93             '.' => 0x80,
94             };
95              
96             sub new {
97 0     0 0   my ($class, %userparams) = @_;
98            
99 0           my %params = (
100             devicename => '/dev/spidev0.0',
101             speed => 9600000, # 9.6 mhz
102             delay => 0,
103             _shutdown_on_exit => 1,
104             segmentfont => $defaultsegmentfont,
105             );
106            
107             # get user params
108 0           foreach my $key( keys (%userparams) ) {
109 0           $params{$key} = $userparams{$key};
110             }
111            
112 0           $params{buffer} = [];
113 0           $params{_decimals} = [0,0,0,0,0,0,0,0];
114            
115 0 0         unless(defined($params{device})) {
116             $params{device} = HiPi::Interface::MAX7219->new(
117             speed => $params{speed},
118             delay => $params{delay},
119             devicename => $params{devicename},
120 0           );
121             }
122            
123 0           my $self = $class->SUPER::new(%params);
124 0           HiPi->register_exit_method( $self, '_on_exit');
125 0           $self->device->set_decode_mode( 0 );
126 0           $self->device->set_scan_limit( 7 );
127 0           $self->device->set_intensity( 2 );
128 0           $self->device->wake_up;
129 0           $self->device->set_display_test(0);
130            
131 0           return $self;
132             }
133              
134             sub set_shutdown_on_exit {
135 0     0 0   my ($self, $state) = @_;
136 0 0         $state = ( $state ) ? 1 : 0;
137 0           $self->_shutdown_on_exit( $state );
138             }
139              
140             sub _on_exit {
141 0     0     my $self = shift;
142 0 0         if( $self->_shutdown_on_exit ) {
143 0           $self->device->shutdown;
144             }
145             }
146              
147             sub set_buffer_text {
148 0     0 0   my( $self, $text ) = @_;
149            
150             # padleft
151 0           $text = sprintf('%8s', $text);
152            
153 0           my @chars = split(//, $text);
154            
155 0           $self->buffer(\@chars );
156 0           $self->_decimals( [0,0,0,0,0,0,0,0] );
157 0           return $text;
158             }
159              
160             sub write_decimal_number {
161 0     0 0   my ($self, $value) = @_;
162 0           $value =~ s/\s+//g;
163            
164 0           my $dp = index($value, '.');
165            
166 0           $value =~ s/\.//g;
167 0           $self->_decimals( [0,0,0,0,0,0,0,0] );
168            
169 0 0         if($dp > -1 ) {
170 0 0         if( length( $value ) < 8 ) {
171 0           $dp += ( 8 - length( $value ) );
172             }
173 0 0         $self->_decimals->[$dp - 1] = 1 if $dp > 0;
174             }
175            
176 0           my @chars = split(//, sprintf('%8s', $value) );
177 0           $self->buffer(\@chars );
178 0           $self->write_buffer;
179 0           return $value;
180             }
181              
182             sub write_degrees {
183 0     0 0   my ($self, $value, $scale) = @_;
184 0           $value =~ s/\s+//g;
185 0   0       $scale //='';
186 0 0         if($scale) {
187 0           $scale =~ s/[^fc]//ig;
188             }
189            
190 0           $value .= 'O' . uc($scale);
191            
192 0           my $dp = index($value, '.');
193            
194 0           $value =~ s/\.//g;
195 0           $self->_decimals( [0,0,0,0,0,0,0,0] );
196            
197 0 0         if($dp > -1 ) {
198 0 0         if( length( $value ) < 8 ) {
199 0           $dp += ( 8 - length( $value ) );
200             }
201 0 0         $self->_decimals->[$dp - 1] = 1 if $dp > 0;
202             }
203            
204 0           my @chars = split(//, sprintf('%8s', $value) );
205 0           $self->buffer(\@chars );
206 0           $self->write_buffer;
207 0           return $value;
208             }
209              
210             sub write_time {
211 0     0 0   my ( $self, $hour, $minute, $second ) = @_;
212 0   0       $hour ||= 0;
213 0   0       $minute ||= 0;
214            
215 0           for ( $hour, $minute, $second) {
216 0 0         $_ = sprintf("%02d", $_) if defined( $_ );
217             }
218 0           my $timestring = $hour . $minute;
219 0 0         if(defined($second)) {
220 0           $timestring .= $second;
221 0           $self->_decimals( [0,0,0,1,0,1,0,0] );
222             } else {
223 0           $self->_decimals( [0,0,0,0,0,1,0,0] );
224             }
225 0           my @chars = split(//, sprintf('%8s', $timestring) );
226 0           $self->buffer(\@chars );
227 0           $self->write_buffer;
228 0           return $timestring;
229             }
230              
231             sub write_localtime {
232 0     0 0   my ( $self, $skipseconds ) = @_;
233 0           my ($second, $minute, $hour ) = localtime(time);
234 0 0         $second = ( $skipseconds ) ? undef : $second;
235 0           my $rval = $self->write_time( $hour, $minute, $second);
236 0           return $rval;
237             }
238              
239             sub write_gmtime {
240 0     0 0   my ( $self, $skipseconds ) = @_;
241 0           my ($second, $minute, $hour ) = gmtime(time);
242 0 0         $second = ( $skipseconds ) ? undef : $second;
243 0           my $rval = $self->write_time( $hour, $minute, $second);
244 0           return $rval;
245             }
246              
247             sub write_buffer {
248 0     0 0   my $self = shift;
249 0           for (my $i = 0; $i < 8; $i ++) {
250 0           my $flags = 0;
251 0 0         $flags |= MAX7219_FLAG_DECIMAL if $self->_decimals->[$i];
252 0           $self->_write_segment_char( 7 - $i , $self->buffer->[$i], $flags );
253             }
254 0           return;
255             }
256              
257             sub write_text {
258 0     0 0   my( $self, $text ) = @_;
259 0           $self->set_buffer_text($text);
260 0           $self->write_buffer;
261             }
262              
263             sub write_raw_bytes {
264 0     0 0   my( $self, @bytes ) = @_;
265 0           while( scalar(@bytes) < 8 ) {
266 0           unshift( @bytes, 0x00 );
267             }
268            
269 0           for (my $i = 0; $i < 8; $i ++) {
270 0           $self->device->send_segment_matrix( 7 - $i, $bytes[$i] );
271 0           $self->sleep_milliseconds(10);
272             }
273            
274 0           return;
275             }
276              
277             sub scroll_buffer_left {
278 0     0 0   my $self = shift;
279 0 0         if( scalar @{ $self->buffer } ) {
  0            
280 0           push @{ $self->buffer }, shift @{ $self->buffer };
  0            
  0            
281             }
282 0           return;
283             }
284              
285             sub scroll_buffer_right {
286 0     0 0   my $self = shift;
287 0 0         if( scalar @{ $self->buffer } ) {
  0            
288 0           unshift @{ $self->buffer }, pop @{ $self->buffer };
  0            
  0            
289             }
290 0           return;
291             }
292              
293             sub clear_display {
294 0     0 0   my $self = shift;
295 0           my $text = ' ' x 8;
296 0           $self->write_text($text);
297 0           return;
298             }
299              
300 0     0 0   sub shut_down { $_[0]->device->shutdown; }
301              
302 0     0 0   sub wake_up { $_[0]->device->wake_up; }
303              
304 0     0 0   sub set_intensity{ $_[0]->device->set_intensity( $_[1] ); }
305              
306             sub _write_segment_char {
307 0     0     my($self, $matrix, $char, $flags ) = @_;
308 0   0       $flags //= 0x00;
309 0   0       $char //= '_';
310 0 0         my $byte = ( exists($self->segmentfont->{$char}) ) ? $self->segmentfont->{$char} : 0x08;
311            
312 0 0         if( $flags & MAX7219_FLAG_FLIPPED ) {
313 0           $byte = (($byte & 0xE) << 3) | (($byte & 0x70) >> 3) | ( $byte & 0x80 ) | ( $byte & 0x01 );
314             }
315            
316 0 0         if( $flags & MAX7219_FLAG_DECIMAL ) {
317 0           $byte |= 0x80;
318             }
319            
320 0 0         if( $flags & MAX7219_FLAG_MIRROR ) {
321             # swap bits 5 and 1
322             # swap bits 4 and 2
323 0           for my $swap ( [ 5, 1], [ 4, 2 ] ) {
324 0           my $val0 = ( $byte >> $swap->[0] ) & 1;
325 0           my $val1 = ( $byte >> $swap->[1] ) & 1;
326            
327 0 0         if( $val0 ) {
328 0           $byte |= ( 1 << $swap->[1] );
329             } else {
330 0           $byte &= ~( 1 << $swap->[1] );
331             }
332            
333 0 0         if( $val1 ) {
334 0           $byte |= ( 1 << $swap->[0] );
335             } else {
336 0           $byte &= ~( 1 << $swap->[0] );
337             }
338             }
339             }
340            
341 0           $self->device->send_segment_matrix( $matrix, $byte );
342 0           $self->sleep_milliseconds(10);
343             }
344              
345              
346             1;
347              
348             __END__