File Coverage

blib/lib/HiPi/Interface/MPL3115A2.pm
Criterion Covered Total %
statement 18 202 8.9
branch 0 78 0.0
condition 0 10 0.0
subroutine 6 28 21.4
pod 0 22 0.0
total 24 340 7.0


line stmt bran cond sub pod time code
1             #########################################################################################
2             # Package HiPi::Interface::MPL3115A2
3             # Description : Interface to MPL3115A2 precision Altimeter
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::MPL3115A2;
10              
11             #########################################################################################
12              
13 1     1   1074 use strict;
  1         3  
  1         30  
14 1     1   5 use warnings;
  1         3  
  1         28  
15 1     1   5 use parent qw( HiPi::Interface );
  1         2  
  1         4  
16 1     1   63 use HiPi qw( :i2c :mpl3115a2 :rpi );
  1         2  
  1         866  
17 1     1   10 use HiPi::RaspberryPi;
  1         2  
  1         15  
18 1     1   21 use Carp;
  1         5  
  1         2408  
19              
20             our $VERSION ='0.81';
21              
22             __PACKAGE__->create_accessors( qw( osdelay backend ) );
23              
24             sub new {
25 0     0 0   my ($class, %userparams) = @_;
26 0           my $pi = HiPi::RaspberryPi->new();
27            
28 0 0         my %params = (
29             devicename => ( $pi->board_type == RPI_BOARD_TYPE_1 ) ? '/dev/i2c-0' : '/dev/i2c-1',
30             address => 0x60,
31             device => undef,
32             osdelay => MPL_OSREAD_DELAY,
33             readmode => I2C_READMODE_REPEATED_START,
34             backend => 'smbus',
35             );
36            
37             # get user params
38 0           foreach my $key( keys (%userparams) ) {
39 0           $params{$key} = $userparams{$key};
40             }
41            
42 0 0         if( $params{busmode} ) {
43 0           $params{backend} = $params{busmode};
44             }
45            
46 0 0         unless( defined($params{device}) ) {
47 0 0         if ( $params{backend} eq 'bcm2835' ) {
48 0           require HiPi::BCM2835::I2C;
49             $params{device} = HiPi::BCM2835::I2C->new(
50             address => $params{address},
51             peripheral => ( $params{devicename} eq '/dev/i2c-0' ) ? HiPi::BCM2835::I2C::BB_I2C_PERI_0() : HiPi::BCM2835::I2C::BB_I2C_PERI_1(),
52             readmode => $params{readmode},
53 0 0         );
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             readmode => $params{readmode},
61 0           );
62             }
63             }
64            
65            
66 0           my $self = $class->SUPER::new(%params);
67             # init
68             {
69 0           my $maxloop = 0;
  0            
70 0           while ( $maxloop++ < 20 ) {
71 0           $self->sysmod;
72 0 0 0       last if( $self->who_am_i && $self->who_am_i == 0xC4);
73 0           $self->device->delay(100);
74             }
75 0           $self->device->delay(100);
76 0           $self->sysmod;
77             }
78            
79 0           return $self;
80             }
81              
82             sub unpack_altitude {
83 0     0 0   my( $self, $msb, $csb, $lsb ) =@_;
84 0           my $alt = $msb << 8;
85 0           $alt += $csb;
86 0 0         if( $msb > 127 ) {
87 0           $alt = 0xFFFF &~$alt;
88 0           $alt ++;
89 0           $alt *= -1;
90             }
91 0 0         $alt += 0.5 if( $lsb & 0b10000000 );
92 0 0         $alt += 0.25 if( $lsb & 0b01000000 );
93 0 0         $alt += 0.125 if( $lsb & 0b00100000 );
94 0 0         $alt += 0.0625 if( $lsb & 0b00010000 );
95 0           return $alt;
96             }
97              
98             sub pack_altitude {
99 0     0 0   my($self, $alt) = @_;
100 0           my $mint = int( $alt );
101 0           my $lsb = 0b1111 & int(0.5 + ( 15.0 * (abs($alt) - abs($mint))));
102 0           $lsb <<= 4;
103            
104 0 0         if( $alt < 0 ) {
105 0           $mint *= -1;
106 0           $mint --;
107 0           $mint = 0xFFFF &~$mint;
108             }
109            
110 0           my $msb = $mint >> 8;
111 0           my $csb = $mint & 0xFF;
112 0           return($msb, $csb, $lsb);
113             }
114              
115             sub unpack_temperature {
116 0     0 0   my( $self, $msb, $lsb ) =@_;
117 0 0         if( $msb > 127 ) {
118 0           $msb = 0xFFFF &~$msb;
119 0           $msb ++;
120 0           $msb *= -1;
121             }
122 0 0         $msb += 0.5 if( $lsb & 0b10000000 );
123 0 0         $msb += 0.25 if( $lsb & 0b01000000 );
124 0 0         $msb += 0.125 if( $lsb & 0b00100000 );
125 0 0         $msb += 0.0625 if( $lsb & 0b00010000 );
126 0           return $msb;
127             }
128              
129             sub pack_temperature {
130 0     0 0   my($self, $temp) = @_;
131 0           my $mint = int( $temp );
132 0           my $lsb = 0b1111 & int(0.495 + ( 15.0 * (abs($temp) - abs($mint))));
133 0           $lsb <<= 4;
134 0 0         if( $temp < 0 ) {
135 0           $mint *= -1;
136 0           $mint --;
137 0           $mint = 0xFF &~$mint;
138             }
139 0           my $msb = $mint & 0xFF;
140 0           return($msb, $lsb);
141             }
142              
143             sub unpack_pressure {
144 0     0 0   my( $self, $msb, $csb, $lsb ) =@_;
145 0           my $alt = $msb << 10;
146 0           $alt += $csb << 2;
147 0           $alt += 0b11 & ( $lsb >> 6 );
148 0 0         $alt += 0.5 if( $lsb & 0b00100000 );
149 0 0         $alt += 0.25 if( $lsb & 0b00010000 );
150 0           return $alt;
151             }
152              
153             sub pack_pressure {
154 0     0 0   my($self, $alt) = @_;
155 0           my $mint = int( $alt );
156 0           my $lsb = 0b1111 & int(0.495 + ( 3.0 * (abs($alt) - abs($mint))));
157 0           $lsb <<= 4;
158 0           my $msb = $mint & 0x3FC00;
159 0           $msb >>= 10;
160 0           my $csb = $mint & 0x3FC;
161 0           $csb >>= 2;
162 0           my $extra = $mint & 0x03;
163 0           $lsb += ($extra << 6);
164 0           return($msb, $csb, $lsb);
165             }
166              
167             sub sysmod {
168 0     0 0   my $self = shift;
169 0           ( $self->device->bus_read(MPL_REG_SYSMOD, 1))[0];
170             }
171              
172             sub who_am_i {
173 0     0 0   my $self = shift;
174 0           ( $self->device->bus_read(MPL_REG_WHO_AM_I, 1))[0];
175             }
176              
177             sub active {
178 0     0 0   my ($self, $set) = @_;
179 0           my ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
180 0           my $rval = $curreg & MPL_CTRL_REG1_SBYB;
181 0 0         if (defined($set)) {
182 0 0         my $setmask = ( $set ) ? MPL_CTRL_REG1_SBYB | $curreg : $curreg &~MPL_CTRL_REG1_SBYB;
183 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $setmask);
184 0           $rval = $setmask & MPL_CTRL_REG1_SBYB;
185             }
186 0           return $rval;
187             }
188              
189             sub reboot {
190 0     0 0   my $self = shift;
191 0           $self->device->bus_write_error(MPL_REG_CTRL_REG1, MPL_CTRL_REG1_RST);
192 0           $self->device->delay(100);
193             }
194              
195              
196             sub oversample {
197 0     0 0   my($self, $newval) = @_;
198 0           my ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
199 0           my $currentval = $curreg & MPL_OVERSAMPLE_MASK;
200 0 0         if(defined($newval)) {
201 0           $newval &= MPL_OVERSAMPLE_MASK;
202 0 0         unless( $currentval == $newval ) {
203 0 0         if( $curreg & MPL_CTRL_REG1_SBYB ) {
204 0           croak('cannot set oversample rate while system is active');
205             }
206 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $curreg | $newval );
207 0           ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
208 0           $currentval = $curreg & MPL_OVERSAMPLE_MASK;
209             }
210             }
211 0           return $currentval;
212             }
213              
214             sub delay_from_oversample {
215 0     0 0   my ($self, $oversample) = @_;
216             # calculate delay needed for oversample to complete.
217             # spec sheet says 60ms at oversample 1 and 1000ms at oversample 128
218             # so if we range at 100ms to 1100ms and the oversample register bits
219             # contain a value of 0 through 7 representing 1 to 128
220             # delay = 100 + 2^$oversample * 1000/128
221 0           $oversample >>= 3;
222 0           return int(100.5 + 2**$oversample * 1000/128);
223             }
224              
225             sub raw {
226 0     0 0   my($self, $newval) = @_;
227 0           my ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
228 0           my $currentval = $curreg & MPL_CTRL_REG1_RAW;
229 0 0         if(defined($newval)) {
230 0           $newval &= MPL_CTRL_REG1_RAW;
231 0 0         unless( $currentval == $newval ) {
232 0 0         if( $curreg & MPL_CTRL_REG1_SBYB ) {
233 0           croak('cannot set raw mode while system is active');
234             }
235 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $curreg | $newval );
236 0           ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
237 0           $currentval = $curreg & MPL_CTRL_REG1_RAW;
238             }
239             }
240 0           return $currentval;
241             }
242              
243             sub mode {
244 0     0 0   my($self, $newmode) = @_;
245 0           my ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
246 0 0         my $currentmode = ( $curreg & MPL_CTRL_REG1_ALT ) ? MPL_FUNC_ALTITUDE : MPL_FUNC_PRESSURE;
247 0 0         if(defined($newmode)) {
248 0 0         unless( $currentmode == $newmode ) {
249 0 0         if( $curreg & MPL_CTRL_REG1_SBYB ) {
250 0           croak('cannot set altitude / pressure mode while system is active');
251             }
252 0 0         my $setmask = ($newmode == MPL_FUNC_ALTITUDE) ? $curreg | MPL_CTRL_REG1_ALT : $curreg &~MPL_CTRL_REG1_ALT;
253 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $setmask );
254 0           ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
255 0 0         $currentmode = ( $curreg & MPL_CTRL_REG1_ALT ) ? MPL_FUNC_ALTITUDE : MPL_FUNC_PRESSURE;
256             }
257             }
258 0           return $currentmode;
259             }
260              
261             sub os_temperature {
262 0     0 0   my $self = shift;
263 0           my ( $pvalue, $tvalue ) = $self->os_any_data;
264 0           return $tvalue;
265             }
266              
267             sub os_pressure {
268 0     0 0   my $self = shift;
269 0           my($pdata, $tdata) = $self->os_both_data( MPL_FUNC_PRESSURE );
270 0           return $pdata;
271             }
272              
273             sub os_altitude {
274 0     0 0   my $self = shift;
275 0           my($pdata, $tdata) = $self->os_both_data( MPL_FUNC_ALTITUDE );
276 0           return $pdata;
277             }
278              
279             sub os_any_data {
280 0     0 0   my $self = shift;
281 0           my ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
282            
283 0 0         my $currentmode = ( $curreg & MPL_CTRL_REG1_ALT ) ? MPL_FUNC_ALTITUDE : MPL_FUNC_PRESSURE;
284 0           my $oversample = ( $curreg & MPL_OVERSAMPLE_MASK );
285            
286             # whatever the original state of CTRL_REG1, we want to restore it with
287             # one shot bit cleared
288 0           my $restorereg = $curreg &~MPL_CTRL_REG1_OST;
289            
290 0           my $delayms = $self->delay_from_oversample($oversample);
291            
292             # clear any one shot bit
293 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $curreg &~MPL_CTRL_REG1_OST );
294             # set one shot bit
295 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $curreg | MPL_CTRL_REG1_OST );
296            
297             # wait before read
298 0           $self->device->delay($delayms);
299            
300             # read data
301 0           my( $pmsb, $pcsb, $plsb, $tmsb, $tlsb)
302             = $self->device->bus_read(MPL_REG_OUT_P_MSB, 5);
303            
304             # convert pressure / altitude data
305 0           my $pdata;
306 0 0         if( $currentmode == MPL_FUNC_ALTITUDE ) {
307 0           $pdata = $self->unpack_altitude( $pmsb, $pcsb, $plsb );
308             } else {
309 0           $pdata = $self->unpack_pressure( $pmsb, $pcsb, $plsb );
310             }
311            
312             # convert temperature data
313 0           my $tdata = $self->unpack_temperature( $tmsb, $tlsb );
314            
315             # restore REG1 clearing any one shot bit
316 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $restorereg );
317            
318             # return both
319 0           return ( $pdata, $tdata );
320             }
321              
322             sub os_both_data {
323 0     0 0   my($self, $function) = @_;
324 0   0       $function //= MPL_FUNC_PRESSURE; # default it not defined
325            
326 0           my ( $curreg ) = $self->device->bus_read(MPL_REG_CTRL_REG1, 1);
327            
328 0 0         my $currentmode = ( $curreg & MPL_CTRL_REG1_ALT ) ? MPL_FUNC_ALTITUDE : MPL_FUNC_PRESSURE;
329 0           my $currentactive = $curreg & 0x01;
330            
331             # we can't change datamodes if system is currently active
332 0 0 0       if($currentactive && ( $currentmode != $function )) {
333 0           croak('cannot switch between pressure and altitude modes when system is active');
334             }
335            
336 0 0         my $ctrlmask = ( $function == MPL_FUNC_ALTITUDE )
337             ? $curreg | MPL_CTRL_REG1_ALT
338             : $curreg &~MPL_CTRL_REG1_ALT;
339            
340 0           $self->device->bus_write(MPL_REG_CTRL_REG1, $ctrlmask );
341 0           $self->os_any_data;
342             }
343              
344             sub os_all_data {
345 0     0 0   my($self ) = @_;
346            
347 0           my( $altitude, $discard ) = $self->os_both_data( MPL_FUNC_ALTITUDE );
348 0           my( $pressure, $tempert ) = $self->os_both_data( MPL_FUNC_PRESSURE );
349            
350 0           return ( $altitude, $pressure, $tempert );
351             }
352              
353             sub sea_level_pressure {
354 0     0 0   my( $class, $pressure, $altitude, $temperature, $gravity) = @_;
355 0   0       $gravity ||= 9.81; # acceleration due to gravity
356 0           my $dgc = 287.0; # dry gas constant
357            
358             # Po = ((P * 1000) * Math.exp((g*Zg)/(Rd * (Tv_avg + 273.15))))/1000;
359            
360 0           my $result = (($pressure * 1000) * exp(($gravity * $altitude)/($dgc * ($temperature + 273.15))))/1000;
361            
362 0           $result = sprintf("%.2f", $result);
363 0           return $result;
364             }
365              
366              
367             1;
368             __END__