lib/HiPi/Interface/MCP23X17.pm

#########################################################################################
# Package       HiPi::Interface::MCP23X17
# Description:  Base module for MCP23S17 & MCP23X17
# Created       Sun Dec 02 01:42:27 2012
# SVN Id        $Id: MCP23X17.pm 3 2015-03-12 01:07:32Z Mark Dootson $
# Copyright:    Copyright (c) 2012-2016 Mark Dootson
# Licence:      This work is free software; you can redistribute it and/or modify it 
#               under the terms of the GNU General Public License as published by the 
#               Free Software Foundation; either version 3 of the License, or any later 
#               version.
#########################################################################################

package HiPi::Interface::MCP23X17;

#########################################################################################

use strict;
use warnings;
use parent qw( HiPi::Interface );
use HiPi::Constant qw( :raspberry );
use Carp;

__PACKAGE__->create_accessors( qw( address devicename backend ) );

our $VERSION = '0.25';

#-------------------------------------------
# MCP23S17
#------------------------------------------

our $mcp23S17const = {
    MCP23S17_A0     => 0x1000,
    MCP23S17_A1     => 0x1001,
    MCP23S17_A2     => 0x1002,
    MCP23S17_A3     => 0x1003,
    MCP23S17_A4     => 0x1004,
    MCP23S17_A5     => 0x1005,
    MCP23S17_A6     => 0x1006,
    MCP23S17_A7     => 0x1007,
    MCP23S17_B0     => 0x1010,
    MCP23S17_B1     => 0x1011,
    MCP23S17_B2     => 0x1012,
    MCP23S17_B3     => 0x1013,
    MCP23S17_B4     => 0x1014,
    MCP23S17_B5     => 0x1015,
    MCP23S17_B6     => 0x1016,
    MCP23S17_B7     => 0x1017,
    
    MCP23S17_BANK   => 7,
    MCP23S17_MIRROR => 6,
    MCP23S17_SEQOP  => 5,
    MCP23S17_DISSLW => 4,
    MCP23S17_HAEN   => 3,
    MCP23S17_ODR    => 2,
    MCP23S17_INTPOL => 1,
    
    MCP23S17_INPUT  => 1,
    MCP23S17_OUTPUT => 0,
    
    MCP23S17_HIGH   => 1,
    MCP23S17_LOW    => 0,
};

our $mcp23017const =  {
    MCP23017_A0     => 0x1000,
    MCP23017_A1     => 0x1001,
    MCP23017_A2     => 0x1002,
    MCP23017_A3     => 0x1003,
    MCP23017_A4     => 0x1004,
    MCP23017_A5     => 0x1005,
    MCP23017_A6     => 0x1006,
    MCP23017_A7     => 0x1007,
    MCP23017_B0     => 0x1010,
    MCP23017_B1     => 0x1011,
    MCP23017_B2     => 0x1012,
    MCP23017_B3     => 0x1013,
    MCP23017_B4     => 0x1014,
    MCP23017_B5     => 0x1015,
    MCP23017_B6     => 0x1016,
    MCP23017_B7     => 0x1017,
    
    MCP23017_BANK   => 7,
    MCP23017_MIRROR => 6,
    MCP23017_SEQOP  => 5,
    MCP23017_DISSLW => 4,
    MCP23017_HAEN   => 3,
    MCP23017_ODR    => 2,
    MCP23017_INTPOL => 1,
    
    MCP23017_INPUT  => 1,
    MCP23017_OUTPUT => 0,
    
    MCP23017_HIGH   => 1,
    MCP23017_LOW    => 0,
};

our $mcpPinConst = {
    MCP_PIN_A0     => 'A0',
    MCP_PIN_A1     => 'A1',
    MCP_PIN_A2     => 'A2',
    MCP_PIN_A3     => 'A3',
    MCP_PIN_A4     => 'A4',
    MCP_PIN_A5     => 'A5',
    MCP_PIN_A6     => 'A6',
    MCP_PIN_A7     => 'A7',
    MCP_PIN_B1     => 'B0',
    MCP_PIN_B2     => 'B1',
    MCP_PIN_B3     => 'B2',
    MCP_PIN_B4     => 'B3',
    MCP_PIN_B5     => 'B4',
    MCP_PIN_B6     => 'B5',
    MCP_PIN_B7     => 'B6',
    MCP_PIN_B8     => 'B7',
};

our %_r_addr_map;

