File Coverage

blib/lib/Device/Chip/MAX11200.pm
Criterion Covered Total %
statement 181 205 88.2
branch 10 18 55.5
condition 3 9 33.3
subroutine 36 40 90.0
pod 14 18 77.7
total 244 290 84.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, 2017-2023 -- leonerd@leonerd.org.uk
5              
6 2     2   314717 use v5.26;
  2         16  
7 2     2   21 use warnings;
  2         6  
  2         105  
8 2     2   14 use Object::Pad 0.800;
  2         18  
  2         91  
9              
10             package Device::Chip::MAX11200 0.15;
11             class Device::Chip::MAX11200
12             :isa(Device::Chip);
13              
14 2     2   645 use Carp;
  2         4  
  2         145  
15 2     2   14 use Future::AsyncAwait;
  2         3  
  2         11  
16 2     2   1156 use Future::IO;
  2         24826  
  2         135  
17 2     2   501 use Data::Bitfield 0.02 qw( bitfield boolfield enumfield );
  2         2283  
  2         164  
18 2     2   16 use List::Util qw( first );
  2         4  
  2         138  
19              
20 2     2   14 use constant PROTOCOL => "SPI";
  2         5  
  2         825  
21              
22             =head1 NAME
23              
24             C - chip driver for F
25              
26             =head1 SYNOPSIS
27              
28             use Device::Chip::MAX11200;
29             use Future::AsyncAwait;
30              
31             my $chip = Device::Chip::MAX11200->new;
32             await $chip->mount( Device::Chip::Adapter::...->new );
33              
34             await $chip->trigger;
35              
36             printf "The reading is %d\n", await $chip->read_adc;
37              
38             =head1 DESCRIPTION
39              
40             This L subclass provides specific communications to a F
41             F or F chip.
42              
43             The reader is presumed to be familiar with the general operation of this chip;
44             the documentation here will not attempt to explain or define chip-specific
45             concepts or features, only the use of this module to access them.
46              
47             =cut
48              
49             sub SPI_options
50             {
51             return (
52 1     1 0 401 mode => 0,
53             max_bitrate => 2E6,
54             );
55             }
56              
57             =head1 METHODS
58              
59             The following methods documented in an C expression return L
60             instances.
61              
62             =cut
63              
64             =head2 init
65              
66             await $chip->init;
67              
68             Performs startup self-calibration by setting C and C to zero
69             then requesting a calibration cycle.
70              
71             =cut
72              
73 0         0 async method init ()
  0         0  
74 0         0 {
75 0         0 await $self->change_config(
76             NOSCG => 0,
77             NOSCO => 0,
78             );
79              
80 0         0 await $self->selfcal;
81              
82 0         0 await Future::IO->sleep( 0.25 ); # selfcal takes 200msec (longer at LINEF=50Hz)
83 0     0 1 0 }
84              
85             use constant {
86 2         1254 REG_STAT => 0,
87             REG_CTRL1 => 1,
88             REG_CTRL2 => 2,
89             REG_CTRL3 => 3,
90             REG_DATA => 4,
91             REG_SOC => 5,
92             REG_SGC => 6,
93             REG_SCOC => 7,
94             REG_SCGC => 8,
95 2     2   16 };
  2         5  
96              
97 11         18 async method read_register ( $reg, $len = 1 )
  11         18  
  11         20  
  11         16  
98 11         30 {
99 11         37 my $bytes = await $self->protocol->readwrite(
100             pack "C a*", 0xC1 | ( $reg << 1 ), "\0" x $len
101             );
102              
103 11         21024 return substr $bytes, 1;
104 11     11 0 1739 }
105              
106 6         12 async method write_register ( $reg, $val )
  6         9  
  6         15  
  6         8  
107 6         16 {
108 6         24 await $self->protocol->write(
109             pack "C a*", 0xC0 | ( $reg << 1 ), $val
110             );
111 6     6 0 1292 }
112              
113             my @RATES = qw( 1 2.5 5 10 15 30 60 120 );
114              
115             use constant {
116 2         6381 CMD_SELFCAL => 0x10,
117             CMD_SYSOCAL => 0x20,
118             CMD_SYSGCAL => 0x30,
119             CMD_POWERDOWN => 0x08,
120             CMD_CONV => 0,
121 2     2   18 };
  2         4  
122              
123 3         6 async method command ( $cmd )
  3         4  
  3         7  
