Used as an IR Controller to transmit commands from a PC to Mickey Mouse Glow with the Show Ears.
.
Converting GWTS binary commands to iTach API calls
PERL GWTS to IR Pulses (binaries as strings)
##################################################
### Functions for converting hex GWTS commands ###
### to pulses for use with iTach ###
##################################################
# Takes a Hex command, converts it to pulses, and sends to iTach
sub GWTS_cmd_to_iTach {
my($socket) = shift;
my($cmd) = shift;
my(%send) = @_;
my($pulse) = GWTS_command2pulse($cmd);
#print "cmd[$cmd] pulse[$pulse]\n";
my($out) = iTach_sendir_simple($socket,$pulse);
return($out);
} # GWTS_cmd_to_iTach
# Takes a hex GWTS command and converts it to a series
# of IR pulses.
sub GWTS_command2pulse {
my($hexcmd) = shift;
my($binstream) = GWTS_command2binarystream($hexcmd);
#print "[binstreeam]$binstream\n";
my($pulse) = binarystream2pulse($binstream,16);
return($pulse);
} # GWTS_command2pulse
# This function takes a GWTS hex command
# and converts it into a binary stream
# 91 62 D9
# 010001001100100011010100110111
sub GWTS_command2binarystream {
my($cmd) = shift;
my($bin);
# Do the binary stuff
# Byte-by-byte do the following
# * convert hex to bin
# * left pad binary with 0's to 8 bits
# * reverse the binary
# * add start bit "0" and end bit "1"
my(@b); (@b) = split(/ +/,$cmd);
foreach my $i (@b) { # byte by byte
$bin .= "0".reverse(lpad(hex2bin($i),"0",8))."1";
} #end foreach
return($bin);
} # GWTS_command2binarystream
# Converts a binary stream into a IR pulse
sub binarystream2pulse {
my($bin) = shift;
my($mult) = shift;
my($pulse,$lastbit,$pcount);
if( $mult eq "") { $mult = 1; }
$pcount = 0; # how bits for current pulse
$lastbit = "0"; # used to figure out which bit (1 or 0) we are counting
for( my($i)=0;$i<length($bin);$i++) {
my($bit) = substr($bin,$i,1);
if( $bit eq $lastbit ) {
$pcount++;
} else {
$pulse .= ($pcount*$mult).",";
$lastbit = $bit;
$pcount = 1;
} #endif
} #end for
$pulse .= ($pcount*$mult); # get the last pulse
return($pulse);
} # binarystream2pulse
# hex2bin - Converts from Hexadecimal to binary
sub hex2bin {return(&decton(&ntodec($_[0],16),2));}
# decton
# This function converts a decimal number to a
# number of a specified base. If you specify 2
# it converts to binary, 8 to octal, 16 to
# hexadecimal, etc.
# $<Basen> = &decton($<Number>, $<Base>);
sub decton {
my($num) = uc($_[0]);
my($base) = uc($_[1]);
my($bit) = uc($_[2]);
if($bit eq "") {$bit = 32;}
my($retval); my($flag) = 0;
my($show);
my($i); for($i=$bit;$i>-1;$i--) {
my($spt) = &power($base,$i);
my($col) = int($num/$spt);
if($col > 9) {$show = chr($col+55);}
else {$show = $col;}
if($col != 0) {
$num = $num - ($col*$spt);
$flag = 1;
} #endif
if($flag == 1) {
$retval = $retval.$show;
} #endif
} #endfor
if($retval eq "") {$retval = 0;}
return($retval);
}
# ntodec
# Converts a base number back to decimal
# $<decimal> = &ntodec($<Number>, $<Base>);
sub ntodec {
my($num) = uc($_[0]);
my($base) = uc($_[1]);
my($bit) = 0;
my($retval) = 0;
my($show); my($col);
my($i); for($i=length($num)-1;$i>-1;$i--) {
my($spt) = &power($base,$bit++);
my($col) = substr($num,$i,1);
if(ord($col) > 57) {$show = ord($col)-55;}
else {$show = $col;}
$retval = $retval+($show * $spt);
}
return($retval);
} #ntodec
# lpad
# This function receives a string and pads the string out to a given
# length to the left with a given character.
# IN: <string> String to pad
# <char> Character to pad with
# <integer> Length to pad string out to
# <boo> If ture do not truncate
# OUT:<string> padded string
# my($out) = lpad($string,"0",8);
sub lpad {
my($string) = $_[0];
my($char) = $_[1];
my($size) = $_[2];
my($flag) = $_[3]; # do not trunc if true
if( length($string) >= $size && $flag) {return($string);}
my($retval) = "";
my($dif) = $size - length($string);
my($i) = 0;
for($i=0;$i<$dif;$i++) {
$retval = $retval.$char;
} #endfor
$retval = $retval.$string;
undef($string);
return($retval);
} # lpad
iTach PERL API Interface
# =================== iTach Interface ===========================================
# +++++++++++ iTach General Commands
# getdevices
# device device,<moduleaddress>,<moduletype> (one sent for each module)# getversion# get_NET
# sendir,<connectoraddress>,<ID>,<frequency>,
sub iTach_sendir {
my($socket) = shift;
my($module) = shift;
my($connector) = shift;
my($freq) = shift;
my($id) = shift;
my($buffersize) = shift;
my($cmd,$response);
if($buffersize eq "") {$buffersize=1024;}
$cmd = "sendir,$module:$connector";
$response = iTach_cmd($socket,$cmd,$buffersize);
} # iTach_sendir
#device,<moduleaddress>,<moduletype> (one sent for each module)
#where for iTach products;
#<moduleaddress> is |0|1|
#<moduletype> is |WIFI|ETHERNET|3 RELAY|3 IR|1 SERIAL|sub iTach_getdevices {
sub iTach_getdevices {
my($socket) = shift;
my($buffersize) = shift;
my($cmd,$response);
if($buffersize eq "") {$buffersize=1024;}
$cmd = "getdevices";
$response = iTach_cmd($socket,$cmd,$buffersize);
my(@devices);
(@devices) = split(/\n/,$response);
print "DEVICES:\n";showarray(@devices);print "-end\n";
my($iserror) = iTach_unknowncommand($response);
return($response);
} # iTach_getdevices
# parses a line returned from getdevices.
sub iTach_parsedevice {
my($device) = shift;
my(%dev);
($dev{'moduleaddress'},$dev{'moduletype'}) = split(/,/,$device);
return(%dev);
} # iTach_parsedevice
sub iTach_getversion {
my($socket) = shift;
my($buffersize) = shift;
my($cmd,$response);
if($buffersize eq "") {$buffersize=1024;}
$cmd = "getversion";
$response = iTach_cmd($socket,$cmd,$buffersize);
my($iserror) = iTach_unknowncommand($response);
if( $iserror ) {
return(0);
} else {
return($response);
} #endif
} # iTach_getversion
# NET,0:1,<configlock>,<ipsettings>,<ipaddress>,<subnet>,<gateway>
sub iTach_get_NET {
my($socket) = shift;
my($buffersize) = shift;
my($cmd,$response);
if($buffersize eq "") {$buffersize=1024;}
$cmd = "get_NET,0:1";
$response = iTach_cmd($socket,$cmd,$buffersize);
my($iserror) = iTach_unknowncommand($response);
if( !$iserror ) {
my(%net);
($net{'cmd'},$net{'moduleNconnector'},$net{'ipsettings'},$net{'ipaddress'},$net{'subnet'},$net{'gateway'}) = split(/,/,$response);
print "$net{'cmd'},$net{'moduleNconnector'},$net{'ipsettings'},$net{'ipaddress'},$net{'subnet'},$net{'gateway'}\n";
return(%net);
} else {
return(0);
}
} # iTach_get_NET
# +++++++++++ iTechGeneral CMD function
sub iTach_cmd {
#output("-[iTach_cmd]-\n");
my($socket) = shift;
my($cmd) = shift;
my($buffersize) = shift;
my($data);
if($buffersize eq "") { $buffersize = 1024; }
socket_tx($socket,$cmd."\r\n");
$data = socket_rx($socket);
$data =~ s/\r//g;
return($data);
} # iTach_cmd
# +++++++++++ iTach IR Commands
# set_IR set_IR,1:1,<mode>
# get_IR
# stopir
# busyIR
# sendir
# completeir
#Sent to iTach:
#set_IR,1:1,<mode>
#where:
#<mode> is |IR|SENSOR|SENSOR_NOTIFY|IR_BLASTER|LED_LIGHTING|
#Example:
#set_IR,1:3,LED_LIGHTING
#This will set the third IR connector to LED lighting mode.
#
# $out = iTach_set_IR($socket,$module,$connector,"IR");
sub iTach_set_IR {
my($socket) = shift;
my($module) = shift;
my($connector) = shift;
my($mode) = shift;
my($buffersize) = shift;
my($cmd,$response,%ir);
#output("[setir], socket[$socket]\n");
if($buffersize eq "") {$buffersize=1024;}
$cmd = "set_IR,$module:$connector,$mode";
$response = iTach_cmd($socket,$cmd,$buffersize);
my($iserror) = iTach_unknowncommand($response);
if( $iserror ) {
return($iserror);
} else {
return($response);
} #endif
} # iTach_set_IR
# This command will retrieve the current mode setting for a designated connector.
# Sent from iTach in response to get_IR query:
# IR,1:1,<IR|SENSOR|SENSOR_NOTIFY|IR_BLASTER|LED_LIGHTING>\n#iTach_get_IR($socket,1,2);
sub iTach_get_IR {
my($socket) = shift;
my($module) = shift;
my($connector) = shift;
my($buffersize) = shift;
my($cmd,$response,%ir,$mc);
if($buffersize eq "") {$buffersize=1024;}
$cmd = "get_IR,$module:$connector";
$response = iTach_cmd($socket,$cmd,$buffersize);
my($iserror) = iTach_unknowncommand($response);
if( $iserror ) {
return($iserror);
} else {
($ir{'cmd'},$mc,$ir{'type'}) = split(/,/,$response);
($ir{'module'},$ir{'connector'}) = split(/:/,$mc);
#print "IRcmd:$ir{'cmd'}\nIRmod:$ir{'module'}\nIRcon:$ir{'connector'}\nIRtype:$ir{'type'}\n";
return(%ir);
} #endif
} #iTach_get_IR
# response: stopir,<connectoraddress>
# iTach_stopir($socket,$module,$connector);
sub iTach_stopir {
my($socket) = shift;
my($module) = shift;
my($connector) = shift;
my($buffersize) = shift;
my($cmd,$response,%ir);
#output("[stopir], socket[$socket]\n");
if($buffersize eq "") {$buffersize=1024;}
$cmd = "stopir,$module:$connector";
$response = iTach_cmd($socket,$cmd,$buffersize);
if( $iserror ) {
return($iserror);
} else {
my($ir,$mc);
($ir{'cmd'},$mc) = split(/,/,$response);
($ir{'module'},$ir{'connector'}) = split(/:/,$mc);
print "IRcmd:$ir{'cmd'}\nIRmod:$ir{'module'}\nIRcon:$ir{'connector'}\n";
return(%ir);
} #endif
} # iTach_stopir
#busyIR,<connectoraddress>,<ID>
#where:
#<connectoraddress> is the busy connector
#<ID> is |0|1|2|…|65535| (ID is specified in sendir command)
sub iTach_busyIR {
my($response) = shift;
if( $response !~ /busyIR/ ) {
return(0);
} #endif
my($name,$connector,$id,$ret);
($name,$connector,$id) = split(/,/,$response);
return(1,$connector,$id);
} #iTach_busyIR
my(%send);
# Sends a command to the iTach
# <socket> = TCP socket to the iTach
# <pulse command>=List of comma seperate pulse commands
# %ir = hash containing information about how to send the command
# 'f' = frequency. default to 38000
# 'mc' = module:connector
# 'id' = ID to send on
# 'repeat' = how many times to repeat command
# 'offset' = normall 1
# 'multiply' = take each pulse value and multiple by this value
# iTach_sendir_simple($socket,$pulse,%ir);
sub iTach_sendir_simple {
my($socket) = shift;
my($pulses) = shift; # Comma deliminated pulses
my(%ir) = @_; # everything else
#print "SIMPLE:[$socket],[$pulses]\n";
if($ir{'f'} eq "") { $ir{'f'} = "38000"; } # default f to 38000
if($ir{'mc'} eq "") { $ir{'mc'} = "1:3"; } # default mc (module:connector)
if($ir{'id'} eq "") { $ir{'id'} = "1"; } # ID
if($ir{'repeat'} eq "" ) { $ir{'repeat'} = 1; } # Repeat
if($ir{'offset'} eq "") { $ir{'offset'} = 1; } #offset
if($ir{'delim'} eq "") { $ir{'delim'} = ","; }
# If multiply attribute has a value, each pulse is multiplied by that amount.
if( $ir{'multiply'} ne "") {
my(@pulse); (@pulse) = split(/,/,$pulses);
$pulses = "";
foreach $p (@pulse) {
my($val) = $p*$ir{'multiply'};
$pulses .= $val.",";
} #foreach
chop($pulses);
} #endif multiple
# Build comand
my($cmd) = "sendir,$ir{'mc'},$ir{'id'},$ir{'f'},$ir{'repeat'},$ir{'offset'},$pulses";
#print "SEND[$cmd]\n";
my($out) = iTach_cmd($socket,$cmd); # Send command to iTach
my($try) = 1;
while( iTach_busyIR($out) ) {
print "IRBusy.Retry[$try]: [$cmd]\n";
sleep(.01);
$out = iTach_cmd($socket,$cmd); # Send command to iTach
$try++;
if( $try > 10 ) {return(0);}
} #endif
if( iTach_isERR($out) ) {
return(0);
} else {
return($out);
} #endif
} # iTach_sendir
# ---------------- iTach Error Handling
sub iTach_unknowncommand {
my($err) = shift;
if( $err !~ /unknowncommand/ ) {
return(0);
} #endif
my($name,$code);
($name,$code) = split(/,/,$err);
my(%errtable) = iTach_get_error_codes();
my($error) = "iTach Error! [$err]:".$errtable{$code};
output($error);
return(1);
} # iTach_unknowncommand
sub iTach_isERR {
my($out) = shift;
if( $out !~ /ERR_/ ) {
return(0);
} else {
my(%err) = iTach_get_error_codes();
my($mc,$val,$d);
($d,$out) = split(/_/,$out);
($mc,$val) = split(/,/,$out);
print "ERROR:[$val], Connector:[$mc] $err{$val}\n";
return($val);
} #endif
}
sub iTach_get_error_codes {
my(%err);
$err{'001'} = "Invalid command. Command not found.";
$err{'002'} = "Invalid module address (does not exist).";
$err{'003'} = "Invalid connector address (does not exist).";
$err{'004'} = "Invalid ID value.";
$err{'005'} = "Invalid frequency value.";
$err{'006'} = "Invalid repeat value.";
$err{'007'} = "Invalid offset value.";
$err{'008'} = "Invalid pulse count.";
$err{'009'} = "Invalid pulse data.";
$err{'010'} = "Uneven amount of <on|off> statements.";
$err{'011'} = "No carriage return found.";
$err{'012'} = "Repeat count exceeded.";
$err{'013'} = "IR command sent to input connector.";
$err{'014'} = "Blaster command sent to non-blaster connector.";
$err{'015'} = "No carriage return before buffer full.";
$err{'016'} = "No carriage return.";
$err{'017'} = "Bad command syntax.";
$err{'018'} = "Sensor command sent to non-input connector.";
$err{'019'} = "Repeated IR transmission failure.";
$err{'020'} = "Above designated IR \<on\|off\> pair limit.";
$err{'021'} = "Symbol odd boundary.";
$err{'022'} = "Undefined symbol.";
$err{'023'} = "Unknown option.";
$err{'024'} = "Invalid baud rate setting.";
$err{'025'} = "Invalid flow control setting.";
$err{'026'} = "Invalid parity setting.";
$err{'027'} = "Settings are locked.";
return(%err);
} # iTach_get_error_codes