File Coverage

blib/lib/HiPi/Interface/MicroDotPHAT.pm
Criterion Covered Total %
statement 27 224 12.0
branch 0 56 0.0
condition 0 45 0.0
subroutine 9 32 28.1
pod 0 20 0.0
total 36 377 9.5


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::MicroDotPHAT
3             # Description : Interface to Pimoroni Micro Dot pHAT
4             # Copyright : Perl Port 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             # This is a port of the Pimoroni Python code to Perl
9             #
10             # https://github.com/pimoroni/microdot-phat
11             #
12             #########################################################################################
13             # Pimoroni Copyright Notice
14             #########################################################################################
15             # MIT License
16             #
17             # Copyright (c) 2017 Pimoroni Ltd.
18             #
19             # Permission is hereby granted, free of charge, to any person obtaining a copy
20             # of this software and associated documentation files (the "Software"), to deal
21             # in the Software without restriction, including without limitation the rights
22             # to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
23             # copies of the Software, and to permit persons to whom the Software is
24             # furnished to do so, subject to the following conditions:
25             #
26             # The above copyright notice and this permission notice shall be included in all
27             # copies or substantial portions of the Software.
28             #
29             # THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
30             # IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
31             # FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
32             # AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
33             # LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
34             # OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
35             # SOFTWARE.
36             #
37             #########################################################################################
38              
39             package HiPi::Interface::MicroDotPHAT;
40              
41             #########################################################################################
42 1     1   1000 use strict;
  1         2  
  1         28  
43 1     1   73 use warnings;
  1         1  
  1         36  
44 1     1   5 use parent qw( HiPi::Interface );
  1         3  
  1         6  
45 1     1   59 use HiPi qw( :i2c :rpi :fl3730);
  1         3  
  1         508  
46 1     1   6 use HiPi::Interface::IS31FL3730;
  1         2  
  1         55  
47 1     1   7 use HiPi::Utils::BitBuffer;
  1         2  
  1         34  
48 1     1   486 use HiPi::Interface::MicroDotPHAT::Font qw( :font );
  1         7  
  1         224  
49 1     1   10 use Try::Tiny;
  1         2  
  1         48  
50 1     1   5 use Carp;
  1         11  
  1         2436  
