Galil as virtual motor (haspp10e1)

The following script operates the right jaw, file name /online_dir/vm1.pl.

#!/usr/bin/perl -w
use Spectra;
my ($method, $value_new) = @ARGV; 
my $status = 1; 

#
# (x, y, z, w) <-> (r, l, t, b)
#
my $axis = 'r'; 

if( "$method" eq "set_position")
{
    Spectra::set_dmc( $axis, $value_new); 
}
elsif( "$method" eq "get_position")
{
    $SYM{RETURN_VALUE} = Spectra::get_dmc( $axis);
}
elsif( "$method" eq "get_limit_min")
{
    $SYM{RETURN_VALUE} = -220;
}
elsif( "$method" eq "get_limit_max")
{
    $SYM{RETURN_VALUE} = 220;
}
$status;

vm1.pl uses functions that are defined in /online_dir/TkIrc.pl:

package Spectra; 
#
# open socket for dmc controller
#
my $flag_dmc_open = 0; 
my $conv = 10000;

$Spectra::test_var = 1; 

sub open_dmc
{
    my ($iaddr, $paddr, $proto, $line); 

    my $remote = '192.168.57.3'; 
    my $port = 10000;

    $port = getservbyname( $port, 'tcp') if( $port =~ /\D/); 
    die " no port " unless $port; 
    
    $iaddr = Socket::inet_aton( $remote) or die "no host $remote"; 
    $paddr = Socket::sockaddr_in( $port, $iaddr); 
    $proto = getprotobyname( 'tcp'); 
    socket( SOCKET_DMC, Socket::PF_INET, Socket::SOCK_STREAM, $proto) or 
      die "socket: $!"; 
    
    connect( SOCKET_DMC, $paddr) or die "connect: $!";
     
    my $flags = fcntl (SOCKET_DMC, Fcntl::F_GETFL(), 0);
    $flags  &= ~Fcntl::O_NONBLOCK(); 
    fcntl ( SOCKET_DMC, Fcntl::F_SETFL(), $flags);

    $flag_dmc_open = 1; 
}
#
# 
#
sub recv_dmc
{
    my $status = undef; 

    if( !$flag_dmc_open)
    {
	open_dmc(); 
	if( !$flag_dmc_open)
	{
#	    Util::log( "Failed to open socket for Dmc controller"); 
	    Spectra::error( "Failed to open socket for Dmc controller"); 
	    goto finish;
	}
    }

    my $rin = my $win = my $ein = ""; 
    vec( $rin, fileno( SOCKET_DMC), 1) = 1; 
    $ein = $rin | $win;
    #
    # do we have input, time-out: 0.1s
    #
    my $nfd = select( $rin, $win, $ein, 0.1); 
    my $buffer = ""; 
    if( $nfd)
    {
	sysread( SOCKET_DMC, $buffer, 100, 0);
	$status = $buffer; 
    }
 finish:
#    Util::display_text( "DMC" , "received $buffer"); 
    return $status; 
}
#
#
#
sub send_dmc
{
    my ($buffer) = @_; 
#    Util::display_text( "DMC", "sending $buffer"); 
    syswrite( SOCKET_DMC, $buffer, length($buffer), 0);     
}
#
#
#
sub get_dmc
{
    my ($axis) = @_; 
    my $status = undef;

    if( !$flag_dmc_open)
    {
	open_dmc(); 
	if( !$flag_dmc_open)
	{
#	    Util::log( "Failed to open socket for Dmc controller"); 
	    Spectra::error( "Failed to open socket for Dmc controller"); 
	    goto finish;
	}
    }
    #
    # x, y, z, w
    #
    if( $axis =~ /^x$/i)
    {
	send_dmc( "TP X\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status/$conv;
    }
    elsif( $axis =~ /^y$/i)
    {
	send_dmc( "TP Y\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status/$conv;
    }
    elsif( $axis =~ /^z$/i)
    {
	send_dmc( "TP Z\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status/$conv;
    }
    elsif( $axis =~ /^w$/i)
    {
	send_dmc( "TP W\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status/$conv;
    }
    #
    # r, l, t, b
    #
    elsif( $axis =~ /^t$/i)
    {
	send_dmc( "TP X\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status/$conv;
    }
    elsif( $axis =~ /^b$/i)
    {
	send_dmc( "TP Y\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status; 
	$status = $status/$conv;
    }
    elsif( $axis =~ /^l$/i)
    {
	send_dmc( "TP Z\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status; 
	$status = $status/$conv;
    }
    elsif( $axis =~ /^r$/i)
    {
	send_dmc( "TP W\015");
	$status = recv_dmc(); 
	$status =~ s/^\s*(\S*)\s+:$/$1/; 
	$status = $status/$conv;
    }
    #
    # cx, cy, dx, dy
    #
    elsif( $axis =~ /^cx$/i)
    {
	my $r = get_dmc( "r"); 
	my $l = get_dmc( "l"); 
	$status = ($r + $l )/2.;
    }
    elsif( $axis =~ /^cy$/i)
    {
	my $t = get_dmc( "t"); 
	my $b = get_dmc( "b"); 
	$status = ($t + $b )/2.;
    }
    elsif( $axis =~ /^dx$/i)
    {
	my $r = get_dmc( "r"); 
	my $l = get_dmc( "l"); 
	$status = ($l - $r);
    }
    elsif( $axis =~ /^dy$/i)
    {
	my $t = get_dmc( "t"); 
	my $b = get_dmc( "b"); 
	$status = ($t - $b);
    }
 finish:
    return $status;
}	

sub set_dmc
{
    my ($axis, $value_new) = @_; 
    my $status = 1;
    my $buffer = "";

    my $value_raw = $value_new*$conv;

    if( !$flag_dmc_open)
    {
	open_dmc(); 
	if( !$flag_dmc_open)
	{
	    $status = 1;
#	    Util::log( "Failed to open socket for Dmc controller"); 
	    Spectra::error( "Failed to open socket for Dmc controller"); 
	    goto finish;
	}
    }
    $Spectra::SYM{ interrupt_scan} = 0;
    #
    # x, y, z, w
    #
    if( $axis =~ /^x$/i)
    {
	$buffer = "PA ${value_raw},_PAY,_PAZ,_PAW;BG\015";
    }
    elsif( $axis =~ /^y$/i)
    {
	$buffer = "PA _PAX,${value_raw},_PAZ,_PAW;BG\015";
    }
    elsif( $axis =~ /^z$/i)
    {
	$buffer = "PA _PAX,_PAY,${value_raw},_PAW;BG\015";
    }
    elsif( $axis =~ /^w$/i)
    {
	$buffer = "PA _PAX,_PAY,_PAZ,${value_raw};BG\015";
    }
    #
    # r, l, t, b
    #
    elsif( $axis =~ /^t$/i)
    {
	$buffer = "PA ${value_raw},_PAY,_PAZ,_PAW;BG\015";
    }
    elsif( $axis =~ /^b$/i)
    {
	$buffer = "PA _PAX,${value_raw},_PAZ,_PAW;BG\015";
    }
    elsif( $axis =~ /^l$/i)
    {
	$buffer = "PA _PAX,_PAY,${value_raw},_PAW;BG\015";
    }
    elsif( $axis =~ /^r$/i)
    {
	$buffer = "PA _PAX,_PAY,_PAZ,${value_raw};BG\015";
    }
    #
    # cx, cy, dx, dy
    #
    elsif( $axis =~ /^cx$/i)
    {
	my $cx_old = get_dmc( "cx");
	my $diff = $value_new - $cx_old; 
	set_dmc( "r", get_dmc( "r") + $diff);
	set_dmc( "l", get_dmc( "l") + $diff);
	goto finish;
    }
    elsif( $axis =~ /^cy$/i)
    {
	my $cy_old = get_dmc( "cy");
	my $diff = $value_new - $cy_old; 
	set_dmc( "t", get_dmc( "t") + $diff);
	set_dmc( "b", get_dmc( "b") + $diff);
	goto finish;
    }
    elsif( $axis =~ /^dx$/i)
    {
	my $dx_old = get_dmc( "dx");
	my $diff = $value_new - $dx_old; 
	set_dmc( "r", get_dmc( "r") - $diff/2.);
	set_dmc( "l", get_dmc( "l") + $diff/2.);
	goto finish;
    }
    elsif( $axis =~ /^dy$/i)
    {
	my $dy_old = get_dmc( "dy");
	my $diff = $value_new - $dy_old; 
	set_dmc( "t", get_dmc( "t") + $diff/2.);
	set_dmc( "b", get_dmc( "b") - $diff/2.);
	goto finish;
    }
    send_dmc( $buffer); 
    
    while( length( $buffer))
    {
	$buffer = recv_dmc(); 
    }
    my $time = 0; 
    $buffer = get_dmc( $axis); 
    while( abs( $buffer - $value_new) > 0.01)
    {
	if( defined( $Spc::h{ w_top}))
	{
	    Util::refresh_motor_positions();
	}
	Spectra::wait( 0.5); 
	$time += 0.5;
	last if( $time > 40);
	#
	# did the user press 'stop'? 
	#
	if( $Spectra::SYM{ interrupt_scan})
	{
	    Util::log( "TkIrc.pl::set_dmc: interrupted, stopping moves"); 
	    send_dmc( "ST\015"); 
	    while( length( $buffer))
	    {
		$buffer = recv_dmc(); 
	    }
	    last;
	}
	$buffer = get_dmc( $axis); 
    }
 finish:
    return $status;
}