File Coverage

blib/lib/Device/BusPirate/Chip/MPL3115A2.pm

Criterion	Covered	Total	%
statement	30	97	30.9
branch	0	4	0.0
condition	0	3	0.0
subroutine	10	54	18.5
pod	1	21	4.7
total	41	179	22.9

#  You may distribute under the terms of either the GNU General Public License
#  or the Artistic License (the same terms as Perl itself)
#
#  (C) Paul Evans, 2015 -- [e-mail]

package Device::BusPirate::Chip::MPL3115A2;

use strict;
use warnings;
use base qw( Device::BusPirate::Chip );

our $VERSION = '0.02';

use Carp;

use constant CHIP => "MPL3115A2";
use constant MODE => "I2C";

use Future::Utils qw( repeat );

use Data::Bitfield qw( bitfield boolfield enumfield );

=head1 NAME

C - use a F chip with C

=head1 DESCRIPTION

This L subclass provides specific communication to a
F F chip attached to the F via
I2C.

The reader is presumed to be familiar with the general operation of this chip;
the documentation here will not attempt to explain or define chip-specific
concepts or features, only the use of this module to access them.

=cut

# This device has a constant address
my $ADDR = 0x60;

use constant WHO_AM_I_ID => 0xC4;

use constant {
   REG_STATUS          => 0x00,
   REG_OUT_P_MSB       => 0x01,
   REG_OUT_P_CSB       => 0x02,
   REG_OUT_P_LSB       => 0x03,
   REG_OUT_T_MSB       => 0x04,
   REG_OUT_T_LSB       => 0x05,
   REG_DR_STATUS       => 0x06,
   REG_OUT_P_DELTA_MSB => 0x07,
   REG_OUT_P_DELTA_CSB => 0x08,
   REG_OUT_P_DELTA_LSB => 0x09,
   REG_OUT_T_DELTA_MSB => 0x0A,
   REG_OUT_T_DELTA_LSB => 0x0B,
   REG_WHO_AM_I        => 0x0C,
   REG_F_STATUS        => 0x0D,
   REG_F_DATA          => 0x0E,
   REG_F_SETUP         => 0x0F,
   REG_TIME_DLY        => 0x10,
   REG_SYSMOD          => 0x11,
   REG_INT_SOURCE      => 0x12,
   REG_PT_DATA_CFG     => 0x13,
   REG_BAR_IN_MSB      => 0x14,
   REG_BAR_IN_LSB      => 0x15,
   REG_P_TGT_MSB       => 0x16,
   REG_P_TGT_LSB       => 0x17,
   REG_T_TGT           => 0x18,
   REG_P_WND_MSB       => 0x19,
   REG_P_WND_LSB       => 0x1A,
   REG_T_WND           => 0x1B,
   REG_P_MIN_MSB       => 0x1C,
   REG_P_MIN_CSB       => 0x1D,
   REG_P_MIN_LSB       => 0x1E,
   REG_T_MIN_MSB       => 0x1F,
   REG_T_MIN_LSB       => 0x20,
   REG_P_MAX_MSB       => 0x21,
   REG_P_MAX_CSB       => 0x22,
   REG_P_MAX_LSB       => 0x23,
   REG_T_MAX_MSB       => 0x24,
   REG_T_MAX_LSB       => 0x25,
   REG_CTRL_REG1       => 0x26,
   REG_CTRL_REG2       => 0x27,
   REG_CTRL_REG3       => 0x28,
   REG_CTRL_REG4       => 0x29,
   REG_CTRL_REG5       => 0x2A,
   REG_OFF_P           => 0x2B,
   REG_OFF_T           => 0x2C,
   REG_OFF_H           => 0x2D,
};

# Represent CTRL_REG1 to CTRL_REG3 as one three-byte field
bitfield CTRL_REG =>
   # CTRL_REG1
   SBYB => enumfield( 0, qw( STANDBY ACTIVE )),
   OST  => boolfield( 1 ),
   RST  => boolfield( 2 ),
   OS   => enumfield( 3, qw( 1 2 4 8 16 32 64 128 )),
   RAW  => boolfield( 6 ),
   ALT  => boolfield( 7 ),

   # CTRL_REG2
   ST          => enumfield( 8, map { 1 << $_ } 0 .. 15 ),
   ALARM_SEL   => boolfield( 13 ),
   LOAD_OUTPUT => boolfield( 14 ),

   # CTRL_REG3
   IPOL1  => boolfield( 16 ),
   PP_OD1 => boolfield( 17 ),
   IPOL2  => boolfield( 20 ),
   PP_OD2 => boolfield( 21 );

