File Coverage

blib/lib/Device/Chip/MAX11200.pm
Criterion Covered Total %
statement 180 201 89.5
branch 10 18 55.5
condition 3 9 33.3
subroutine 40 43 93.0
pod 12 24 50.0
total 245 295 83.0


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   354179 use v5.26;
  2         5  
7 2     2   7 use warnings;
  2         3  
  2         89  
8 2     2   8 use Object::Pad 0.800;
  2         10  
  2         59  
9              
10             package Device::Chip::MAX11200 0.16;
11             class Device::Chip::MAX11200
12             :isa(Device::Chip);
13              
14 2     2   690 use Carp;
  2         8  
  2         131  
15 2     2   11 use Future::AsyncAwait;
  2         3  
  2         11  
16 2     2   1349 use Future::IO;
  2         74367  
  2         149  
17 2     2   580 use Data::Bitfield 0.02 qw( bitfield boolfield enumfield );
  2         11537  
  2         231  
18 2     2   16 use List::Util qw( first );
  2         4  
  2         136  
19              
20 2     2   13 use constant PROTOCOL => "SPI";
  2         4  
  2         973  
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 599 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 1 0 async method init ()
  0         0  
  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             }
84              
85             use constant {
86 2         1330 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         4  
96              
97 11     11 0 3166 async method read_register ( $reg, $len = 1 )
  11         31  
  11         20  
  11         23  
  11         16  
98 11         25 {
99 11         68 my $bytes = await $self->protocol->readwrite(
100             pack "C a*", 0xC1 | ( $reg << 1 ), "\0" x $len
101             );
102              
103 11         37915 return substr $bytes, 1;
104             }
105              
106 6     6 0 1939 async method write_register ( $reg, $val )
  6         19  
  6         13  
  6         19  
  6         11  
107 6         14 {
108 6         36 await $self->protocol->write(
109             pack "C a*", 0xC0 | ( $reg << 1 ), $val
110             );
111             }
112              
113             my @RATES = qw( 1 2.5 5 10 15 30 60 120 );
114              
115             use constant {
116 2         13771 CMD_SELFCAL => 0x10,
117             CMD_SYSOCAL => 0x20,
118             CMD_SYSGCAL => 0x30,
119             CMD_POWERDOWN => 0x08,
120             CMD_CONV => 0,
121 2     2   16 };
  2         3  
122              
123 3     3 0 8 async method command ( $cmd )
  3         9  
  3         8  
  3         4  
124 3         8 {
125 3         80 await $self->protocol->write( pack "C", 0x80 | $cmd );
126             }
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     1 1 1805 async method read_status ()
  1         6  
  1         3  
152 1         3 {
153 1         6 my $bytes = await $self->read_register( REG_STAT );
154              
155 1         125 return unpack_STAT( $bytes );
156             }
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     1 1 13846 async method read_config ()
  1         7  
  1         3  
197 1         2 {
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         151 return $self->{config} = { unpack_CONFIG( $ctrl1 . $ctrl3 ) };
203             }
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     1 1 8898 async method change_config ( %changes )
  1         9  
  1         4  
  1         2  
215 1         3 {
216 1   33     6 my $config = $self->{config} // await $self->read_config;
217              
218 1         16 $self->{config} = { %$config, %changes };
219 1         5 my $ctrlb = pack_CONFIG( %{ $self->{config} } );
  1         9  
220              
221 1         399 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             }
226              
227             =head2 selfcal
228              
229             await $chip->selfcal;
230              
231             Requests the chip perform a self-calibration.
232              
233             =cut
234              
235 1     1 1 6104 async method selfcal ()
  1         5  
  1         3  
236 1         4 {
237 1         5 await $self->command( CMD_SELFCAL );
238             }
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 1 0 async method syscal_offset ()
  0         0  
  0         0  
249 0         0 {
250 0         0 await $self->command( CMD_SYSOCAL );
251             }
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 1 0 async method syscal_gain ()
  0         0  
  0         0  
262 0         0 {
263 0         0 await $self->command( CMD_SYSGCAL );
264             }
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             method default_trigger_rate :lvalue { $_default_trigger_rate }
287              
288 2     2 1 7863 async method trigger ( $rate = $_default_trigger_rate )
  2         8  
  2         6  
  2         3  
289 2         6 {
290 2 50   14   21 defined( my $rateidx = first { $RATES[$_] == $rate } 0 .. $#RATES )
  14         42  
291             or croak "Unrecognised conversion rate $rate";
292              
293 2         18 await $self->command( CMD_CONV | $rateidx );
294             }
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     4 1 11644 async method read_adc ()
  4         16  
  4         6  
310 4         10 {
311 4         18 my $bytes = await $self->read_register( REG_DATA, 3 );
312              
313 4         419 return unpack "L>", "\0$bytes";
314             }
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     1 1 7702 async method read_adc_ratio ()
  1         5  
  1         3  
326 1         6 {
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       166 if( $config->{UB} eq "UNIPOLAR" ) {
333             # Raw 24bit integer
334 0         0 return $value / 2**24;
335             }
336             else {
337 1 50       5 if( $config->{FORMAT} eq "TWOS_COMP" ) {
338             # Signed integer in twos-complement form
339 1 50       6 $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         10 return $value / 2**23;
346             }
347             }
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     3 1 6397 async method write_gpios ( $values, $dir )
  3         12  
  3         7  
  3         6  
  3         5  
366 3         7 {
367 3         22 await $self->write_register( REG_CTRL2, pack "C", ( $dir << 4 ) | $values );
368             }
369              
370 3     3 1 3746 async method read_gpios ()
  3         12  
  3         7  
371 3         7 {
372 3         14 my $bytes = await $self->read_register( REG_CTRL2 );
373              
374 3         281 return 0x0F & unpack "C", $bytes;
375             }
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             BEGIN {
395 2     2   21 use Object::Pad 0.800 ':experimental(mop)';
  2         25  
  2         122  
396 2     2   2718 my $mop = Object::Pad::MOP::Class->for_caller;
397              
398 2         175 foreach (
399             [ "selfcal_offset", REG_SCOC ],
400             [ "selfcal_gain", REG_SCGC ],
401             [ "syscal_offset", REG_SOC ],
402             [ "syscal_gain", REG_SGC ],
403             ) {
404 8         25 my ( $name, $reg ) = @$_;
405              
406 1     1 0 2102 $mop->add_method( "read_$name" => async method () {
  1     1 0 3  
  1     1 0 7  
  1     1 0 2  
407 1         5 my $bytes = await $self->read_register( $reg, 3 );
408 1         102 return unpack "I>", "\0" . $bytes;
409 8         120 } );
410              
411 1     1 0 854 $mop->add_method( "write_$name" => async method ( $value ) {
  1     1 0 5  
  1     1 0 5  
  1     1 0 2  
  1         3  
412 1         8 await $self->write_register( $reg,
413             substr( pack( "I>", $value ), 1 )
414             );
415 8         885 } );
416             }
417             }
418              
419             =head2 as_gpio_adapter
420              
421             $adapter = $chip->as_gpio_adapter
422              
423             Returns an instance implementing the L interface,
424             allowing access to the four GPIO pins via the standard adapter API.
425              
426             =cut
427              
428             method as_gpio_adapter
429             {
430             return Device::Chip::MAX11200::_GPIOAdapter->new( chip => $self );
431             }
432              
433             class Device::Chip::MAX11200::_GPIOAdapter {
434 2     2   274 use Carp;
  2         5  
  2         6581  
435              
436             field $_chip :param;
437              
438 1     1   2 async method make_protocol ( $pname )
  1         4  
  1         3  
  1         2  
439 1         3 {
440 1 50       5 $pname eq "GPIO" or
441             croak "Unrecognised protocol name $pname";
442              
443 1         27 return $self;
444             }
445              
446             method list_gpios { qw( GPIO1 GPIO2 GPIO3 GPIO4 ) }
447              
448             method meta_gpios
449             {
450             return map {
451             Device::Chip::Adapter::GPIODefinition( $_, "rw", 0 )
452             } $self->list_gpios;
453             }
454              
455             field $_dir = "";
456             field $_val = "";
457              
458 2     2   7619 async method write_gpios ( $values )
  2         7  
  2         4  
  2         4  
459 2         5 {
460 2         7 foreach my $n ( 1 .. 4 ) {
461 8 100       31 defined( my $v = $values->{"GPIO$n"} ) or next;
462              
463 2         10 vec( $_dir, $n-1, 1 ) = 1;
464 2         8 vec( $_val, $n-1, 1 ) = $v;
465             }
466              
467 2         10 await $_chip->write_gpios( ord $_val, ord $_dir );
468             }
469              
470 1     1   2 async method tris_gpios ( $pins )
  1         3  
  1         2  
  1         2  
471 1         3 {
472 1         4 my $newdir = $_dir;
473 1         3 foreach my $pin ( @$pins ) {
474 1 50 33     19 $pin =~ m/^GPIO(\d)/ and $1 >= 1 and $1 <= 4 or
      33        
475             croak "Unrecognised GPIO pin name $pin";
476 1         3 my $n = $1;
477              
478 1         7 vec( $newdir, $n-1, 1 ) = 0;
479             }
480              
481 1 50       20 if( $newdir ne $_dir ) {
482 0         0 $_dir = $newdir;
483 0         0 await $_chip->write_gpios( ord $_val, ord $_dir );
484             }
485             }
486              
487 1     1   6252 async method read_gpios ( $pins )
  1         5  
  1         3  
  1         1  
488 1         4 {
489 1         6 await $self->tris_gpios( $pins );
490              
491 1         63 my $read = chr await $_chip->read_gpios;
492              
493 1         93 my %ret;
494 1         4 foreach my $pin ( @$pins ) {
495 1 50       10 $pin =~ m/^GPIO(\d)/ and my $n = $1;
496 1         6 $ret{$pin} = vec( $read, $n-1, 1 );
497             }
498              
499 1         6 return \%ret;
500             }
501             }
502              
503             =head1 AUTHOR
504              
505             Paul Evans
506              
507             =cut
508              
509             0x55AA;