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__ |