sub _mplread
{
   my $self = shift;
   my ( $reg, $len ) = @_;

   $self->mode->send_then_recv( $ADDR, pack( "C", $reg ), $len );
}

sub _mplwrite
{
   my $self = shift;
   my ( $reg, $val ) = @_;

   $self->mode->send( $ADDR, pack( "C", $reg ) . $val );
}

# Raw 8/16-bit integers
sub _mplread8  { $_[0]->_mplread( $_[1], 1 )
                  ->then( sub { Future->done( unpack "C", $_[0] ) } ) }
sub _mplwrite8 { $_[0]->_mplwrite( $_[1], pack "C", $_[2] ) }

sub _mplread16  { $_[0]->_mplread( $_[1], 2 )
                   ->then( sub { Future->done( unpack "S>", $_[0] ) } ) }
sub _mplwrite16 { $_[0]->mplwrite( $_[1], pack "S>", $_[2] ) }

# Converted pressure
sub _mplread_p { $_[0]->_mplread( $_[1], 3 )
                  ->then( sub { Future->done( unpack( "L>", "\0" . $_[0] ) / 64 ) } ) }

# Converted altitude
sub _mplread_a { $_[0]->_mplread( $_[1], 3 )
                  ->then( sub {
                        my ( $msb, $lsb ) = unpack "s>C", $_[0];
                        Future->done( $msb + ( $lsb / 256 ) ); }) }

# Converted temperature
sub _mplread_t { $_[0]->_mplread( $_[1], 2 )
                  ->then( sub {
                        my ( $msb, $lsb ) = unpack "cC", $_[0];
                        Future->done( $msb + ( $lsb / 256 ) ) }) }

=head1 ACCESSORS

The following methods documented with a trailing call to C<< ->get >> return
L instances.

=cut

=head2 $config = $mpl->read_config->get

Returns a C reference of the contents of control registers C
to C, using fields named from the data sheet.

=head2 $mpl->change_config( %changes )->get

Writes updates to the control registers C to C. This
will be performed as a read-modify-write operation, so any fields not given
as arguments to this method will retain their current values.

Note that these two methods use a cache of configuration bytes to make
subsequent modifications more efficient. This cache will not respect the
"one-shot" nature of the C and C bits.

=cut

sub _cached_read_ctrlreg
{
   my $self = shift;

   defined $self->{configbytes}
      ? return Future->done( $self->{configbytes} )
      : return $self->_mplread( REG_CTRL_REG1, 3 )
}

sub read_config
{
   my $self = shift;

   $self->_cached_read_ctrlreg->then( sub {
      my ( $bytes ) = @_;
      return Future->done( { unpack_CTRL_REG( unpack "L<", $bytes . "\0" ) } );
   });
}

sub change_config
{
   my $self = shift;
   my %changes = @_;

   $self->read_config->then( sub {
      my ( $config ) = @_;
      $config->{$_} = $changes{$_} for keys %changes;

      my $bytes = $self->{configbytes} =
         substr pack( "L<", pack_CTRL_REG( %$config ) ), 0, 3;

      $self->_mplwrite( REG_CTRL_REG1, $bytes );
   });
}

=head2 $pressure = $mpl->get_sealevel_pressure->get

=head2 $mpl->set_sealevel_pressure->get( $pressure )

Read or write the barometric pressure calibration register which is used to
convert pressure to altitude when the chip is in altimeter mode, in Pascals.
The default value is 101,326 Pa.

=cut

sub get_sealevel_pressure { shift->_mplread16( REG_BAR_IN_MSB )
                              ->then( sub { Future->done( $_[0] * 2 ) }) }

sub set_sealevel_pressure { $_[0]->_mplwrite16( REG_BAR_IN_MSB, $_[1] / 2 ) }

=head2 $pressure = $mpl->read_pressure->get

Returns the value of the C registers, suitably converted into
Pascals. (The chip must be in barometer mode and must I be in C mode
for the conversion to work).

=cut

sub read_pressure { shift->_mplread_p( REG_OUT_P_MSB ) }

=head2 $altitude = $mpl->read_altitude->get

Returns the value of the C registers, suitably converted into metres.
(The chip must be in altimeter mode and must I be in C mode for the
conversion to work).