124 3         10 {
125 3         10 await $self->protocol->write( pack "C", 0x80 | $cmd );
126 3     3 0 7 }
127              
128             =head2 read_status
129              
130             $status = await $chip->read_status;
131              
132             Returns a C reference containing the chip's current status.
133              
134             RDY => 0 | 1
135             MSTAT => 0 | 1
136             UR => 0 | 1
137             OR => 0 | 1
138             RATE => 1 | 2.5 | 5 | 10 | 15 | 30 | 60 | 120
139             SYSOR => 0 | 1
140              
141             =cut
142              
143             bitfield { format => "bytes-LE" }, STAT =>
144             RDY => boolfield(0),
145             MSTAT => boolfield(1),
146             UR => boolfield(2),
147             OR => boolfield(3),
148             RATE => enumfield(4, @RATES),
149             SYSOR => boolfield(7);
150              
151 1         3 async method read_status ()
  1         2  
152 1         3 {
153 1         4 my $bytes = await $self->read_register( REG_STAT );
154              
155 1         79 return unpack_STAT( $bytes );
156 1     1 1 300 }
157              
158             =head2 read_config
159              
160             $config = await $chip->read_config;
161              
162             Returns a C reference containing the chip's current configuration.
163              
164             SCYCLE => 0 | 1
165             FORMAT => "TWOS_COMP" | "OFFSET"
166             SIGBUF => 0 | 1
167             REFBUF => 0 | 1
168             EXTCLK => 0 | 1
169             UB => "UNIPOLAR" | "BIPOLAR"
170             LINEF => "60Hz" | "50Hz"
171             NOSCO => 0 | 1
172             NOSCG => 0 | 1
173             NOSYSO => 0 | 1
174             NOSYSG => 0 | 1
175             DGAIN => 1 2 4 8 16 # only valid for the MAX11210
176              
177             =cut
178              
179             bitfield { format => "bytes-LE" }, CONFIG =>
180             # CTRL1
181             SCYCLE => boolfield(1),
182             FORMAT => enumfield(2, qw( TWOS_COMP OFFSET )),
183             SIGBUF => boolfield(3),
184             REFBUF => boolfield(4),
185             EXTCLK => boolfield(5),
186             UB => enumfield(6, qw( BIPOLAR UNIPOLAR )),
187             LINEF => enumfield(7, qw( 60Hz 50Hz )),
188             # CTRL2 is all GPIO control; we'll do that elsewhere
189             # CTRL3
190             NOSCO => boolfield(8+1),
191             NOSCG => boolfield(8+2),
192             NOSYSO => boolfield(8+3),
193             NOSYSG => boolfield(8+4),
194             DGAIN => enumfield(8+5, qw( 1 2 4 8 16 ));
195              
196 1         3 async method read_config ()
  1         1  
197 1         4 {
198 1         5 my ( $ctrl1, $ctrl3 ) = await Future->needs_all(
199             $self->read_register( REG_CTRL1 ), $self->read_register( REG_CTRL3 )
200             );
201              
202 1         124 return $self->{config} = { unpack_CONFIG( $ctrl1 . $ctrl3 ) };
203 1     1 1 5759 }
204              
205             =head2 change_config
206              
207             await $chip->change_config( %changes );
208              
209             Changes the configuration. Any field names not mentioned will be preserved at
210             their existing values.
211              
212             =cut
213              
214 1         4 async method change_config ( %changes )
  1         3  
  1         2  
215 1         3 {
216 1   33     5 my $config = $self->{config} // await $self->read_config;
217              
218 1         10 $self->{config} = { %$config, %changes };
219 1         3 my $ctrlb = pack_CONFIG( %{ $self->{config} } );
  1         8  
220              
221 1         264 await Future->needs_all(
222             $self->write_register( REG_CTRL1, substr $ctrlb, 0, 1 ),
223             $self->write_register( REG_CTRL3, substr $ctrlb, 1, 1 ),
224             );
225 1     1 1 6056 }
226              
227             =head2 selfcal
228              
229             await $chip->selfcal;
230              
231             Requests the chip perform a self-calibration.
232              
233             =cut
234              
235 1         31 async method selfcal ()
  1         6  
236 1         4 {
237 1         5 await $self->command( CMD_SELFCAL );
238 1     1 1 4304 }
239              
240             =head2 syscal_offset
241              
242             await $chip->syscal_offset;
243              
244             Requests the chip perform the offset part of system calibration.
245              
246             =cut
247              
248 0         0 async method syscal_offset ()
  0         0  
