File Coverage

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

Criterion	Covered	Total	%
statement	24	52	46.1
branch	0	4	0.0
condition			n/a
subroutine	8	23	34.7
pod	1	4	25.0
total	33	83	39.7

#  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.01';

use Carp;

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

=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,
};

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-bit integers
sub _mplread8  { $_[0]->_mplread( $_[1], 1 )
                  ->then( sub { Future->done( unpack "C", $_[0] ) } ) }
sub _mplwrite8 { $_[0]->_mplwrite( $_[1], pack "C", $_[2] ) }

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

# 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 $pressure = $mpl->read_pressure->get

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

=cut

sub read_pressure { shift->_mplread_p( 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 ) }

=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->active( $on )->get

Sets/clears the C bit in C, which activates the actual
device. This must be set before pressure / temperature readings will be made.

=cut

sub active
{
   my $self = shift;
   my ( $on ) = @_;

   $self->_mplread8( REG_CTRL_REG1 )->then( sub {
      my ( $val ) = @_;
      $val = ( $val & ~1 );
      $val |= 1 if $on;
      $self->_mplwrite8( REG_CTRL_REG1, $val );
   });
}

=head1 AUTHOR

Paul Evans

=cut

0x55AA;