sub set_address_bank {
    my( $selforclass, $bank) = @_;
    if( $bank == 1 ) {
        $_r_addr_map{IODIRA}   = 0x00;
        $_r_addr_map{IPOLA}    = 0x01;
        $_r_addr_map{GPINTENA} = 0x02;
        $_r_addr_map{DEFVALA}  = 0x03;
        $_r_addr_map{INTCONA}  = 0x04;
        $_r_addr_map{IOCON}    = 0x05;
        $_r_addr_map{GPPUA}    = 0x06;
        $_r_addr_map{INTFA}    = 0x07;
        $_r_addr_map{INTCAPA}  = 0x08;
        $_r_addr_map{GPIOA}    = 0x09;
        $_r_addr_map{OLATA}    = 0x0A;
        $_r_addr_map{IODIRB}   = 0x10;
        $_r_addr_map{IPOLB}    = 0x11;
        $_r_addr_map{GPINTENB} = 0x12;
        $_r_addr_map{DEFVALB}  = 0x13;
        $_r_addr_map{INTCONB}  = 0x14;
        $_r_addr_map{GPPUB}    = 0x16;
        $_r_addr_map{INTFB}    = 0x17;
        $_r_addr_map{INTCAPB}  = 0x18;
        $_r_addr_map{GPIOB}    = 0x19;
        $_r_addr_map{OLATB}    = 0x1A;
    } else {
        $_r_addr_map{IODIRA}   = 0x00;
        $_r_addr_map{IODIRB}   = 0x01;
        $_r_addr_map{IPOLA}    = 0x02;
        $_r_addr_map{IPOLB}    = 0x03;
        $_r_addr_map{GPINTENA} = 0x04;
        $_r_addr_map{GPINTENB} = 0x05;
        $_r_addr_map{DEFVALA}  = 0x06;
        $_r_addr_map{DEFVALB}  = 0x07;
        $_r_addr_map{INTCONA}  = 0x08;
        $_r_addr_map{INTCONB}  = 0x09;
        $_r_addr_map{IOCON}    = 0x0A;
        $_r_addr_map{GPPUA}    = 0x0C;
        $_r_addr_map{GPPUB}    = 0x0D;
        $_r_addr_map{INTFA}    = 0x0E;
        $_r_addr_map{INTFB}    = 0x0F;
        $_r_addr_map{INTCAPA}  = 0x10;
        $_r_addr_map{INTCAPB}  = 0x11;
        $_r_addr_map{GPIOA}    = 0x12;
        $_r_addr_map{GPIOB}    = 0x13;
        $_r_addr_map{OLATA}    = 0x14;
        $_r_addr_map{OLATB}    = 0x15;
    }
}

sub new {
    my ($class, %params) = @_;
    my $self = $class->SUPER::new(%params);
    my $bank = ( $params{bank} ) ? 1 : 0;
    $self->set_address_bank($bank);
    return $self;
}

sub get_register_address {
    my($self, $register) = @_;
    croak(qq(Register $register is not recognised)) unless( exists($_r_addr_map{$register}) );
    my $raddr = $_r_addr_map{$register};
    return $raddr;
}

sub read_register_bits {
    my($self, $register, $numbytes) = @_;
    my @bytes = $self->read_register_bytes($register, $numbytes);
    my @bits;
    while( defined(my $byte = shift @bytes )) {
        my $checkbits = 0b00000001;
        for( my $i = 0; $i < 8; $i++ ) {
            my $val = ( $byte & $checkbits ) ? 1 : 0;
            push( @bits, $val );
            $checkbits *= 2;
        }
    }
    return @bits;
}

sub read_register_bytes {
    my($self, $registername, $numbytes) = @_;
    $numbytes ||= 1;
    my $raddr = $self->get_register_address( $registername );
    my @vals = $self->do_read_register_bytes($raddr, $numbytes);
    # Check if address bank changed
    if( $registername eq 'IOCON' ) {
        my $bank = ( $vals[0] & 0b10000000 ) ? 1 : 0;
        $self->set_address_bank($bank);
    }
    return @vals;
}

sub write_register_bits {
    my($self, $registername, @bits) = @_;
    my $bitcount  = @bits;
    my $bytecount = $bitcount / 8;
    if( $bitcount % 8 ) {
        croak(qq(The number of bits $bitcount cannot be ordered into bytes));
    }
    my @bytes;
    while( $bytecount ) {
        my $byte = 0;
        for(my $i = 0; $i < 8; $i++ ) {
            my $bit = shift @bits;
            $byte += ( $bit << $i );   
        }
        push(@bytes, $byte);
        $bytecount --;
    }
    $self->write_register_bytes($registername,@bytes);
}

sub write_register_bytes { 
    my($self, $registername, @bytes) = @_;
    my $raddr = $self->get_register_address( $registername );
    my $rval = $self->do_write_register_bytes($raddr, @bytes);
    # Check if address bank changed
    if( $registername eq 'IOCON' ) {
        my $bank = ( $bytes[0] & 0b10000000 ) ? 1 : 0;
        $self->set_address_bank($bank);
    }
    return $rval;
}

sub do_read_register_bytes {
    croak 'do_read_register_bytes must be overidden in a derived class';
}

sub do_write_register_bytes {
    croak 'do_write_register_bytes must be overidden in a derived class';
}

sub set_register_bit {
    my($self, $register, $bit, $val) = @_;
    croak qq(invalid bit or pin number $bit) unless $bit =~ /^[0-7]$/;
    my ( $byte ) = $self->read_register_bytes($register, 1);
    my $mask = 1 << $bit;
    $val = ( $val ) ? 1 << $bit : 0;
    $byte = ($byte & ~$mask) | $val;
    $self->write_register_bytes($register, $byte );
    return;
}