=cut

sub read_altitude { shift->_mplread_a( REG_OUT_P_MSB ) }

=head2 $temperature = $mpl->read_temperature->get

Returns the value of the C registers, suitable converted into degrees
C. (The chip must I be in C mode for the conversion to work).

=cut

sub read_temperature { shift->_mplread_t( REG_OUT_T_MSB ) }

=head2 $pressure = $mpl->read_min_pressure->get

=head2 $pressure = $mpl->read_max_pressure->get

Returns the values of the C and C registers, suitably converted
into Pascals.

=head2 $mpl->clear_min_pressure->get

=head2 $mpl->clear_max_pressure->get

Clear the C or C registers, resetting them to start again from
the next measurement.

=cut

sub read_min_pressure { shift->_mplread_p( REG_P_MIN_MSB ) }
sub read_max_pressure { shift->_mplread_p( REG_P_MAX_MSB ) }

sub clear_min_pressure { shift->_mplwrite( REG_P_MIN_MSB, "\x00\x00\x00" ) }
sub clear_max_pressure { shift->_mplwrite( REG_P_MAX_MSB, "\x00\x00\x00" ) }

=head2 $altitude = $mpl->read_min_altitude->get

=head2 $altitude = $mpl->read_max_altitude->get

Returns the values of the C and C registers, suitably converted
into metres.

=cut

=head2 $mpl->clear_min_altitude->get

=head2 $mpl->clear_max_altitude->get

Clear the C or C registers, resetting them to start again from
the next measurement.

=cut

sub read_min_altitude { shift->_mplread_a( REG_P_MIN_MSB ) }
sub read_max_altitude { shift->_mplread_a( REG_P_MAX_MSB ) }

*clear_min_altitude = \&clear_min_pressure;
*clear_max_altitude = \&clear_max_pressure;

=head2 $temperature = $mpl->read_min_temperature->get

=head2 $temperature = $mpl->read_max_temperature->get

Returns the values of the C and C registers, suitably converted
into metres.

=head2 $mpl->clear_min_temperature->get

=head2 $mpl->clear_max_temperature->get

Clear the C or C registers, resetting them to start again from
the next measurement.

=cut

sub read_min_temperature { shift->_mplread_t( REG_T_MIN_MSB ) }
sub read_max_temperature { shift->_mplread_t( REG_T_MAX_MSB ) }

sub clear_min_temperature { shift->_mplwrite( REG_T_MIN_MSB, "\x00\x00" ) }
sub clear_max_temperature { shift->_mplwrite( REG_T_MAX_MSB, "\x00\x00" ) }

=head1 METHODS

=cut

=head2 $mpl->check_id->get

Reads the C register and checks for a valid ID result. The returned
future fails if the expected result is not received.

=cut

sub check_id
{
   my $self = shift;

   $self->_mplread8( REG_WHO_AM_I )->then( sub {
      my ( $id ) = @_;
      $id == WHO_AM_I_ID or
         die sprintf "Incorrect response from WHO_AM_I register (got %02X, expected %02X)\n",
            $id, WHO_AM_I_ID;

      Future->done( $self );
   });
}

=head2 $mpl->start_oneshot->get

Sets the C bit of C to start a one-shot measurement when in
standby mode. After calling this method you will need to use
C to wait for the measurement to finish, or rely somehow on
the interrupts.

=cut

sub start_oneshot
{
   my $self = shift;

   $self->_cached_read_ctrlreg->then( sub {
      my ( $bytes ) = @_;
      my $ctrl_reg1 = substr( $bytes, 0, 1 ) | "\x02"; # Set OST bit
      $self->_mplwrite( REG_CTRL_REG1, $ctrl_reg1 );
   });
}

=head2 $mpl->busywait_oneshot->get

Repeatedly reads the C bit of C until it becomes clear.

=cut

sub busywait_oneshot
{
   my $self = shift;

   repeat {
      $self->_mplread( REG_CTRL_REG1, 1 )->then( sub {
         Future->done( ord( $_[0] ) & 0x02 )
      });
   } until => sub { !$_[0]->failure and !$_[0]->get };
}

=head2 $mpl->oneshot->get

A convenient wrapper around C and C.

=cut

sub oneshot
{
   my $self = shift;

   $self->start_oneshot->then( sub {
      $self->busywait_oneshot
   });
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;