#! c:\perl\bin\perl -w
#
# Pete Griffiths 2007
# http://picprojects.org.uk
# Serial Addressable RGB LED PWM Driver
# RGB Driver test application
# Version 1.0 for Windows
use strict;

# Download this module from http://www.petesworld.demon.co.uk/homebrew/PIC/simplergb/SerialPort-0_19.zip
use Win32::SerialPort;

my $version = "1.0";

my $Config_File = "rgbtest.cfg";
my $baud = "9600";
my $uport = 1;
my $port;
my $parity = "none";
my $databits = "8";
my $stopbits = "1";
my $handshake = "none";

print "Serial Addressable RGB LED PWM Driver Test Utility\n";
print "Version 1.0 for Windows\n\n";

if (@ARGV){
    
        my $cl_string = join (";",@ARGV) .";";
        chomp $cl_string;
           
             
        $baud = $1 if $cl_string=~ /\/b:(\d+);/; # look for /i:(any digits);
        $uport = ($1) if $cl_string=~ /\/p:(.*?);/; # look for /k:(any characters);
        showUse() if $cl_string=~ /(\?|\/help)/; # look for ? or /help
}

$port = "COM1" if $uport == 1;
$port = "COM2" if $uport == 2;
$port = "COM3" if $uport == 3;
$port = "COM4" if $uport == 4;

my $test=0;
$test = 1 if $baud == 1200;
$test = 1 if $baud == 2400;
$test = 1 if $baud == 9600;
$test = 2 if $baud == 19200;
$test = 2 if $baud == 38400;

unless ($test) {
	      
	      print "$baud is not a valid setting for the bit rate\n\n";
	      exit;
	     }
if ($test==2){
    print "$baud not supported in free version \n\n";
}
	     

print "Using $port @ $baud bps \n";
print "Settings are changed using command line options - rgbtest /? for help \n\n";

$|=1; 


my $PortObj = new Win32::SerialPort ($port)
       || die "Can't open $port: $^E\n";    # $quiet is optional


  $PortObj->baudrate($baud);
  $PortObj->parity($parity);
  $PortObj->databits($databits);
  $PortObj->stopbits($stopbits);
  #$PortObj->handshake($handshake);
  $PortObj->buffers(6, 6);
  $PortObj->write_char_time(0);
  $PortObj->write_const_time(0);
  $PortObj->is_binary(0);
  #$PortObj->datatype('raw');

  #use open IN => ":raw", OUT => ":raw";

  $PortObj->write_settings || undef $PortObj;
  
  $PortObj->save($Config_File)
       || warn "Can't save $Config_File: $^E\n";
       
 $PortObj->close || die "failed to close";
  undef $PortObj; 

  my $tie_ob = tie(*PORT,'Win32::SerialPort', $Config_File)
                 or die "Can't start $Config_File\n";


my @dataline;
    while (<DATA>) {
	push @dataline, $_;
    }

    foreach (@dataline){
		    
	my($red, $green, $blue, $fadeRate, $delay) = split /,/;
	chomp $delay;
	txPacket (255, $red, $green, $blue, $fadeRate);
	txPacket (254, 1,0,1,0);
	
	print "Pause for $delay mS\n";
	Win32::Sleep($delay)
    }

    txPacket (255, 5,5,5,2);
    txPacket (254, 1,0,1,0);    
print "\n Test complete \n";    



	
    
sub txPacket {
	my ($start, $rled, $gled, $bled, $fade) = @_;
	my $addr = 255;
        my $checksum = ((($start + $addr + $rled + $gled + $bled + $fade)^255 )+1) & 255;
       
	my $data = chr($start) .chr($addr) .chr($rled) .chr($gled) .chr($bled) . chr($fade) .chr($checksum);
	
	printf "TX -> Type:%3d | Addr:%3d | D0:%3d | D1:%3d | D2:%3d | D3:%3d | Chksum: %3d\n", $start, $addr, $rled, $gled, $bled, $fade, $checksum;
	syswrite PORT, $data;
	
}
        
        
sub showUse {
    
    print "\n";
    print "Version $version\n";
    print "\n";
    print "rgbtest [/p:commport] [/b:bit_rate] \n\n";
    print "Supports Comm ports 1-4\n";
    print "Supports bit rates 1200, 2400, 9600, 19200, 38400\n";
    print "\n";
    print "Default is COM1, 9600bps\n\n";
    print "Example use:\n";
    print "rgbtest /p:2 /b:1200\n\n";
    die "\n";     
      
    
}
# red, green, blue, fadeRate, packetDelay(mS)
__DATA__
255,0,0,0,500
0,255,0,0,500
0,0,255,0,500
255,0,0,0,500
0,255,0,0,500
0,0,255,0,500
255,0,0,0,500
0,255,0,0,500
0,0,255,0,500
255,0,0,0,500
0,255,0,0,500
0,0,255,0,500
0,0,0,0,0
128,0,0,2,2000
128,128,0,2,2000
0,128,0,2,2000
0,128,128,2,2000
0,0,128,2,2000
128,0,128,2,2000
128,0,0,2,2000
128,128,0,2,2000
0,128,0,2,2000
0,128,128,2,2000
0,0,128,2,2000
128,0,128,2,2000