File Coverage

blib/lib/RPi/ADC/ADS.pm

Criterion	Covered	Total	%
statement	98	137	71.5
branch	39	60	65.0
condition	3	15	20.0
subroutine	16	21	76.1
pod	10	10	100.0
total	166	243	68.3

package RPi::ADC::ADS;

use strict;
use warnings;

our $VERSION = '1.03';

require XSLoader;
XSLoader::load('RPi::ADC::ADS', $VERSION);

use constant {

    DEFAULT_QUEUE       => 0x03,  # bits 1-0 (0-3)
    MAX_QUEUE           => 0x03,

    DEFAULT_POLARITY    => 0x00,  # bit  3
    MAX_POLARITY        => 0x08,

    DEFAULT_RATE        => 0x00,  # bits 7-5
    MAX_RATE            => 0xE0,

    DEFAULT_MODE        => 0x100, # bit  8
    MAX_MODE            => 0x100,

    DEFAULT_GAIN        => 0x200, # bits 11-9
    MAX_GAIN            => 0xE00,

    DEFAULT_CHANNEL     => 0x4000, # bits 14-12
    MAX_CHANNEL         => 0x7000,
};

# channel multiplexer

my %mux = (
    # bit 14-12 (most significant bit shown)

    # single-ended
    0 => 0x4000, # 01000000, 16384
    1 => 0x5000, # 01010000, 20480
    2 => 0x6000, # 01100000, 24576
    3 => 0x7000, # 01110000, 28672

    # differential
    4 => 0x0,    # 00000000, 0
    5 => 0x1000, # 00010000, 4096
    6 => 0x2000, # 00100000, 8192
    7 => 0x3000, # 00110000, 12288
);

# comparitor queue

my %queue = (
    # bit 1-0 (least significant bit shown)

    0 => 0x00, # 00000000, 0
    1 => 0x01, # 00000001, 1
    2 => 0x02, # 00000010, 2
    3 => 0x03, # 00000011, 3
);

# comparator polarity

my %polarity = (
    # bit 3 (least significant bit shown)

    0 => 0x00, # 00000000, 0
    1 => 0x08, # 00000001, 8
);

# data rate

my %rate = (
    # bit 7-5 (least significant bit shown)

    0 => 0x00, # 00000000, 0
    1 => 0x20, # 00100000, 32
    2 => 0x40, # 01000000, 64
    3 => 0x60, # 01100000, 96
    4 => 0x80, # 10000000, 128
    5 => 0xA0, # 10100000, 160
    6 => 0xC0, # 00000001, 192
    7 => 0xE0, # 00000001, 224
);

# operating mode

my %mode = (
    # bit 8 (both bits shown)

    0 => 0x00,  # 0|00000000, 0
    1 => 0x100, # 1|00000000, 256
);

# amplifier gain

my %gain = (
    # bit 11-9 (most significant bit shown)

    0 => 0x00,  # 00000000, 0
    1 => 0x200, # 00000010, 512
    2 => 0x400, # 00000100, 1024
    3 => 0x600, # 00000110, 1536
    4 => 0x800, # 00001000, 2048
    5 => 0xA00, # 00001010, 2560
    6 => 0xC00, # 00001100, 3072
    7 => 0xE00, # 00001110, 3584
);

# map of all the above config register maps

my $param_map;

BEGIN {

    $param_map = {
        channel  => \%mux,
        queue    => \%queue,
        polarity => \%polarity,
        rate     => \%rate,
        mode     => \%mode,
        gain     => \%gain,
    };

    no strict 'refs';

    for my $sub (keys %$param_map) {

        *$sub = sub {

            my ($self, $opt) = @_;

            if (defined $opt) {
                if (! exists $param_map->{$sub}{$opt}) {
                    die "$sub param requires an integer\n";
                }
                $self->{$sub} = $param_map->{$sub}{$opt};
            }

            my $default = "DEFAULT_" . uc $sub;
            my $max     = "MAX_"     . uc $sub;

            $self->{$sub} = __PACKAGE__->$default if ! defined $self->{$sub};
            $self->_bit_set($self->{$sub}, __PACKAGE__->$max);
            return $self->{$sub};
        }
    }
}

# object methods (public)

