#!/bin/perl

#                        I2C2USB Command

#                    Copyright 2007, Bill Jones
#                         All rights reserved.

# This program is free software; you can redistribute it and/or modify
# it under the terms of The Artistic License 2.0:

# This program is distributed in the hope that it will be useful, but
# WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the Artistic
# License 2.0 for more details.

# You should have received a copy of the Artistic Licensev2.0 with this
# Kit, in the file named "Artistic".  If not, You can find a copy on the
# internet at
# http://www.opensource.org/licenses/artistic-license-2.0.php

# You should also have received a copy of the GNU General Public License
# along with this program in the file named "Copying". If not, write to the
# Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA
# 02111-1307, USA or visit their web page on the internet at
# http://www.gnu.org/copyleft/gpl.html.


# This script sends commands to the Devantech USB to I2C Module for controlling 
# an I2C bus. See http://www.robot-electronics.co.uk/htm/usb_i2c_tech.htm for 
# more information on the adapter.


# This really should be a perl object oriented module based on the 
# the connection and inheriting from Win32::SerialPort.

# For further information please see the SourceForge project homepage at 

# or email me at 
# bjones1024@users.sourceforge.net


package I2CUsb;

use strict;

my $OSTYPE = $^O;

if($OSTYPE eq "MSWin32") {
  use Win32;	## not required under all circumstances
  use Win32::API 0.01;
  use Win32::SerialPort qw( :PARAM :STAT :RAW BM_fCtsHold CE_FRAME 0.19 );
} elsif($OSTYPE eq "cygwin") {
#  use Device::SerialPort qw( :PARAM :STAT 0.07 );
}

use Getopt::Long;

my $i2c_addr;
my $PortObj;

sub i2c_init {
  my ($config_file, $comm_port, $verbose) = @_;
  my $result;
  my @required;
  defined $verbose or $verbose = 0;

  # Don't use for now.
  undef $config_file;

  if(defined($config_file) && ($config_file ne "")) {
    # This config_file stuff seems like a lot more trouble then it's
    # worth. Maybe I'll ditch it.  Fix the windows filename
    # backslashes.
    if($OSTYPE eq "MSWin32") {
      $config_file =~ "s:\\:/:g";
    } else {
      $config_file =~ "s:/:\\:g";
    }

    # Try to start up using the settings in the config file
    if(-f $config_file) {
      $PortObj = start Win32::SerialPort ($config_file) || undef $PortObj;
      if(defined $PortObj) {
	print "Using configuration stored in: $config_file\n" if $verbose;
	return $PortObj;
      } else { 
	warn "Couldn't use configuration stored in: $config_file\n" if $verbose;
      }
    }
  }

#  warn "Creating a new configuration in $config_file\n" if $verbose;

  # Either no config file or the port failed to open using it.
  # Create a new port and configure it.
  if($OSTYPE eq "MSWin32") {
    $PortObj = new Win32::SerialPort ($comm_port, !$verbose) || undef $PortObj;
  } else {
    $PortObj = new Device::SerialPort ($comm_port, !$verbose) || undef $PortObj;
  }

  die "Can't open Serial port $comm_port\n" unless defined $PortObj;

  $PortObj->baudrate(19200);
  $PortObj->parity("none");
  $PortObj->parity_enable("FALSE");
  $PortObj->handshake("none");
  $PortObj->databits(8);
  $PortObj->stopbits(2);
  $PortObj->abort_on_error(0);            # cancel read/write [fAbortOnError]
  $PortObj->ignore_null(0);               # discard \000 bytes on input [fNull]
  $PortObj->ignore_no_dsr(0);             # discard input bytes unless DSR [fDsrSensitivity]

  $PortObj->is_read_interval(0x500);      # max time between read char (milliseconds)
  $PortObj->is_read_char_time(0x500);     # avg time between read char
  $PortObj->is_read_const_time(0x500);    # total = (avg * bytes) + const
  $PortObj->is_write_char_time(0x500);
  $PortObj->is_write_const_time(0x500);

  $PortObj->is_binary(1);                 # just say Yes (Win 3.x option)
  $PortObj->is_buffers(64, 64);
  $PortObj->is_read_buf(1);

  $PortObj->user_msg(1);

  $PortObj->write_settings() || undef $PortObj;
  die "Can't open Serial port $comm_port\n" unless defined $PortObj;

  if(defined($config_file) && ($config_file ne "")) {
    $PortObj->save($config_file) || warn "Can't save $config_file\n";
  }

  return $PortObj;
}

