File Coverage

blib/lib/VIC/PIC/Base.pm
Criterion Covered Total %
statement 25 66 37.8
branch 3 20 15.0
condition n/a
subroutine 8 9 88.8
pod 0 3 0.0
total 36 98 36.7


line stmt bran cond sub pod time code
1             package VIC::PIC::Base;
2 31     31   12422 use strict;
  31         44  
  31         772  
3 31     31   103 use warnings;
  31         40  
  31         1190  
4              
5             our $VERSION = '0.29';
6             $VERSION = eval $VERSION;
7              
8 31     31   123 use Carp;
  31         38  
  31         1584  
9 31     31   121 use Moo;
  31         35  
  31         126  
10 31     31   15577 use VIC::PIC::Roles; # load all the roles
  31         61  
  31         952  
11 31     31   15551 use namespace::clean;
  31         254245  
  31         117  
12              
13             sub doesrole {
14 1512     1512 0 122507 my $a = $_[0]->does('VIC::PIC::Roles::' . $_[1]);
15 1512 50       16286 unless ($_[1]) { # no logging
16 0 0       0 carp ref($_[0]) . " does not do role $_[1]" unless $a;
17             }
18 1512         3423 return $a;
19             }
20              
21             sub doesroles {
22 240     240 0 28929 my $self = shift;
23 240         390 foreach (@_) {
24 600 100       732 return unless $self->doesrole($_);
25             }
26 228         612 return 1;
27             }
28              
29             has chip_config => (is => 'ro', default => sub { {} });
30              
31             sub print_pinout {
32 0     0 0   my ($self, $fh) = @_;
33 0 0         $fh = *STDOUT unless $fh;
34 0 0         return unless $self->doesroles(qw(CodeGen Chip));
35 0           my $pinref = $self->pins;
36 0           my @pinnames = ();
37 0           my $maxlen = 0;
38 0           foreach (sort(keys %$pinref)) {
39 0 0         next unless $_ =~ /^\d+$/;
40 0           my $aa = $pinref->{$_};
41 0 0         my $str = join('/', @{$aa}) if ref $aa eq 'ARRAY';
  0            
42 0 0         $str = $aa unless ref $aa;
43 0           $pinnames[$_ - 1] = $str;
44 0 0         $maxlen = length($str) if $maxlen < length($str);
45             }
46 0           my $pdip = scalar(@pinnames) / 2;
47 0           my $start = 5 + $maxlen;
48 0           my $chip = uc($self->type);
49 0           my $w = 14;
50 0           my $notch = '__';
51 0           my $w0 = ($w - length($notch)) / 2;
52 0           print $fh "\n\n";
53 0           print $fh ' ' x $start, '+', '=' x $w0, $notch, '=' x $w0, '+', "\n";
54 0           my $pinline = '---';
55 0           for (my $i = 0; $i < $pdip; ++$i) {
56 0           my $s1 = $pinnames[$i];
57 0           my $s2 = $pinnames[2 * $pdip - $i - 1];
58 0           my $l1 = $start - 1 - length($pinline) - length($s1);
59 0           my $p1 = sprintf "%d", ($i + 1);
60 0           my $p2 = sprintf "%d", (2 * $pdip - $i);
61 0           my $w1 = $w - length($p1) - length($p2);
62 0           print $fh ' ' x $l1, $s1, ' ', $pinline, '|', $p1, ' ' x $w1, $p2, '|', $pinline, ' ', $s2, "\n";
63 0           print $fh ' ' x $start, '|', ' ' x $w, '|', "\n";
64 0 0         if (($i + 1) == int($pdip / 2)) {
65 0           my $w2 = int(($w - length($chip)) / 2);
66 0           my $w3 = $w - $w2 - length($chip);
67 0           print $fh ' ' x $start, '|', ' ' x $w2, $chip, ' ' x $w3, '|', "\n";
68 0           print $fh ' ' x $start, '|', ' ' x $w, '|', "\n";
69             }
70             }
71 0           print $fh ' ' x $start, '+', '=' x $w, '+', "\n";
72 0           print $fh "\n\n";
73 0           1;
74             }
75              
76             1;