#  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, 2016 -- leonerd@leonerd.org.uk

package Device::Chip::PCF8574;

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

our $VERSION = '0.01';

use constant PROTOCOL => "I2C";

=encoding UTF-8

=head1 NAME

C<Device::Chip::PCF8574> - chip driver for a F<PCF8574>

=head1 DESCRIPTION

This L<Device::Chip> subclass provides specific communication to a
F<NXP> or F<Texas Instruments> F<PCF8574> attached to a computer via an I²C
adapter.

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

=head1 MOUNT PARAMETERS

=head2 addr

The I²C address of the device. Can be specified in decimal, octal or hex with
leading C<0> or C<0x> prefixes.

=cut

sub I2C_options
{
   my $self = shift;
   my %opts = @_;

   my $addr = $opts{addr} // 0x20;
   $addr = oct $addr if $addr =~ m/^0/;

   return (
      addr        => $addr,
      max_bitrate => 400E3,
   );
}

=head1 METHODS

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

=cut

=head2 write

   $pcf->write( $val )->get

Sets the value of the GPIO pins, as an 8-bit integer.

Pins set low will sink current suitable for signalling or driving an LED. Pins
set high will source current via a weak current-source to act as a pull-up for
an active-low input signal, such as a button.

=cut

sub write
{
   my $self = shift;
   my ( $v ) = @_;

   $self->protocol->write( pack( "C", $v ) );
}

=head2 read

   $val = $pcf->read->get

Reads the current logic levels on the GPIO pins, returned as an 8-bit
integer. Pins of interest as inputs should have previously been set to high
level using the L</write> method.

=cut

sub read
{
   my $self = shift;

   $self->protocol->read( 1 )
      ->then( sub {
         my ( $b ) = @_;
         Future->done( unpack "C", $b );
      });
}

=head2 as_adapter

   $adapter = $pcf->as_adapter

Returns a new object implementing the L<Device::Chip::Adapter> interface which
allows access to the GPIO pins of the chip as if it was a GPIO protocol
adapter. The returned instance supports the following methods:

   $protocol = $adapter->make_protocol( 'GPIO' )

   $protocol->list_gpios
   $protocol->write_gpios
   $protocol->read_gpios
   $protocol->tris_gpios

=cut

sub as_adapter
{
   my $self = shift;

   return Device::Chip::PCF8574::_Adapter->new( $self );
}

package # hide from indexer
   Device::Chip::PCF8574::_Adapter;
use base qw( Device::Chip::Adapter );

use Carp;

use Future;

sub new
{
   my $class = shift;
   bless { chip => $_[0], mask => 0xFF }, $class;
}

sub make_protocol_GPIO { Future->done( shift ) }

my %GPIOs = (
   map { +"P$_", ( 1 << $_ ) } 0 .. 7
);

sub list_gpios
{
   return sort keys %GPIOs;
}

sub write_gpios
{
   my $self = shift;
   my ( $gpios ) = @_;

   my $newmask = $self->{mask};

   foreach my $pin ( keys %$gpios ) {
      my $bit = $GPIOs{$pin} or
         croak "Unrecognised GPIO pin name $pin";

      $newmask &= ~$bit;
      $newmask |=  $bit if $gpios->{$pin};
   }

   return Future->done if $newmask == $self->{mask};

   $self->{chip}->write( $self->{mask} = $newmask );
}

sub read_gpios
{
   my $self = shift;
   my ( $gpios ) = @_;

   $self->{chip}->read->then( sub {
      my ( $mask ) = @_;

      my %ret;
      foreach my $pin ( @$gpios ) {
         my $bit = $GPIOs{$pin} or
            croak "Unrecognised GPIO pin name $pin";

         $ret{$pin} = !!( $mask & $bit );
      }

      Future->done( \%ret );
   });
}

sub tris_gpios
{
   my $self = shift;
   my ( $gpios ) = @_;

   $self->write_gpios( { map { $_ => 1 } @$gpios } );
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