sub comm_status {
  my @status = $PortObj->is_status();
  my ($BlockingFlags, $InBytes, $OutBytes, $LatchErrorFlags) = (@status);
  print "raw status: [ @status ]\n";

#   if ($BlockingFlags) { warn "Port is blocked: $BlockingFlags\n"; }
#   if ($BlockingFlags & Win32API::CommPort::BM_fCtsHold) { warn "Waiting for CTS\n"; }
#   if ($LatchErrorFlags & Win32API::CommPort::CE_FRAME) { warn "Framing Error"; }

}


sub i2c_raw_read {
# Reads a packed string from the adapter.
# ($success, $buffer) = i2c_raw_read($count, [$verbose])
#   $buffer is a packed string;
#
  my ($count, $verbose) =(@_);
  defined($verbose) or $verbose = 0;
  my ($this_count, $buffer) = $PortObj->read($count);

  if($this_count != $count) {
    warn "i2c_raw_read: tried to read $count but got $this_count: \n" if $verbose;
    return (0, undef)
  }
  return (1, $buffer);
}

sub i2c_raw_write {
# Write a packed string to the adapter.
# $success = i2c_raw_write($buffer, [$verbose])
#   $buffer is a packed string;
#
  my ($buffer, $verbose) = @_;
  defined($verbose) or $verbose = 0;

  my $this_count = $PortObj->write($buffer);
  if($this_count != length($buffer)) {
    warn "i2c_raw_write: tried to write " . length($buffer) . " but got $this_count: \n" if($verbose);
    return 0;
  }
  return $this_count;
}

sub i2c_read_result {
# Read a packed result string from the adapter.
# ($success, $buffer) = i2c_read_result()
#   $buffer is a packed string;
#
  my ($status, $buffer) = i2c_raw_read(1);
  return 0 unless($status && length($buffer) == 1);
  return unpack "C1", $buffer;
}

sub i2c_read {
# Read a byte from the i2c slave at $addr.
# ($success, $byte) = i2c_read($addr, [$verbose])
#
  my ($addr, $verbose) = (@_);
  defined $verbose or $verbose = 0;
  my $status;
  my $buffer = pack "C2", 0x53, $addr | 0x01;
  my $this_count = i2c_raw_write($buffer);
  (length($buffer) == $this_count) || return (0, undef);
  return (i2c_read_result(), unpack "C1", $buffer);
}

sub i2c_write {
# Write a byte to the slave at $addr.
# $success = i2c_read($addr, $byte, [$verbose])
#
  my($addr, $byte, $verbose) = @_;
  defined $verbose or $verbose = 0;
  my $status;
  my $buffer = pack "C3", 0x53, $addr & ~0x01, $byte ;
  my $this_count = i2c_raw_write($buffer);
  return (0, undef) unless(length($buffer) == $this_count);
  return i2c_read_result();
}

sub i2c_read_reg {
# Read $count bytes from the $reg at I2C slave $addr.
# ($success, $buffer) = i2c_read_reg($addr, $reg, $count, [$verbose])
#
  my ($addr, $reg, $count, $verbose) = @_;
  defined $verbose or $verbose = 0;
  my $status;
  my $buffer = pack "C4",  0x55, $addr | 0x01, $reg, $count;
  my $this_count = i2c_raw_write($buffer);
  return (0, undef) unless(length($buffer) == $this_count);

  ($status, $buffer) = i2c_raw_read($count);
  return (0, undef) unless($status && length($buffer) == $count);
  return (1, unpack "C" . length($buffer), $buffer);
}

