File Coverage

blib/lib/HiPi/Interface/MCP4DAC.pm
Criterion Covered Total %
statement 18 68 26.4
branch 0 28 0.0
condition 0 10 0.0
subroutine 6 10 60.0
pod 0 3 0.0
total 24 119 20.1


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::MCP4DAC
3             # Description : Control MCP4xxx Digital 2 Analog ICs
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::MCP4DAC;
10              
11             #########################################################################################
12              
13 1     1   1034 use strict;
  1         3  
  1         28  
14 1     1   18 use warnings;
  1         2  
  1         26  
15 1     1   5 use parent qw( HiPi::Interface );
  1         13  
  1         5  
16 1     1   67 use Carp;
  1         4  
  1         79  
17 1     1   7 use HiPi qw( :spi :mcp4dac );
  1         1  
  1         215  
18 1     1   18 use HiPi::Device::SPI;
  1         2  
  1         768  
19              
20             our $VERSION ='0.81';
21              
22             __PACKAGE__->create_accessors( qw( bitsperword minvar ic devicename
23             dualchannel canbuffer buffer gain
24             writemask shiftvalue shiftbits ) );
25              
26             sub new {
27 0     0 0   my( $class, %userparams ) = @_;
28            
29 0           my %params = (
30             devicename => '/dev/spidev0.0',
31             speed => SPI_SPEED_MHZ_1,
32             bitsperword => 8,
33             delay => 0,
34             device => undef,
35             ic => MCP4902,
36             buffer => 0,
37             gain => 0,
38             shiftvalue => 0,
39             );
40            
41 0           foreach my $key (sort keys(%userparams)) {
42 0           $params{$key} = $userparams{$key};
43             }
44            
45             {
46 0           my $ic = $params{ic};
  0            
47            
48 0 0         if( $ic & MCP_DAC_RESOLUTION_12 ) {
    0          
49 0           $params{minvar} = 0;
50 0           $params{shiftbits} = 0;
51 0           $params{writemask} = 0b1111111111111111;
52             } elsif( $ic & MCP_DAC_RESOLUTION_10 ) {
53 0           $params{minvar} = 4;
54 0           $params{shiftbits} = 2;
55 0           $params{writemask} = 0b1111111111111100;
56             } else {
57 0           $params{minvar} = 16;
58 0           $params{shiftbits} = 4;
59 0           $params{writemask} = 0b1111111111110000;
60             }
61            
62 0 0         if( $ic & MCP_DAC_CAN_BUFFER ) {
63 0           $params{canbuffer} = 1;
64             } else {
65 0           $params{canbuffer} = 0;
66             }
67            
68 0 0         if( $ic & MCP_DAC_DUAL_CHANNEL ) {
69 0           $params{dualchannel} = 1;
70             } else {
71 0           $params{dualchannel} = 0;
72             }
73            
74             }
75            
76 0 0         unless( defined($params{device}) ) {
77             my $dev = HiPi::Device::SPI->new(
78             speed => $params{speed},
79             bitsperword => $params{bitsperword},
80             delay => $params{delay},
81             devicename => $params{devicename},
82 0           );
83            
84 0           $params{device} = $dev;
85             }
86            
87 0           my $self = $class->SUPER::new(%params);
88 0           return $self;
89             }
90              
91              
92             sub write {
93 0     0 0   my($self, $value, $channelb) = @_;
94 0   0       $channelb ||= 0;
95 0 0         $channelb = 0 if !$self->dualchannel;
96            
97 0 0         my $output = ( $channelb ) ? MCP_DAC_CHANNEL_B : MCP_DAC_CHANNEL_A;
98 0 0 0       $output += MCP_DAC_BUFFER if($self->canbuffer && $self->buffer);
99 0 0         $output += ( $self->gain ) ? MCP_DAC_GAIN : MCP_DAC_NO_GAIN;
100 0           $output += MCP_DAC_LIVE;
101            
102             # allow user to specify values 1-255 for 8 bit device etc
103            
104 0 0         if( $self->shiftvalue ) {
105 0           $value <<= $self->shiftbits;
106             }
107            
108             # mask the $value. If user specifies shiftvalue == true
109             # and gives a value over 255 for an 8 bit device
110             # confusing things will happen. We only want
111             # 12 bits. If user gets it wrong then at least
112             # all that happens is they get wrong voltage -
113             # instead of potentially writing to wrong channel
114             # or shutting the channel down if we shift a high value
115            
116 0           $value &= 0b111111111111;
117            
118 0 0 0       $value = $self->minvar if( $value > 0 && $value < $self->minvar );
119 0 0         $value = 0 if $value < 0;
120            
121 0           $output += $value;
122 0           $output &= $self->writemask;
123 0           $self->device->transfer( $self->_fmt_val( $output ) );
124             }
125              
126             sub _fmt_val {
127 0     0     my($self, $val) = @_;
128 0           pack('n', $val);
129             }
130              
131             sub shutdown {
132 0     0 0   my($self, $channelb) = @_;
133 0   0       $channelb ||= 0;
134 0 0         $channelb = 0 if !$self->dualchannel;
135 0 0         my $output = ( $channelb ) ? MCP_DAC_CHANNEL_B : MCP_DAC_CHANNEL_A;
136 0           $output += MCP_DAC_SHUTDOWN;
137 0           $self->device->transfer( $self->_fmt_val( $output ) );
138             }
139              
140             1;
141              
142             __END__