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

package Device::Chip::Adapter::BusPirate;

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

use Device::BusPirate;

=head1 NAME

C<Device::Chip::Adapter::BusPirate> - a C<Device::Chip::Adapter> implementation

=head1 DESCRIPTION

This class implements the L<Device::Chip::Adapter> interface for the
I<Bus Pirate>, allowing an instance of a L<Device::Chip> driver to communicate
with the actual chip hardware by using the I<Bus Pirate> as a hardware
adapter.

=cut

=head1 CONSTRUCTOR

=cut

=head2 new

   $adapter = Device::Chip::Adapter::BusPirate->new( %args )

Returns a new instance of a C<Device::Chip::Adapter::BusPirate>. Takes the
same named arguments as L<Device::BusPirate/new>.

=cut

sub new
{
   my $class = shift;

   my $bp = Device::BusPirate->new( @_ );

   bless {
      bp => $bp,
   }, $class;
}

=head1 METHODS

This module provides no new methods beyond the basic API documented in
L<Device::Chip::Adapter/METHODS> at version 0.01.

=cut

sub make_protocol_SPI
{
   my $self = shift;

   $self->{bp}->enter_mode( "SPI" )->then( sub {
      my ( $mode ) = @_;
      $self->{mode} = $mode;

      $mode->configure( open_drain => 0 )
         ->then_done(
            Device::Chip::Adapter::BusPirate::_SPI->new( $mode )
         );
   });
}

sub shutdown
{
   my $self = shift;
   $self->{mode}->power( 0 )->get;
   $self->{bp}->stop;
}

package
   Device::Chip::Adapter::BusPirate::_SPI;

use Carp;

use List::Util qw( first );

sub new
{
   my $class = shift;
   my ( $mode ) = @_;

   bless { mode => $mode }, $class;
}

my @SPEEDS = (qw( 30k 125k 250k 1M 2M 2.6M 4M 8M ));

sub configure
{
    my $self = shift;
    my %args = @_;

    my $mode        = delete $args{mode};
    my $max_bitrate = delete $args{max_bitrate};

    croak "Unrecognised configuration options: " . join( ", ", keys %args )
        if %args;

    # Translate 'max_bitrate' into the highest 'speed' setting the Bus Pirate
    # can set
    my $speed;
    $speed = first {
        my $rate = $_;
        $rate =~ s/k$/000/;
        $rate =~ s/M$/000000/;

        $rate <= $max_bitrate
    } @SPEEDS if defined $max_bitrate;

    $self->{mode}->configure(
        ( defined $mode  ? ( mode  => $mode  ) : () ),
        ( defined $speed ? ( speed => $speed ) : () ),
    );
}

sub power
{
   my $self = shift;
   $self->{mode}->power( @_ );
}

sub readwrite
{
   my $self = shift;
   my ( $data ) = @_;

   $self->{mode}->writeread_cs( $data );
}

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

   # BP has no write-without-read method
   $self->{mode}->writeread_cs( $data )
      ->then_done();
}

=head1 AUTHOR

Paul Evans <leonerd@leonerd.org.uk>

=cut

0x55AA;
