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;