sub i2c_write_reg {
# Write $bytes to the $reg at I2C slave $addr.
# $success = i2c_write_reg($addr, $reg, @bytes)
#
  my ($addr, $reg, @bytes) = @_;
  my $this_count;
  my $count;
  my $hex_buffer;
  my $buffer;
  my $index;

  $buffer = pack "C" . (scalar(@bytes) + 4), 0x55, $addr & ~0x01, $reg, scalar(@bytes), @bytes;
  $this_count = i2c_raw_write($buffer);
  return 0 unless(length($buffer) == $this_count);
  return i2c_read_result();
}

sub i2c_version {
# Read the version string from the adapter
# ($success, $version) = i2c_version([$verbose])
#
  my ($verbose) = @_;
  defined $verbose or $verbose = 0;
  my $status;
  my $buffer = pack "C4", 0x5a, 0x01, 0, 0;
  my $this_count = i2c_raw_write($buffer, 1);

  return (0, undef) unless(length($buffer) == $this_count);

  ($status, $buffer) = i2c_raw_read(1);
  return (0, undef) unless($status && length($buffer) == 1);
  return (1, unpack "C" . length($buffer), $buffer);
}

sub i2c_set_pins {
# Set the value of the IO pins on the adapter
# ($success, $value) = i2c_set_pins($value, [$verbose])
#
  my ($value, $verbose) = @_;
  defined $verbose or $verbose = 0;
  my $buffer = pack( "C4", 0x5a, 0x10,$value, 0 );
  my $count = i2c_raw_write($buffer, $verbose);
  my $status;
  return (0, undef) unless($count == length($buffer));
  ($status, $buffer) = i2c_raw_read(1);
  return (0, undef) unless($status);
  return (1, unpack "C", $buffer);
}

sub i2c_get_pins {
# Set the value of the IO pins on the adapter
# ($success, $value) = i2c_get_pins([$verbose])
#

  my ($verbose) = @_;
  defined $verbose or $verbose = 0;
  my $status;
  my $buffer = pack( "C4", 0x5a, 0x11, 0, 0 );
  my $count = i2c_raw_write($buffer, $verbose);
  my $status;
  return (0, undef) unless($count == length($buffer));
  ($status, $buffer) = i2c_raw_read(1);
  return (0, undef) unless($status);
  return (1, unpack "C", $buffer);
}
 
sub i2c_test {
# Junk function for debugging.
#

  my ($count, $verbose) = @_;
  defined($verbose) or $verbose = 0;
  my $value;

  my ($status, $version) = i2c_version(1);
  if($status == 0) {
    warn "Read version failed\n" if $verbose;
    print "i2c version: failed\n";
  } else {
    print "i2c version: $version\n";
  }

  i2c_write_reg($i2c_addr, 0, 1..$count);# || warn "Write failed\n";;
  ($status, $value) = i2c_read_reg($i2c_addr, 0, $count);
  if($status == 0) {
    warn "i2c_test: register read failed.\n";
  } else {
    print "i2c_test: i2c version: $version\n";
  }
}

my %options =
(
 addr => 0x04,
 count => 1,
 interactive => 1,
 port => "COM1",
 register => 0,
 verbose => 0,
# config => "$ENV{HOME}\\.i2c-cmd"
);

my @option_names = ();
@option_names = ( @option_names, "interactive!");
@option_names = ( @option_names, "port=s");
@option_names = ( @option_names, "addr=s");
@option_names = ( @option_names, "register=s");
@option_names = ( @option_names, "count=s");
@option_names = ( @option_names, "read");
@option_names = ( @option_names, "write");
@option_names = ( @option_names, "set-pins=s");
@option_names = ( @option_names, "get-pins");
@option_names = ( @option_names, "version");
@option_names = ( @option_names, "verbose");
@option_names = ( @option_names, "test");
@option_names = ( @option_names, "help");
#@option_names = ( @option_names, "config");

my $help_string = "usage: i2c-cmd ";

foreach my $option (@option_names) {
  $help_string .= "--$option ";
}
$help_string .= " [bytes ...]";

$help_string .= "\n\n";