sub get_register_bit {
    my($self, $register, $bit) = @_;
    croak qq(invalid bit or pin number $bit) unless $bit =~ /^[0-7]$/;
    my ( $byte ) = $self->read_register_bytes($register, 1);
    my $mask = 1 << $bit;
    return ( $byte & $mask ) ? 1 : 0;
}

sub iocon_bank {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 7, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 7);
    }
    return $val;
}

sub iocon_mirror {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 6, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 6);
    }
    return $val;
}

sub iocon_seqop {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 5, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 5);
    }
    return $val;
}

sub iocon_disslw {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 4, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 4);
    }
    return $val;
}

sub iocon_haen {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 3, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 3);
    }
    return $val;
}

sub iocon_odr {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 2, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 2);
    }
    return $val;
}

sub iocon_intpol {
    my($self, $val) = @_;
    if (defined($val)) {
        $self->set_register_bit('IOCON', 1, $val);
    } else {
        $val = $self->get_register_bit('IOCON', 1);
    }
    return $val;
}

sub _set_any_register_bit {
    my($self, $portprefix, $port, $bit, $val) = @_;
    croak q(invalid GPIO port $port) if $port !~ /^[a-b]$/i;
    my $register = $portprefix . uc($port);
    $self->set_register_bit($register, $bit, $val);
    return;
}

sub _get_any_register_bit {
    my($self, $portprefix, $port, $bit) = @_;
    croak q(invalid GPIO port $port) if $port !~ /^[a-b]$/i;
    my $register = $portprefix . uc($port);
    return $self->get_register_bit($register, $bit);
}

sub _convert_portpin {
    my($self, $portpin) = @_;
    $portpin = uc($portpin);
    my( $port, $pin ) = ( $portpin =~ /^([AB])([0-7])$/ );
    if ($port && defined($pin)) {
        return ( $port, $pin);
    } else {
        croak qq(invalid pin value $portpin);
    }
}

sub _standard_bit_handler {
    my($self, $regbase, $portpin, $val) = @_;
    my( $port, $pin ) = $self->_convert_portpin( $portpin );
    if (defined($val)) {
        $self->_set_any_register_bit( $regbase, $port, $pin, $val );
    } else {
        $val = $self->_get_any_register_bit( $regbase, $port, $pin );
    }
    return $val;
}

# pin value has to read from GPIO but write to OLAT
# so do that all here

sub pin_value {
    my( $self, $portpin, $val) = @_;
    my( $port, $bit ) = $self->_convert_portpin( $portpin );
    
    my $readregister  = 'GPIO' . $port;
    my $writeregister = 'OLAT' . $port;
    
    my ( $byte ) = $self->read_register_bytes($readregister, 1);
    my $mask = 1 << $bit;
    my $returnval = ( $byte & $mask ) ? 1 : 0;
    
    if (defined($val)) {
        $val = ( $val ) ? 1 : 0;
        if ( $val != $returnval ) {
            $returnval = $val;
            $byte = ($byte & ~$mask) | ( $val << $bit );
            $self->write_register_bytes($writeregister, $byte );
        }
    }
    return $returnval;
}

sub pin_mode {
    my( $self, $portpin, $val) = @_;
    return $self->_standard_bit_handler('IODIR', $portpin, $val );
}

sub pin_polarity {
    my( $self, $portpin, $val) = @_;
    return $self->_standard_bit_handler('IPOL', $portpin, $val );
}

sub pin_interrupt_enable {
    my( $self, $portpin, $val) = @_;
    return $self->_standard_bit_handler('GPINTEN', $portpin, $val );
}

sub pin_interrupt_default {
    my( $self, $portpin, $val) = @_;
    return $self->_standard_bit_handler('DEFVAL', $portpin, $val );
}

sub pin_interrupt_control {
    my( $self, $portpin, $val) = @_;
    return $self->_standard_bit_handler('INTCON', $portpin, $val );
}

sub pin_pull_up {
    my( $self, $portpin, $val) = @_;
    return $self->_standard_bit_handler('GPPU', $portpin, $val );
}

#sub pin_interrupt_flag {
#    my( $self, $portpin) = @_;
#    return $self->_standard_bit_handler('INTF', $portpin );
#}
#
#sub pin_interrupt_capture {
#    my( $self, $portpin) = @_;
#    return $self->_standard_bit_handler('INTCAP', $portpin );
#}








1;

__END__
	Global
`s`	Focus search bar
`?`	Bring up this help dialog
	GitHub
`g` `p`	Go to pull requests
`g` `i`	go to github issues (only if github is preferred repository)
	POD
`g` `a`	Go to author
`g` `c`	Go to changes
`g` `i`	Go to issues
`g` `d`	Go to dist
`g` `r`	Go to repository/SCM
`g` `s`	Go to source
`g` `b`	Go to file browse
	Search terms
module: (e.g. module:Plugin)
distribution: (e.g. distribution:Dancer auth)
author: (e.g. author:SONGMU Redis)
version: (e.g. version:1.00)