File Coverage

blib/lib/Device/Chip/MCP4725.pm
Criterion Covered Total %
statement 37 37 100.0
branch 4 6 66.6
condition 2 8 25.0
subroutine 10 10 100.0
pod 3 4 75.0
total 56 65 86.1


line stmt bran cond sub pod time code
1             # You may distribute under the terms of either the GNU General Public License
2             # or the Artistic License (the same terms as Perl itself)
3             #
4             # (C) Paul Evans, 2016 -- leonerd@leonerd.org.uk
5              
6             package Device::Chip::MCP4725;
7              
8 3     3   64570 use strict;
  3         5  
  3         82  
9 3     3   11 use warnings;
  3         5  
  3         87  
10 3     3   22 use base qw( Device::Chip );
  3         5  
  3         689  
11              
12             our $VERSION = '0.01';
13              
14 3     3   9630 use Carp;
  3         6  
  3         201  
15              
16 3     3   14 use constant PROTOCOL => "I2C";
  3         3  
  3         1267  
17              
18             =encoding UTF-8
19              
20             =head1 NAME
21              
22             C - chip driver for F
23              
24             =head1 SYNOPSIS
25              
26             use Device::Chip::MCP4725;
27              
28             my $chip = Device::Chip::MCP4725->new;
29             $chip->mount( Device::Chip::Adapter::...->new )->get;
30              
31             # Presuming Vcc = 5V
32             $chip->write_dac( 4096 * 1.23 / 5 )->get;
33             print "Output is now set to 1.23V\n";
34              
35             =head1 DESCRIPTION
36              
37             This L subclass provides specific communication to a
38             F F attached to a computer via an I²C adapter.
39              
40             The reader is presumed to be familiar with the general operation of this chip;
41             the documentation here will not attempt to explain or define chip-specific
42             concepts or features, only the use of this module to access them.
43              
44             =cut
45              
46             =head1 MOUNT PARAMETERS
47              
48             =head2 addr
49              
50             The I²C address of the device. Can be specified in decimal, octal or hex with
51             leading C<0> or C<0x> prefixes.
52              
53             =cut
54              
55             sub I2C_options
56             {
57 2     2 0 508 my $self = shift;
58 2         6 my %params = @_;
59              
60 2   50     13 my $addr = delete $params{addr} // 0x60;
61 2 50       9 $addr = oct $addr if $addr =~ m/^0/;
62              
63             return (
64 2         13 addr => $addr,
65             max_bitrate => 400E3,
66             );
67             }
68              
69             =head1 ACCESSORS
70              
71             The following methods documented with a trailing call to C<< ->get >> return
72             L instances.
73              
74             =cut
75              
76             my @POWERDOWN_TO_NAME = qw( normal 1k 100k 500k );
77             my %NAME_TO_POWERDOWN = map { $POWERDOWN_TO_NAME[$_] => $_ } 0 .. $#POWERDOWN_TO_NAME;
78              
79             =head2 read_config
80              
81             $config = $chip->read_config->get
82              
83             Returns a C reference containing the chip's current configuration
84              
85             RDY => 0 | 1
86             POR => 0 | 1
87              
88             PD => "normal" | "1k" | "100k" | "500k"
89             DAC => 0 .. 4095
90              
91             EEPROM_PD => "normal" | "1k" | "100k" | "500k"
92             EEPROM_DAC => 0 .. 4095
93              
94             =cut
95              
96             sub read_config
97             {
98 1     1 1 115 my $self = shift;
99              
100             $self->protocol->read( 5 )->then( sub {
101 1     1   179 my ( $bytes ) = @_;
102 1         8 my ( $status, $dac, $eeprom ) = unpack( "C S> S>", $bytes );
103              
104 1         16 Future->done({
105             RDY => !!( $status & 0x80 ),
106             POR => !!( $status & 0x40 ),
107             PD => $POWERDOWN_TO_NAME[ ( $status & 0x06 ) >> 1 ],
108              
109             DAC => $dac >> 4,
110              
111             EEPROM_PD => $POWERDOWN_TO_NAME[ ( $eeprom & 0x6000 ) >> 13 ],
112             EEPROM_DAC => ( $eeprom & 0x0FFF ),
113             });
114 1         4 });
115             }
116              
117             =head1 METHODS
118              
119             =cut
120              
121             =head2 write_dac
122              
123             $chip->write_dac( $dac, $powerdown )->get
124              
125             Writes a new value for the DAC output and powerdown state in "fast" mode.
126              
127             C<$powerdown> is optional and will default to 0 if not provided.
128              
129             =cut
130              
131             sub write_dac
132             {
133 2     2 1 1768 my $self = shift;
134 2         3 my ( $dac, $powerdown ) = @_;
135              
136 2         3 $dac &= 0x0FFF;
137              
138 2         3 my $pd = 0;
139 2 100 33     9 $pd = $NAME_TO_POWERDOWN{$powerdown} // croak "Unrecognised powerdown state '$powerdown'"
140             if defined $powerdown;
141              
142 2         7 $self->protocol->write( pack "S>", $pd << 12 | $dac );
143             }
144              
145             =head2 write_dac_and_eeprom
146              
147             $chip->write_dac_and_eeprom( $dac, $powerdown )
148              
149             As L but also updates the EEPROM with the same values.
150              
151             =cut
152              
153             sub write_dac_and_eeprom
154             {
155 1     1 1 1418 my $self = shift;
156 1         2 my ( $dac, $powerdown ) = @_;
157              
158 1         2 $dac &= 0x0FFF;
159              
160 1         2 my $pd = 0;
161 1 50 0     5 $pd = $NAME_TO_POWERDOWN{$powerdown} // croak "Unrecognised powerdown state '$powerdown'"
162             if defined $powerdown;
163              
164 1         6 $self->protocol->write( pack "C S>", 0x60 | $pd << 1, $dac << 4 );
165             }
166              
167             =head1 AUTHOR
168              
169             Paul Evans
170              
171             =cut
172              
173             0x55AA;