sub new {
    my ($class, %args) = @_;

    my $self = bless {}, $class;

    # set up the initial default config register

    $self->register(0x80, 0x00);

    # primary C args

    $self->model($args{model});
    $self->addr($args{addr});
    $self->device($args{device});

    # control register switches

    $self->channel($args{channel});
    $self->queue($args{queue});
    $self->polarity($args{polarity});
    $self->mode($args{mode});
    $self->gain($args{gain});

    # default number of conversions to average per read (1 = single read)

    $self->samples($args{samples});

    return $self;
}
sub addr {
    my ($self, $addr) = @_;

    if (defined $addr){
        if (! grep {$addr eq $_} qw(72 73 74 75)){
            die "invalid address. " .
                "Use 0x48 (72), 0x49 (73), 0x4A (74) or 0x4B (75)\n";
        }
        $self->{addr} = $addr;
    }

    $self->{addr} = 0x48 if ! defined $self->{addr};

    return $self->{addr};
}
sub device {
    my ($self, $dev) = @_;

    if (defined $dev){
        if ($dev !~ m|/dev/i2c-\d|){
            die "invalid device name: $dev. " .
                "Must be /dev/i2c-N, where N is 0-9\n";
        }
        $self->{device} = $dev;
    }

    $self->{device} = '/dev/i2c-1' if ! defined $self->{device};

    return $self->{device};
}
sub model {
    my ($self, $model) = @_;

    if (defined $model){
        if ($model !~ /^ADS1[01]1[3458]/){
            die "invalid model name: $model. " .
                "Must be 'ADS1x1y' where x is 1 or 0, and y is 3, 4, 5 or 8\n";
        }
        $self->{model} = $model
    }

    $self->{model} = 'ADS1015' if ! defined $self->{model};

    my ($model_num) = $self->{model} =~ /(\d+)/;

    $self->_resolution($model_num);

    return $self->{model};
}

# operational methods (public)

sub bits {
    my $self = shift;

    my @bytes = $self->register;

    my $bits = ($bytes[0] << 8) | $bytes[1];

    return $bits;
}
sub register {
    my ($self, $msb, $lsb) = @_;

    # config register

    if (defined $msb){
        if (! defined $lsb){
            die "register() requires \$msb and \$lsb params\n";
        }
        if (! grep {$msb == $_} (0..255)){
            die "msg param requires an int 0..255\n";
        }
        if (! grep {$lsb == $_} (0..255)){
            die "lsb param requires an int 0..255\n";
        }

        $self->{register_data} = [$msb, $lsb];
    }

    return @{ $self->{register_data} };
}

# private methods

sub _bit_set {
    # unset and set config register bits

    my ($self, $value, $max) = @_;

    my $bits = $self->bits;

    # unset
    $bits &= ~$max;

    # set
    $bits |= $value;

    my $lsb = $bits & 0xFF;
    my $msb = $bits >> 8;

    $self->register($msb, $lsb);
}
sub _register_data {

    # for testing/validation purposes

    my $tables = {
        mux         => \%mux,
        queue       => \%queue,
        polarity    => \%polarity,
        rate        => \%rate,
        mode        => \%mode,
        gain        => \%gain,
    };

    return $tables;
}
sub _resolution {
    # decides/sets resolution to 12 or 16 bits

    my ($self, $model) = @_;

    if (defined $model){
        if ($model =~ /11\d{2}/){
            $self->{resolution} = 16;
        }
        else {
            $self->{resolution} = 12;
        }
    }
    return $self->{resolution};
}

# device methods

sub samples {
    my ($self, $samples) = @_;

    if (defined $samples){
        if ($samples !~ /^\d+$/ || $samples < 1){
            die "samples() requires a positive integer\n";
        }
        $self->{samples} = $samples;
    }

    $self->{samples} = 1 if ! defined $self->{samples};

    return $self->{samples};
}
sub volts {
    my ($self, $channel, $samples) = @_;

    if (defined $channel){
        $self->channel($channel);
    }

    my $addr = $self->addr;
    my $dev = $self->device;
    my @write_buf = $self->register;

    my $v = voltage_c(
        $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution,
        $self->_samples($samples),
    );

    if ($self->channel > 3 && $v < 0){
        return 0;
    }

    return $v;
}
sub raw {
    my ($self, $channel, $samples) = @_;

    if (defined $channel){
        $self->channel($channel);
    }

    my $addr = $self->addr;
    my $dev = $self->device;
    my @write_buf = $self->register;

    my $r = raw_c(
        $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution,
        $self->_samples($samples),
    );

    if ($self->channel > 3 && $r < 0){
        return 0;
    }

    return $r;

}
sub percent {
    my ($self, $channel, $samples) = @_;

    if (defined $channel){
        $self->channel($channel);
    }

    my $addr = $self->addr;
    my $dev = $self->device;
    my @write_buf = $self->register;

    my $percent = percent_c(
        $addr, $dev, $write_buf[0], $write_buf[1], $self->_resolution,
        $self->_samples($samples),
    );

    $percent = 100 if $percent > 100;

    if ($self->channel > 3 && $percent < 0){
        return 0;
    }

    return sprintf("%.2f", $percent);
}

sub _samples {
    my ($self, $samples) = @_;

    # Per-call override if given, otherwise the object default; validate either.
    $samples = $self->samples if ! defined $samples;

    if ($samples !~ /^\d+$/ || $samples < 1){
        die "samples must be a positive integer\n";
    }

    return $samples;
}

sub _vim {}

1;

__END__