File Coverage

blib/lib/HiPi/Interface/HobbyTronicsADC.pm
Criterion Covered Total %
statement 18 64 28.1
branch 0 24 0.0
condition n/a
subroutine 6 11 54.5
pod 0 5 0.0
total 24 104 23.0


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::HobbyTronicsADC
3             # Description : Control HTADCI2C I2C Analog to Digital ic via I2C
4             # Copyright : Copyright (c) 2013-2017 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::HobbyTronicsADC;
10              
11             #########################################################################################
12              
13 1     1   1086 use strict;
  1         2  
  1         31  
14 1     1   5 use warnings;
  1         2  
  1         27  
15 1     1   6 use parent qw( HiPi::Interface );
  1         2  
  1         5  
16 1     1   98 use HiPi qw( :rpi );
  1         2  
  1         296  
17 1     1   8 use HiPi::RaspberryPi;
  1         2  
  1         9  
18 1     1   33 use Carp;
  1         4  
  1         724  
19              
20             # Chip based on a PIC 18F14K22
21              
22             our $VERSION ='0.81';
23              
24             __PACKAGE__->create_accessors( qw( devicename address res fil1 fil0 backend ) );
25              
26              
27             sub new {
28 0     0 0   my ($class, %userparams) = @_;
29            
30 0           my $pi = HiPi::RaspberryPi->new();
31            
32 0 0         my %params = (
33             address => 0x28,
34             device => undef,
35             devicename => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
36             res => 1,
37             fil1 => 0,
38             fil0 => 0,
39             backend => 'i2c',
40             );
41            
42             # get user params
43 0           foreach my $key( keys (%userparams) ) {
44 0           $params{$key} = $userparams{$key};
45             }
46            
47 0 0         unless( defined($params{device}) ) {
48 0 0         if ( $params{backend} eq 'bcm2835' ) {
49 0           require HiPi::BCM2835::I2C;
50             $params{device} = HiPi::BCM2835::I2C->new(
51             address => $params{address},
52 0 0         peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(),
53             );
54             } else {
55 0           require HiPi::Device::I2C;
56             $params{device} = HiPi::Device::I2C->new(
57             devicename => $params{devicename},
58             address => $params{address},
59             busmode => $params{backend},
60 0           );
61             }
62             }
63            
64            
65 0           my $self = $class->SUPER::new(%params);
66            
67             # set the device params
68 0 0         my $setupflags = ( $params{res} ) ? 1 : 0;
69 0 0         $setupflags += 2 if $params{fil0};
70 0 0         $setupflags += 4 if $params{fil1};
71 0           $self->device->bus_write( $setupflags );
72            
73 0           return $self;
74             }
75              
76             sub set_option_flags {
77 0     0 0   my($self, $res, $fil0, $fil1) = @_;
78 0 0         my $setupflags = ( $res ) ? 1 : 0;
79 0 0         $setupflags += 2 if $fil0;
80 0 0         $setupflags += 4 if $fil1;
81 0           $self->res($res);
82 0           $self->fil0($fil0);
83 0           $self->fil1($fil1);
84 0           $self->device->bus_write( $setupflags );
85              
86             }
87              
88             sub read_channel {
89 0     0 0   my ($self, $channel) = @_;
90 0           return ( $self->read_register )[$channel];
91             }
92              
93             sub read_channels {
94 0     0 0   my ($self, @channels) = @_;
95 0           my @all = $self->read_register;
96 0           my @results;
97 0           for ( @channels ) {
98 0           push (@results, $all[$_]);
99             }
100 0           return @results;
101             }
102              
103             sub read_register {
104 0     0 0   my($self) = @_;
105 0 0         my $numbytes = ( $self->res ) ? 10 : 20;
106             #my $address = ( $self->res ) ? 0x01 : 0x01;
107 0           my @rvals = $self->device->bus_read( undef, $numbytes );
108 0 0         if( $numbytes == 10 ) {
109 0           for( my $i = 0; $i < 10; $i++ ) {
110 0           $rvals[$i] *= 4;
111             }
112 0           return @rvals;
113             } else {
114 0           my @newvals;
115 0           while( @rvals) {
116 0           my $low = shift( @rvals );
117 0           my $high = shift( @rvals );
118 0           push @newvals, $high + $low * 256;
119             }
120 0           return @newvals;
121             }
122             }
123              
124             1;