51              
52             our $VERSION ='0.80';
53              
54             __PACKAGE__->create_ro_accessors( qw( _hat_width _hat_height ) );
55              
56             __PACKAGE__->create_accessors( qw(
57             controllers buffer
58             _rotate180
59             _scrollx
60             _scrolly
61             _mirror
62             _decimal
63             _clear_on_exit
64             ) );
65              
66             my $matrixconfig = [
67             { control => 0, type => 'B' },
68             { control => 0, type => 'A' },
69             { control => 1, type => 'B' },
70             { control => 1, type => 'A' },
71             { control => 2, type => 'B' },
72             { control => 2, type => 'A' },
73             ];
74              
75             sub new {
76 0     0 0   my ($class, %userparams) = @_;
77            
78 0           my %params = (
79             brightness => 127,
80             width => 30,
81             height => 7,
82             _hat_width => 30,
83             _hat_height => 7,
84             _rotate180 => 0,
85             _scrollx => 0,
86             _scrolly => 0,
87             _mirror => 0,
88             _clear_on_exit => 1,
89             _decimal => [ 0, 0, 0, 0, 0, 0 ],
90             );
91            
92             # get user params
93 0           foreach my $key( keys (%userparams) ) {
94 0           my $paramkey = $key;
95 0           $paramkey =~ s/^_+//;
96 0           $params{$paramkey} = $userparams{$key};
97             }
98            
99             # initialise
100 0           my @controllers = ();
101            
102 0           for my $address ( 0x63, 0x62, 0x61 ) {
103 0           my $control = HiPi::Interface::IS31FL3730->new( address => $address );
104 0           $control->reset;
105 0           $control->configure( FL3730_SSD_NORMAL | FL3730_DM_MATRIX_BOTH | FL3730_AEN_OFF | FL3730_ADM_8X8 );
106 0           $control->lighting_effect( FL3730_AGS_0_DB | FL3730_CS_35_MA );
107 0           $control->brightness( $params{brightness} );
108 0           push @controllers, $control;
109             }
110            
111 0           $params{controllers} = \@controllers;
112            
113             $params{buffer} = HiPi::Utils::BitBuffer->new(
114             width => $params{width},
115             height => $params{height},
116 0           autoresize => 1,
117             );
118            
119 0           my $self = $class->SUPER::new(%params);
120 0           HiPi->register_exit_method( $self, '_exit');
121 0           return $self;
122             }
123              
124 0     0 0   sub width { $_[0]->buffer->width; }
125              
126 0     0 0   sub height { $_[0]->buffer->height; }
127              
128             sub clear {
129 0     0 0   my $self = shift;
130            
131 0           $self->buffer (
132             HiPi::Utils::BitBuffer->new(
133             width => $self->_hat_width,
134             height => $self->_hat_height,
135             autoresize => 1,
136             )
137             );
138            
139 0           $self->_scrollx(0);
140 0           $self->_scrolly(0);
141 0           $self->_decimal([0,0,0,0,0,0]);
142 0           return;
143             }
144              
145             sub fill {
146 0     0 0   my ( $self, $val ) = @_;
147 0           $self->buffer->fill( $val );
148             }
149              
150             sub set_rotate180 {
151 0     0 0   my($self, $value) = @_;
152 0 0         $self->_rotate180( $value ? 1 : 0 );
153             }
154              
155             sub set_mirror {
156 0     0 0   my($self, $value) = @_;
157 0 0         $self->_mirror( $value ? 1 : 0 );
158             }
159              
160             sub set_clear_on_exit {
161 0     0 0   my($self, $value) = @_;
162 0 0         $self->_clear_on_exit( $value ? 1 : 0 );
163             }
164              
165             sub set_brightness {
166 0     0 0   my($self, $val) = @_;
167            
168 0   0       $val ||= 1.0;
169 0 0 0       if( $val > 1.0 || $val < 0.0 ) {
170 0           carp q(brightness value must be between 0.0 and 1.0 );
171             }
172            
173 0           my $brightness = int($val * 127);
174 0 0         $brightness = 127 if $brightness > 127;
175            
176 0           $_->brightness( $brightness ) for ( @{ $self->controllers } );
  0            
177             }
178              
179             sub set_col {
180 0     0 0   my($self, $x, $col) = @_;
181            
182 0           for (my $y = 0; $y < 7; $y++) {
183 0           $self->set_pixel($x, $y, ($col & (1 << $y)) > 0);
184             }
185             }
186              
187             sub set_pixel {
188 0     0 0   my($self, $x, $y, $c) = @_;
189 0 0         $c = $c ? 1 : 0;
190 0           $self->buffer->set_bit($x, $y, $c);
191             }
192              
193             sub write_char {
194 0     0 0   my($self, $char, $offset_x, $offset_y) = @_;
195 0   0       $offset_x ||= 0;
196 0   0       $offset_y ||= 0;
197            
198 0           my $charbits = _get_char($char);
199 0           for ( my $x = 0; $x < 5; $x++ ) {
200 0           for ( my $y = 0; $y < 7; $y ++ ) {
201 0 0         my $p = (($charbits->[$x] & (1 << $y)) > 0) ? 1 : 0;
202 0           $self->set_pixel($offset_x + $x, $offset_y + $y, $p );
203             }
204             }
205             }
206              
207             sub _get_char {
208 0     0     my $char = shift;
209 0   0       $char //= ' ';
210 0           my $char_ordinal;
211              
212 0     0     try { $char_ordinal = ord($char); };
  0            
213            
214 0 0 0       unless( $char_ordinal && exists(phat_font->{$char_ordinal}) ) {
215 0           carp qq(Unsupported char $char);
216 0           $char_ordinal = 32;
217             }
218              
219             # ? override
220            
221 0 0         $char_ordinal = 12316 if $char_ordinal == 65374;
222            
223 0           return phat_font->{$char_ordinal};
224             }
225              
226              
227             sub set_decimal {
228 0     0 0   my($self, $index, $state) = @_;
229            
230 0 0 0       unless(defined($index)
231             && $index =~ /^0|1|2|3|4|5$/
232             ) {
233 0           return;
234             }
235            
236 0 0         $self->_decimal->[$index] = $state ? 1 : 0;
237            
238             }
239              
240             sub write_string {
241 0     0 0   my($self, $string, $offset_x, $offset_y, $kerning ) = @_;
242 0   0       $string //= '';
243 0   0       $offset_x ||= 0;
244 0   0       $offset_y ||= 0;
245 0   0       $kerning //= 1;
246            
247 0           my $pixels = 0;
248 0           for my $char ( split(//, $string) ) {
249              
250 0           my $char_data = _get_char($char);
251            
252 0           my @pixelcols = ();
253 0           my ($maxX, $minX);
254            
255 0           for (my $x = 0; $x < 5; $x ++ ) {
256 0           my @pixelrows = ();
257 0           for ( my $y = 0; $y < 7; $y++ ) {
258            
259 0 0         my $val = (($char_data->[$x] & (1 << $y)) > 0) ? 1 : 0;
260            
261 0 0         if( $val ) {
262 0 0         $minX = $x unless(defined($minX));
263 0           $maxX = $x;
264             }
265            
266 0           push @pixelrows, [ $offset_x + $x, $offset_y + $y, $val ];
267             }
268            
269 0           push @pixelcols, \@pixelrows;
270             }
271            
272 0 0         if( $kerning ) {
273 0 0         if(defined($minX)) {
274 0           my $shiftcount = $minX;
275 0           for (my $x = 0; $x < $shiftcount; $x ++) {
276 0           shift @pixelcols;
277             }
278 0           for (my $x = $maxX; $x < 4; $x++) {
279              
280 0           pop @pixelcols;
281             }
282            
283             # adjust x values
284 0           for my $col( @pixelcols ) {
285 0           for my $row ( @$col ) {
286 0           $row->[0] -= $shiftcount;
287             }
288             }
289            
290             # add gap
291 0           my @pixelrows = ();
292 0           my $gapoffset = scalar @pixelcols;
293 0           for ( my $y = 0; $y < 7; $y++ ) {
294 0           push @pixelrows, [ $offset_x + $gapoffset + 1, $offset_y + $y, 0 ];
295             }
296 0           push @pixelcols, \@pixelrows;
297             } else {
298             # a space - 2 rows - get rid of final 3
299 0           pop @pixelcols;
300 0           pop @pixelcols;
301 0           pop @pixelcols;
302             }
303             }
304            
305 0           my $charpixels = scalar @pixelcols;
306            
307 0           $offset_x += $charpixels;
308            
309 0           $pixels += $charpixels;
310            
311 0           for my $col ( @pixelcols ) {
312 0           for my $row ( @$col ) {
313 0           $self->set_pixel( @$row );
314             }
315             }
316             }
317            
318 0           return $pixels;
319             }
320              
321             sub show {
322 0     0 0   my $self = shift;
323            
324 0           my $databuf = $self->buffer->clone_buffer;
325            
326             # scroll it etc
327 0           $databuf->scroll_x_y( $self->_scrollx, $self->_scrolly);
328            
329 0 0         $databuf->mirror($self->_hat_width, $self->_hat_height) if $self->_mirror;
330            
331 0 0         $databuf->flip($self->_hat_width, $self->_hat_height) if $self->_rotate180;
332            
333             # write it
334 0           for (my $matrix = 0; $matrix < 6; $matrix++) {
335 0           my $mconf = $matrixconfig->[$matrix];
336 0           my $control = $self->controllers->[$mconf->{control}];
337 0           my $offset_x = $matrix * 5;
338            
339 0           my @buffer = ( 0 ) x 8;
340            
341 0           for ( my $x = 0; $x < 5; $x++) {
342 0           for ( my $y = 0; $y < 7; $y++) {
343 0           my $val = $databuf->get_bit( $offset_x + $x, $y );
344 0 0         if($mconf->{type} eq 'B') {
345 0           $buffer[$x] += ( $val << $y );
346             } else {
347 0           $buffer[$y] += ( $val << $x );
348             }
349             }
350             }
351            
352 0 0         if($mconf->{type} eq 'B') {
353 0 0         if( $self->_decimal->[$matrix] ) {
354 0           $buffer[7] |= 0b01000000;
355             } else {
356 0           $buffer[7] &= 0b10111111;
357             }
358 0           $control->matrix_2_data( @buffer );
359             } else {
360 0 0         if( $self->_decimal->[$matrix] ) {
361 0           $buffer[6] |= 0b10000000;
362             } else {
363 0           $buffer[6] &= 0b01111111;
364             }
365 0           $control->matrix_1_data( @buffer );
366             }
367             }
368            
369 0           for my $control ( @{ $self->controllers } ) {
  0            
370 0           $control->update;
371             }
372             }
373              
374             sub scroll {
375 0     0 0   my($self, $amount_x, $amount_y) = @_;
376 0   0       $amount_x //= 0;
377 0   0       $amount_y //= 0;
378            
379 0 0 0       if($amount_x == 0 && $amount_y == 0 ) {
380 0           $amount_x = 1;
381             }
382            
383 0           my $scroll_x = $self->_scrollx;
384 0           my $scroll_y = $self->_scrolly;
385              
386 0           $scroll_x += $amount_x;
387 0           $scroll_y += $amount_y;
388 0           $scroll_x %= $self->width;
389 0           $scroll_y %= $self->height;
390            
391 0           $self->_scrollx( $scroll_x );
392 0           $self->_scrolly( $scroll_y );
393 0           return;
394             }
395              
396             sub scroll_to {
397 0     0 0   my($self, $position_x, $position_y) = @_;
398 0   0       $position_x //= 0;
399 0   0       $position_y //= 0;
400            
401 0           my $scroll_x = $position_x % $self->width;
402 0           my $scroll_y = $position_y % $self->height;
403            
404 0           $self->_scrollx( $scroll_x );
405 0           $self->_scrolly( $scroll_y );
406            
407 0           return;
408             }
409              
410             sub scroll_horizontal {
411 0     0 0   my($self, $amount) = @_;
412 0   0       $amount //= 1;
413 0           $self->scroll( $amount, 0 );
414             }
415              
416             sub scroll_vertical {
417 0     0 0   my($self, $amount) = @_;
418 0   0       $amount //= 1;
419 0           $self->scroll( 0, $amount );
420             }
421              
422             sub draw_tiny {
423 0     0 0   my($self, $display, $text) = @_;
424 0   0       $text //= '';
425            
426 0 0 0       return unless( defined($display) && $display =~ /^0|1|2|3|4|5$/ );
427 0 0         return unless length($text);
428            
429 0 0         unless( $text =~ /^\d+$/ ) {
430 0           carp qq(text should contain only numbers: '$text');
431 0           return;
432             }
433            
434 0           my @buf = ();
435 0           for my $char ( split(//, $text) ) {
436 0           my $num = int($char);
437 0           push @buf, @{ phat_tiny_numbers->[$num] };
  0            
438             # space
439 0           push @buf, 0;
440             }
441            
442 0           my $rowcount = scalar @buf;
443 0 0         $rowcount = 7 if $rowcount > 7;
444              
445 0           for ( my $row = 0; $row < $rowcount; $row ++ ) {
446 0           my $offset_x = $display * 5;
447 0           my $offset_y = 6-($row % 7);
448 0           for ( my $d = 0; $d < 5; $d++ ) {
449 0           $self->set_pixel($offset_x+(4-$d), $offset_y, ($buf[$row] & (1 << $d)) > 0);
450             }
451             }
452            
453 0           return;
454             }
455              
456             sub _exit {
457 0     0     my $self = shift;
458 0 0         if( $self->_clear_on_exit ) {
459 0           for my $control ( @{ $self->controllers } ) {
  0            
460 0           $control->configure(FL3730_SSD_SHUTDOWN);
461             }
462             }
463             }
464              
465             1;
466              
467             __END__