This is an implementation of an interface to the T95 temperature controller. The communication functions and the assignments that create the beamline-specific code widget are part of /online_dir/TkIrc.pl.
It is also demonstrated how the T95 functionality is made available from the Online command line, see below.
#
#
#
package T95;
use strict;
use IO::Socket::INET;
use IO::Select;
use Spectra;
# bw5 hastXX.desy.de 4504
# test hasptXX 10032
our $node = "hasptsXX.desy.de";
our $port = 10032;
sub openT95
{
my $status = 1;
$Util::res_h{ sockT95} = IO::Socket::INET->new(PeerAddr => $node,
PeerPort => $port,
Proto => 'tcp',
Type => SOCK_STREAM);
if( !$Util::res_h{ sockT95})
{
$status = Spectra::error( "openT95: failed to connect to $node port $port");
goto finish;
}
finish:
return $status;
}
sub sendT95
{
my ( $argin) = @_;
my $status = 1;
if( !defined( $Util::res_h{ sockT95}))
{
if( !openT95())
{
$status = Spectra::error( "sendT95: openT95 returned error");
goto finish;
}
}
$argin =~ s/^\s*(.*?)\s*$/$1/;
# print "sendT95: $argin \n";
$argin .= "\015";
$status = $Util::res_h{ sockT95}->send( $argin);
finish:
return $status;
}
sub recvT95
{
my $argout;
my $status = 1;
if( !defined( $Util::res_h{ sockT95}))
{
if( !openT95())
{
$status = Spectra::error( "recvT95: openT95 returned error");
goto finish;
}
}
my $s = new IO::Select();
$s->add( $Util::resh_h{ sockT95});
$argout = "";
my $buffer; ~/Spectra/src/
while( !length( $argout) || $s->can_read(0.1))
{
$Util::res_h{ sockT95}->recv( $buffer, 100);
$argout .= $buffer;
$buffer = "";
}
my $temp = $argout;
$temp =~ s/^\s*(.*?)\s*$/$1/;
# print "recvT95: $temp \n";
return $argout;
}
sub closeT95
{
close($Util::res_h{ sockT95});
delete $Util::res_h{ sockT95};
}
sub getT95status
{
sendT95( "T");
my $res = recvT95();
my @list = unpack( "C*", $res);
return $list[0];
}
sub getT95error
{
sendT95( "T");
my $res = recvT95();
my @list = unpack( "C*", $res);
return $list[1];
}
sub getT95pumpStatus
{
sendT95( "T");
my $res = recvT95();
my @list = unpack( "C*", $res);
return $list[2];
}
sub getT95genStatus
{
sendT95( "T");
my $res = recvT95();
my @list = unpack( "C*", $res);
return $list[3];
}
#
# map [0xf858, 0x3a98] to [-196, 1500]
#
#
sub getT95temperature
{
sendT95( "T");
my $res = recvT95();
my $temp = "0x" . substr( $res, 6, 4);
$temp = hex($temp);
if( $temp & 0x8000)
{
$temp -= 65536;
}
return $temp*0.1;
}
#
# the commands
#
sub cmdT95
{
my ($keyword, $value) = @_;
my $status;
#
# rate: R1
#
if( $keyword =~ /rate/i && length( $value))
{
$value = int( 100*$value + 0.5);
sendT95( "R1${value}");
}
#
# limit: L1
#
elsif( $keyword =~ /limit/i && length( $value))
{
$value = int( 10*$value + 0.5);
sendT95( "L1${value}");
}
#
# start: S
#
elsif( $keyword =~ /start/i)
{
sendT95( "S");
}
#
# stop: E
#
elsif( $keyword =~ /stop/i)
{
sendT95( "E");
}
#
# hold: O
#
elsif( $keyword =~ /hold/i)
{
sendT95( "O");
}
#
# heat: H
#
elsif( $keyword =~ /heat/i)
{
sendT95( "H");
}
#
# cool: C
#
elsif( $keyword =~ /cool/i)
{
sendT95( "C");
}
#
# automatic mode: Pa
#
elsif( $keyword =~ /auto/i)
{
sendT95( "Pa");
}
#
# manual mode: Pm
#
elsif( $keyword =~ /manual/i)
{
sendT95( "Pm");
}
#
# speed: P0 - PN
#
elsif( $keyword =~ /speed/i)
{
if( $value < 0 || $value > 30)
{
print " speed: value out of range $value \n";
$status = 0;
goto finish;
}
my $let = pack( "C", $value + 48);
sendT95( "P${let}");
}
finish:
return $status;
}
$Spc::res_h{ t95_title } = { text => "T95 Temperature Controller"};
$Spc::res_h{ t95_help} = sub
{
Util::display_text( "Help T95",
'
Speed: 0 - 30
'
)};
$Spc::res_h{ t95_io1 } = { label => { name => "Temperature",
get => sub { T95::getT95temperature();}}};
$Spc::res_h{ t95_io2 } = { label => { name => "Status",
get => sub { T95::getT95status();}}};
$Spc::res_h{ t95_io3 } = { label => { name => "Error",
get => sub { T95::getT95error();}}};
$Spc::res_h{ t95_io4 } = { label => { name => "Gen. Status",
get => sub { T95::getT95genStatus();}}};
$Spc::res_h{ t95_io5 } = { label => { name => "Rate",},
entry => { set => sub {T95::cmdT95( "rate", $_[0]);}}};
$Spc::res_h{ t95_io6 } = { label => { name => "Limit",},
entry => { set => sub {T95::cmdT95( "limit", $_[0]);}}};
$Spc::res_h{ t95_io7 } = { label => { name => "Speed",
get => sub { T95::getT95pumpStatus() - 128;}},
entry => { set => sub { T95::cmdT95( "speed", $_[0]);}}};
$Spc::res_h{ t95_b1} = { name => "Start",
command => sub { T95::cmdT95( "start")}};
$Spc::res_h{ t95_b2} = { name => "Stop",
command => sub { T95::cmdT95( "stop")}};
$Spc::res_h{ t95_b3} = { name => "Hold",
command => sub { T95::cmdT95( "hold")}};
$Spc::res_h{ t95_b4} = { name => "Heat",
command => sub { T95::cmdT95( "heat")}};
$Spc::res_h{ t95_b5} = { name => "Cool",
command => sub { T95::cmdT95( "cool")}};
$Spc::res_h{ t95_b6} = { name => "Auto",
command => sub { T95::cmdT95( "auto")}};
$Spc::res_h{ t95_b7} = { name => "Manual",
command => sub { T95::cmdT95( "manual")}};
The temperature controller can also be operated from the Online command line. The syntax is, e.g., "t95 start". The string t95 is a symbol which is defined in /online_dir/exp_ini.exp. It points to a Perl script:
#!/bin/env perl
#
# file: ~/prog/t95.pl
#
# needs this symbol assignment in exp_ini.exp
#
# t95 = "perl <~.prog>t95.pl"
#
use Spectra;
my ( $keyword, $value) = @ARGV;
my $status = 1;
sub print_usage
{
print "\n\n Usage: \n";
print " t95 cool \n";
print " t95 heat \n";
print " t95 start \n";
print " t95 stop \n";
print " t95 limit 60 \n";
print " t95 rate [1,120] [C/min] \n";
print " t95 speed [0,30] \n";
print "\n\n\n";
}
if( !defined( $keyword))
{
$status = 0;
print_usage();
goto finish;
}
if( $keyword =~ /gettemperature/i)
{
$Spectra::SYM{ t95_temperature} = T95::getT95temperature();
goto finish;
}
if( $keyword =~ /cool/i)
{
T95::cmdT95( "cool");
goto finish;
}
if( $keyword =~ /heat/i)
{
T95::cmdT95( "heat");
goto finish;
}
if( $keyword =~ /start/i)
{
T95::cmdT95( "start");
goto finish;
}
if( $keyword =~ /stop/i)
{
T95::cmdT95( "stop");
goto finish;
}
if( $keyword =~ /limit/i)
{
if( !defined( $value))
{
$status = 0;
print_usage();
goto finish;
}
T95::cmdT95( "limit", $value);
goto finish;
}
if( $keyword =~ /rate/i)
{
if( !defined( $value))
{
$status = 0;
print_usage();
goto finish;
}
if( $value < 0 || $value > 120)
{
$status = 0;
print_usage();
goto finish;
}
T95::cmdT95( "rate", $value);
goto finish;
}
if( $keyword =~ /speed/i)
{
if( !defined( $value))
{
$status = 0;
print_usage();
goto finish;
}
if( $value < 0 || $value > 30)
{
$status = 0;
print_usage();
goto finish;
}
T95::cmdT95( "speed", $value);
goto finish;
}
print "\n\n T95.pl: failed to identify $keyword $value \n\n\n";
finish:
$status;