view release on metacpan or  search on metacpan

Slinke.pm  view on Meta::CPAN

	    warn( __PACKAGE__ . " package does not handle response '$response' on device '$device' yet\n" );
	    $this->{ SERIALPORT }->input();
	    return undef;
	}
	
	my $bytesToRead = $Slinke::RESPONSEMAPS{ $device }{ $response };
	if ( $bytesToRead ) {
	    ( $count, $data ) = $this->{ SERIALPORT }->read( $bytesToRead );
	    if ( $count != $bytesToRead ) {
		warn "Read of $response on $device unsuccessful\n";
		return undef;
	    }
	    
	    $data = unpack( "H*", $data ) if defined $data;
	}

	if ( $device eq "PORT_IR" && $response eq "RSP_EQRXPORT" ) {
	    my $str = $this->cleanupRLC( substr( $this->{ PORTDATA }{ $device }, 0, -1 ) );
	    my @t = split / /, $str;
	    my $irport = 1 << $data;
	    push @{$this->{ RECEIVED }}, { PORT => $device, 
					   DATA => [ @t ],
					   TIME => $this->{ PORTTIME }{ $device },
					   IRPORT => $irport, 
					 };

	    $this->{ PORTDATA }{ $device } = "";
	    $this->{ PORTTIME }{ $device } = 0;

	    next if !$returnOnInput;
	}
	
	return ( $device, $response, $data );
    }
}

sub cleanupRLC {
    my $this = shift;
    my @data = split / /, shift;

    # let's make sure that we alternate even and odd numbers
    my @newdata;
    push @newdata, shift @data;
    while ( defined( my $i = shift @data ) ) {
	if ( ( $i > 0 && $newdata[$#newdata] > 0 )
	     || ( $i < 0 && $newdata[$#newdata] < 0 ) ) {
	    $newdata[$#newdata] += $i;
	}
	else {
	    push @newdata, $i;
	}
    }
    
    return join( " ", @newdata );
}

sub int8ToRLC {
    my $this = shift;
    my $data = shift;

    my $oldsign = 33; # don't use 0x00 or 0x80
	
    my $numtime = 0;
    my $num = 0;
    my $signallen = 0;
    my $sign = 1;
    my $numstr;
	
    foreach my $i ( split / */, $data ) {
	$i = ord( $i );
	$sign = $i & 0x80;
	$i &= 0x7f;

	if ($sign != $oldsign) {
	    # signal change
	    if ($oldsign != 33) {
		# write out num first
		$num = -$num if $sign == 0x80; # use sign to indicate 0 periods
				
		$numtime = $num * $this->{ IRSAMPLEPERIOD } + $Slinke::IRSKEWADJUST;
		$numstr .= sprintf( "%.1lf ", $numtime * 1e6 ); # convert to microseconds
		$signallen += abs($numtime);
	    }
	    
	    $oldsign = $sign;
	    $num = $i;
	}
	else {
	    # same signal
	    $num += $i;
	}
    }
	
    # write out the last one
    $num = -$num if !$sign;  # use sign to indicate 0 periods;
	
    $numtime = $num * $this->{ IRSAMPLEPERIOD } + $Slinke::IRSKEWADJUST;
    $numstr .= sprintf( "%.1lf ", $numtime * 1e6 ); # convert to microseconds
    $signallen += abs($numtime);
	
    return ($numstr, $signallen);
}	

sub rlcToInt8 {
    my $this = shift;
    my $data = shift;
	
    my $outsum = 0.0;
    my $truesum = 0;
    my @bin;
	
    foreach my $i ( @$data ) {
	my $sign = $i < 0 ? 0 : 0x80;
	$i = abs( $i );

	$truesum += $i;
	# convert microseconds into the current IR sampling period of the Slink-e
	$i = int(($truesum-$outsum) / $this->{ IRSAMPLEPERIOD } / 1e6 + 0.5); 
	$outsum += $i * $this->{ IRSAMPLEPERIOD } * 1e6;

	# break into smaller segments if necessary
	while ($i > 0) {
	    my $binnum = $i < 127 ? $i : 127;
	    $i -= $binnum;
	    push @bin, ( $binnum + $sign );
	}
    }
	
    return @bin;
}

=head2 $slinke->requestInput();

This function returns any input from the S-Link ports, the IR ports or the Parallel port

The returned element is a hash reference.  

C<PORT> is always set, and it will contain the port that returned the data

C<DATA> is a reference to an array of values.

C<TIME> is set for data coming from the IR port and this lists the total amount
of time that was needed to produce the IR signal

C<IRPORT> is set for data coming from the IR port.  It tells which IR receiver (1-8) the