$help_string .= "
Send commands to the Devantech USB to I2C Module for controlling an I2C bus.
(see http://www.robot-electronics.co.uk/htm/usb_i2c_tech.htm for more information).\n\n";


$help_string .= "\t--port\n";
$help_string .= "\t\tThe comm port that the adapter is attached to. [COM1]\n";
$help_string .= "\t--addr\n";
$help_string .= "\t\tThe target slave's i2c address in hex. [0x04]\n";
$help_string .= "\t--register\n";
$help_string .= "\t\tThe target register on the slave in hex. [0x00]\n";
$help_string .= "\t--count\n";
$help_string .= "\t\tThe number of bytes to read or write in decimal. [1]\n";
$help_string .= "\t--read\n";
$help_string .= "\t\tRead bytes from a slave.\n";
$help_string .= "\t--write\n";
$help_string .= "\t\tWrite bytes to a slave.\n";
$help_string .= "\t--set-pins\n";
$help_string .= "\t\tSet the io pins on the adapter. value is in hex. [0]\n";
$help_string .= "\t--get-pins\n";
$help_string .= "\t\tGet the value of the io pins on the adapter. prints value in hex.\n";
$help_string .= "\t--version\n";
$help_string .= "\t\tReturns the version number of the adapter.\n";

$help_string .= "\t--[no]interactive [interactive]"; 
$help_string .= "
\t\t Takes arguments from the shell command line and executes them [The default].
\t\t --no-interactive is used when loading this file into another perl
\t\t script.\n";

$help_string .= "\t--verbose\n";
$help_string .= "\t\tprints some extra information.\n";
#$help_string .= "\t--config";
#$help_string .= "\t\tUse settings from the config file [~/.i2c-cmd]\n ";
$help_string .= "\t--test\n";
$help_string .= "\t\tDoes whatever I needed it to do the last time I worked on this script :).\n";
$help_string .= "\t--help\n";
$help_string .= "\t\tThis string.\n";

GetOptions(\%options, (@option_names));

if(exists $options{interactive}) {

  if($options{help}) {
    print $help_string;
    exit;
  }

  if($options{verbose}) {
    print "\nArguments:\n";
    map { print "\t$_=$options{$_}\n"; } keys(%options);
    print "\tbytes=[ @ARGV ]\n\n";
  }

  $options{addr} = hex($options{addr}) << 1;
  $options{register} = hex($options{register});
  $options{'set-pins'} = hex($options{'set-pins'}) if exists $options{'set-pins'};

  i2c_init($options{config}, $options{port}, $options{verbose});

  if($options{test}) {
    i2c_test($options{count});
  }

  if($options{version}) {
    my $version = i2c_version($options{verbose});
    printf "Devantech i2c-usb version: %x\n" . $version;
  }

  if($options{write}) {
    @ARGV = (map { hex $_ } (@ARGV));
    my $count= scalar(@ARGV);
    printf "Writing to %2.2x [ " . "%2.2x "x$count . "]\n", $options{addr} >> 1, (@ARGV);
    my $status = i2c_write_reg($options{addr}, $options{register}, @ARGV);
    if($status == 0) {
      warn "Write register failed: $status\n";
    } else {
      print "Write register succeeded\n";
    }
  }

  if($options{read}) {
    my ($status, @buffer) = i2c_read_reg($options{addr}, $options{register}, $options{count});
    if($status == 0) {
      warn "Read register failed: $status\n";
    } else {
      printf "Read Bytes[ " . "%2.2x "x$options{count} . "]\n", scalar(@buffer);
    }
  }

  if(exists $options{'set-pins'}) {
    my ($status, $pins) = i2c_set_pins($options{'set-pins'});

    if($status == 0) {
      warn "set-pins: failed.\n";
    } else {
      printf "set-pins: pins: 0x%.x\n", $pins;
    }
  }

  if($options{'get-pins'}) {
    my ($status, $pins) = i2c_get_pins();
    if($status == 0) {
      warn "get-pins: failed.\n";
    } else {
      printf "get-pins: pins: 0x%.2x\n", $pins;
    }
  }
}

END {
  if($PortObj && exists $options{interactive}) {
    $PortObj->close();
    undef $PortObj;  # closes port AND frees memory in perl
  }
}