249 0         0 {
250 0         0 await $self->command( CMD_SYSOCAL );
251 0     0 1 0 }
252              
253             =head2 syscal_gain
254              
255             await $chip->syscal_gain;
256              
257             Requests the chip perform the gain part of system calibration.
258              
259             =cut
260              
261 0         0 async method syscal_gain ()
  0         0  
262 0         0 {
263 0         0 await $self->command( CMD_SYSGCAL );
264 0     0 1 0 }
265              
266             =head2 trigger
267              
268             await $chip->trigger( $rate );
269              
270             Requests the chip perform a conversion of the input level, at the given
271             rate (which must be one of the values specified for the C configuration
272             option); defaulting to the value of L if not defined.
273             Once the conversion is complete it can be read using the C method.
274              
275             =head2 default_trigger_rate
276              
277             $rate = $chip->default_trigger_rate
278             $chip->default_trigger_rate = $new_rate
279              
280             Lvalue accessor for the default trigger rate if L is invoked without
281             one. Initialised to 120.
282              
283             =cut
284              
285             field $_default_trigger_rate = 120;
286 1     1 1 4299 method default_trigger_rate :lvalue { $_default_trigger_rate }
  1         4  
287              
288 2         5 async method trigger ( $rate = $_default_trigger_rate )
  2         3  
  2         3  
289 2         5 {
290 14 50   14   32 defined( my $rateidx = first { $RATES[$_] == $rate } 0 .. $#RATES )
  2         15  
291             or croak "Unrecognised conversion rate $rate";
292              
293 2         11 await $self->command( CMD_CONV | $rateidx );
294 2     2 1 5562 }
295              
296             =head2 read_adc
297              
298             $value = await $chip->read_adc;
299              
300             Reads the most recent reading from the result register on the tip. This method
301             should be called after a suitable delay after the L method when in
302             single cycle mode, or at any time when in continuous mode.
303              
304             The reading is returned directly from the chip as a plain 24-bit integer,
305             either signed or unsigned as per the C configuration.
306              
307             =cut
308              
309 4         9 async method read_adc ()
  4         5  
310 4         12 {
311 4         12 my $bytes = await $self->read_register( REG_DATA, 3 );
312              
313 4         300 return unpack "L>", "\0$bytes";
314 4     4 1 9077 }
315              
316             =head2 read_adc_ratio
317              
318             $ratio = await $chip->read_adc_ratio;
319              
320             Converts a reading obtained by L into a ratio between -1 and 1,
321             taking into account the current mode setting of the chip.
322              
323             =cut
324              
325 1         2 async method read_adc_ratio ()
  1         2  
326 1         4 {
327             my ( $value, $config ) = await Future->needs_all(
328             $self->read_adc,
329 1         6 ( $self->{config} ? Future->done( $self->{config} ) : $self->read_config )
330             );
331              
332 1 50       146 if( $config->{UB} eq "UNIPOLAR" ) {
333             # Raw 24bit integer
334 0         0 return $value / 2**24;
335             }
336             else {
337 1 50       30 if( $config->{FORMAT} eq "TWOS_COMP" ) {
338             # Signed integer in twos-complement form
339 1 50       12 $value -= 2**24 if $value >= 2**23;
340             }
341             else {
342             # Signed-integer in offset form
343 0         0 $value -= 2**23;
344             }
345 1         11 return $value / 2**23;
346             }
347 1     1 1 4224 }
348              
349             =head2 write_gpios
350              
351             await $chip->write_gpios( $values, $direction );
352              
353             =head2 read_gpios
354              
355             $values = await $chip->read_gpios;
356              
357             Sets or reads the values of the GPIO pins as a 4-bit integer. Bits in the
358             C<$direction> should be high to put the corresponding pin into output mode, or
359             low to put it into input mode.
360              
361             As an alternative to these methods, see instead L.
362              
363             =cut
364              
365 3         7 async method write_gpios ( $values, $dir )
  3         6  
  3         5  
  3         4  
366 3         40 {
367 3         18 await $self->write_register( REG_CTRL2, pack "C", ( $dir << 4 ) | $values );
368 3     3 1 3732 }
369              
370 3         4 async method read_gpios ()
  3         7  
371 3         12 {
372 3         48 my $bytes = await $self->read_register( REG_CTRL2 );
373              
374 3         219 return 0x0F & unpack "C", $bytes;
375 3     3 1 2848 }
376              
377             =head2 Calibration Registers
378              
379             $value = await $chip->read_selfcal_offset;
380             $value = await $chip->read_selfcal_gain;
381             $value = await $chip->read_syscal_offset;
382             $value = await $chip->read_syscal_gain;
383              
384             await $chip->write_selfcal_offset( $value );
385             await $chip->write_selfcal_gain( $value );
386             await $chip->write_syscal_offset( $value );
387             await $chip->write_syscal_gain( $value );
388              
389             Reads or writes the values of the calibration registers, as plain 24-bit
390             integers.
391              
392             =cut
393              
394             foreach (
395             [ "selfcal_offset", REG_SCOC ],
396             [ "selfcal_gain", REG_SCGC ],
397             [ "syscal_offset", REG_SOC ],
398             [ "syscal_gain", REG_SGC ],
399             ) {
400             my ( $name, $reg ) = @$_;
401              
402 2     2   19 no strict 'refs';
  2         5  
  2         1324  
403              
404 1         4 *{"read_$name"} = async method () {
  1         3  
  1         2  
405 1         4 my $bytes = await $self->read_register( $reg, 3 );
406 1         76 return unpack "I>", "\0" . $bytes;
407 1     1   1601 };
408              
409 1         4 *{"write_$name"} = async method ( $value ) {
  1         2  
  1         3  
  1         2  
410 1         9 await $self->write_register( $reg,
411             substr( pack( "I>", $value ), 1 )
412             );
413 1     1   544 };
414             }
415              
416             =head2 as_gpio_adapter
417              
418             $adapter = $chip->as_gpio_adapter
419              
420             Returns an instance implementing the L interface,
421             allowing access to the four GPIO pins via the standard adapter API.
422              
423             =cut
424              
425             method as_gpio_adapter
426 1     1 1 1001 {
427 1         22 return Device::Chip::MAX11200::_GPIOAdapter->new( chip => $self );
428             }
429              
430             class Device::Chip::MAX11200::_GPIOAdapter {
431 2     2   257 use Carp;
  2         5  
  2         3400  
432              
433             field $_chip :param;
434              
435 1         3 async method make_protocol ( $pname )
  1         2  
  1         2  
436 1         3 {
437 1 50       5 $pname eq "GPIO" or
438             croak "Unrecognised protocol name $pname";
439              
440 1         16 return $self;
441 1     1   2 }
442              
443 1     1   48 method list_gpios { qw( GPIO1 GPIO2 GPIO3 GPIO4 ) }
  1         17  
444              
445             method meta_gpios
446 0     0   0 {
447             return map {
448 0         0 Device::Chip::Adapter::GPIODefinition( $_, "rw", 0 )
  0         0  
449             } $self->list_gpios;
450             }
451              
452             field $_dir = "";
453             field $_val = "";
454              
455 2         3 async method write_gpios ( $values )
  2         4  
  2         3  
456 2         7 {
457 2         7 foreach my $n ( 1 .. 4 ) {
458 8 100       27 defined( my $v = $values->{"GPIO$n"} ) or next;
459              
460 2         9 vec( $_dir, $n-1, 1 ) = 1;
461 2         8 vec( $_val, $n-1, 1 ) = $v;
462             }
463              
464 2         8 await $_chip->write_gpios( ord $_val, ord $_dir );
465 2     2   5801 }
466              
467 1         2 async method tris_gpios ( $pins )
  1         2  
  1         2  
468 1         3 {
469 1         2 my $newdir = $_dir;
470 1         3 foreach my $pin ( @$pins ) {
471 1 50 33     17 $pin =~ m/^GPIO(\d)/ and $1 >= 1 and $1 <= 4 or
      33        
472             croak "Unrecognised GPIO pin name $pin";
473 1         4 my $n = $1;
474              
475 1         6 vec( $newdir, $n-1, 1 ) = 0;
476             }
477              
478 1 50       12 if( $newdir ne $_dir ) {
479 0         0 $_dir = $newdir;
480 0         0 await $_chip->write_gpios( ord $_val, ord $_dir );
481             }
482 1     1   2 }
483              
484 1         3 async method read_gpios ( $pins )
  1         3  
  1         2  
485 1         4 {
486 1         4 await $self->tris_gpios( $pins );
487              
488 1         51 my $read = chr await $_chip->read_gpios;
489              
490 1         71 my %ret;
491 1         3 foreach my $pin ( @$pins ) {
492 1 50       9 $pin =~ m/^GPIO(\d)/ and my $n = $1;
493 1         6 $ret{$pin} = vec( $read, $n-1, 1 );
494             }
495              
496 1         6 return \%ret;
497 1     1   4789 }
498             }
499              
500             =head1 AUTHOR
501              
502             Paul Evans
503              
504             =cut
505              
506             0x55AA;