Restored accidentally removed file.
r1244 | ffr | 2006-11-07 12:57:45 +1100 (Tue, 07 Nov 2006) | 2 lines
This commit is contained in:
Ferdi Franceschini
committed by
Douglas Clowes
Douglas Clowes
parent
3d0bae3859
commit
65d0b79508
105
site_ansto/instrument/deploySICS.sh
Executable file
105
site_ansto/instrument/deploySICS.sh
Executable file
@@ -0,0 +1,105 @@
|
|||||||
|
#!/bin/sh
|
||||||
|
# $Revision: 1.8 $
|
||||||
|
# $Date: 2006-11-07 01:45:20 $
|
||||||
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||||
|
# Last revision by $Author: ffr $
|
||||||
|
|
||||||
|
# Deploys SICServer and configuration files to
|
||||||
|
# an instrument control computer.
|
||||||
|
# It requires a MANIFEST.TXT file for each instrument
|
||||||
|
|
||||||
|
usage()
|
||||||
|
{
|
||||||
|
echo deploySICS.sh copies SICS and the files listed
|
||||||
|
echo in the MANIFEST.TXT files to the IC host.
|
||||||
|
echo -e "Usage:\t./deploySICS.sh INSTRUMENT [TARGET_HOST TARGET_DIR]";
|
||||||
|
echo -e "\t./deploySICS.sh test/INSTRUMENT [TARGET_HOST TARGET_DIR]";
|
||||||
|
echo -e "\twhere INSTRUMENT can be hrpd, echidna, hipd, wombat ...";
|
||||||
|
echo -e "\tTARGET_HOST can be a remote host or 'localhost'";
|
||||||
|
echo -e "\twill create last directory in TARGET_DIR if necessary";
|
||||||
|
}
|
||||||
|
|
||||||
|
if [ $# -eq 0 -o $# -eq 2 -o $# -gt 3 ]
|
||||||
|
then
|
||||||
|
usage
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
|
||||||
|
INSTRUMENT=$1
|
||||||
|
|
||||||
|
SRCDIR=./
|
||||||
|
DESTDIR=${3:-/usr/local/}
|
||||||
|
mkdir -p ~/tmp/$DESTDIR
|
||||||
|
rm -fr ~/tmp/$DESTDIR/*
|
||||||
|
|
||||||
|
# Set the destination host and the
|
||||||
|
# instrument src directory
|
||||||
|
case $INSTRUMENT in
|
||||||
|
hrpd|echidna)
|
||||||
|
DESTHOST=${2:-ics1-echidna.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=hrpd;;
|
||||||
|
hipd|wombat)
|
||||||
|
DESTHOST=${2:-ics1-wombat.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=hipd;;
|
||||||
|
qld|koala)
|
||||||
|
DESTHOST=${2:-ics1-koala.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=qld;;
|
||||||
|
reflectometer|platypus)
|
||||||
|
DESTHOST=${2:-ics1-platypus.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=reflectometer;;
|
||||||
|
rsd|kowari)
|
||||||
|
DESTHOST=${2:-ics1-kowari.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=qld;;
|
||||||
|
sans|quokka)
|
||||||
|
DESTHOST=${2:-ics1-quokka.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=sans;;
|
||||||
|
tas|taipan)
|
||||||
|
DESTHOST=${2:-ics1-taipan.nbi.ansto.gov.au}
|
||||||
|
INSTSRC=tas;;
|
||||||
|
test/*)
|
||||||
|
#copy TEST_SICS/fakeDMC
|
||||||
|
#TESTSRC=TEST_SICS
|
||||||
|
cp -a TEST_SICS/* ~/tmp/$DESTDIR
|
||||||
|
rm -fr $(find ~/tmp/$DESTDIR -name CVS)
|
||||||
|
DESTHOST=$2
|
||||||
|
INSTSRC=$(basename $INSTRUMENT);;
|
||||||
|
esac
|
||||||
|
|
||||||
|
echo $DESTHOST
|
||||||
|
if [ $DESTHOST = "localhost" ]
|
||||||
|
then
|
||||||
|
EXTRACT="tar vxz -C /"
|
||||||
|
else
|
||||||
|
EXTRACT="ssh $DESTHOST tar vxz -C /"
|
||||||
|
fi
|
||||||
|
|
||||||
|
if [ ! -e $SRCDIR/MANIFEST.TXT ]
|
||||||
|
then
|
||||||
|
echo "$SRCDIR/MANIFEST.TXT not found"
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
if [ ! -e $INSTSRC/MANIFEST.TXT ]
|
||||||
|
then
|
||||||
|
echo "$INSTSRC/MANIFEST.TXT not found"
|
||||||
|
echo "You must list the files required for $INSTRUMENT in the manifest"
|
||||||
|
exit 1
|
||||||
|
fi
|
||||||
|
|
||||||
|
# Get list of files to copy
|
||||||
|
COMMON=$(for f in $(cat $SRCDIR/MANIFEST.TXT); do echo -n "$SRCDIR/$f "; done)
|
||||||
|
INSTSPEC=$(for f in $(cat $INSTSRC/MANIFEST.TXT); do echo -n "$INSTSRC/$f "; done)
|
||||||
|
|
||||||
|
mkdir -p ~/tmp/$DESTDIR/sics/{server,data,log,tmp}
|
||||||
|
cp $COMMON $INSTSPEC ~/tmp/$DESTDIR/sics/server
|
||||||
|
cp ../SICServer ~/tmp/$DESTDIR/sics/server
|
||||||
|
|
||||||
|
# Create a manifest of the files installed on the IC host
|
||||||
|
echo "Date: $(date -Iminutes)" > ~/tmp/$DESTDIR/sics/server/MANIFEST.TXT
|
||||||
|
echo -e "The following files were installed by $USER\n" >> ~/tmp/$DESTDIR/sics/server/MANIFEST.TXT
|
||||||
|
cat $SRCDIR/MANIFEST.TXT $INSTSRC/MANIFEST.TXT >> ~/tmp/$DESTDIR/sics/server/MANIFEST.TXT
|
||||||
|
|
||||||
|
cd ~/tmp/
|
||||||
|
|
||||||
|
# Strip leading / from DESTDIR and extract to destination
|
||||||
|
tar -cz ${DESTDIR:1} | $EXTRACT
|
||||||
71
site_ansto/instrument/dmc2280_util.tcl
Normal file
71
site_ansto/instrument/dmc2280_util.tcl
Normal file
@@ -0,0 +1,71 @@
|
|||||||
|
# $Revision: 1.6 $
|
||||||
|
# $Date: 2006-11-07 01:48:22 $
|
||||||
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||||
|
# Last revision by $Author: ffr $
|
||||||
|
|
||||||
|
# globals controller, channel
|
||||||
|
|
||||||
|
# Open a communications channel to a dmc2280 motor controller
|
||||||
|
# contName: controller name, eg dmc2280_controller1
|
||||||
|
# The host and port in the SICS configuration file will be used by default
|
||||||
|
proc dmc_connect {contName {host ""} {port ""}} {
|
||||||
|
upvar #0 $contName controller;
|
||||||
|
global channel;
|
||||||
|
|
||||||
|
if {$host == ""} {set host $controller(host)}
|
||||||
|
if {$port == ""} {set port $controller(port)}
|
||||||
|
|
||||||
|
if [catch {socket $host $port} con] {
|
||||||
|
error "Failed to connect to $contName IP($host) port($port)\n\
|
||||||
|
$con\n
|
||||||
|
Is the motor controller switched on? Are the network cables plugged in?\n
|
||||||
|
NOTE: You can only have a maximum of eight connections per motor controller.\n
|
||||||
|
If there are other programs (eg SICS) connected to the controller then all\n
|
||||||
|
of the available connections may have been used up."
|
||||||
|
}
|
||||||
|
set controller(socket) $con
|
||||||
|
set channel($contName) $con
|
||||||
|
set channel($con) $contName
|
||||||
|
set channel($controller(host)) $con
|
||||||
|
fconfigure $con -buffering line -translation crlf -blocking true
|
||||||
|
}
|
||||||
|
|
||||||
|
proc dmc_close {dmc_socket} {
|
||||||
|
close $dmc_socket;
|
||||||
|
}
|
||||||
|
|
||||||
|
# Send a dmc2280 command
|
||||||
|
proc dmc_sendCmd {dmc_socket cmd} {
|
||||||
|
global channel
|
||||||
|
set contName $channel($dmc_socket);
|
||||||
|
upvar #0 $contName controller
|
||||||
|
puts $dmc_socket $cmd
|
||||||
|
set status [read $dmc_socket 1]
|
||||||
|
if {$status == "?"} {
|
||||||
|
puts $dmc_socket "TC 1"
|
||||||
|
set status [read $dmc_socket 1]
|
||||||
|
if {$status == "?"} {
|
||||||
|
error "error: dmc command $cmd failed"
|
||||||
|
} else {
|
||||||
|
set dmcError [dmc_receive $dmc_socket]
|
||||||
|
set errInfo "DM2280 controller $contName
|
||||||
|
host $controller(host)
|
||||||
|
port $controller(port)"
|
||||||
|
error "DMC2280 ERROR $dmcError: when running command $cmd\n$errInfo"
|
||||||
|
}
|
||||||
|
} else {
|
||||||
|
return $status
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Receive a dmc2280 command
|
||||||
|
proc dmc_receive {dmc_socket} {
|
||||||
|
global channel
|
||||||
|
set contName $channel($dmc_socket);
|
||||||
|
upvar #0 $contName controller
|
||||||
|
gets $dmc_socket line
|
||||||
|
# Consume the following colon
|
||||||
|
read $dmc_socket 1
|
||||||
|
return $line
|
||||||
|
}
|
||||||
|
|
||||||
83
site_ansto/instrument/genCLOSLOOP.tcl
Normal file
83
site_ansto/instrument/genCLOSLOOP.tcl
Normal file
@@ -0,0 +1,83 @@
|
|||||||
|
#TODO Version stamp this code and write the version number to the generated code
|
||||||
|
# axis = A B C D E F
|
||||||
|
# encodercounts = number of encoder counts per revolution
|
||||||
|
# quadcounts = number of quadrature counts per revolution
|
||||||
|
# tolquadcounts = tolerance in quadrature counts
|
||||||
|
proc genMOVE {axis encodercounts quadcounts tolquadcounts} {
|
||||||
|
puts "NO CLOSE MOTION LOOP FOR ${axis} AXIS
|
||||||
|
NO If the motor is within ${axis}TOLQC quadrature counts of the target
|
||||||
|
NO position then adjust it.
|
||||||
|
${axis}DIFF=${axis}QTARGET - _TP${axis}
|
||||||
|
IF ( ((100*${axis}TOLQC) > @ABS\[${axis}DIFF\]) & (@ABS\[${axis}DIFF\] > ${axis}TOLQC) )
|
||||||
|
${axis}SHLDFIX=1
|
||||||
|
ELSE
|
||||||
|
${axis}SHLDFIX=0
|
||||||
|
ENDIF
|
||||||
|
IF (${axis}FIXPOS=1)
|
||||||
|
${axis}OLDQT=${axis}QTARGET
|
||||||
|
${axis}count=10
|
||||||
|
SH${axis}
|
||||||
|
#${axis}LOOP
|
||||||
|
NO Abort if target position changes
|
||||||
|
IF (${axis}OLDQT <> ${axis}QTARGET)
|
||||||
|
JP#${axis}ENDCLP
|
||||||
|
ENDIF
|
||||||
|
${axis}count=${axis}count-1
|
||||||
|
PR${axis}=${encodercounts}*(${axis}DIFF/${quadcounts})
|
||||||
|
IF (_SP${axis}>${axis}MINSP)
|
||||||
|
SP${axis}=@ABS\[_PR${axis}\]/2.0
|
||||||
|
IF (_SP${axis} < ${axis}MINSP)
|
||||||
|
SP${axis}=${axis}MINSP
|
||||||
|
ENDIF
|
||||||
|
IF (_SP${axis} > ${axis}MAXSP)
|
||||||
|
SP${axis}=${axis}MAXSP
|
||||||
|
ENDIF
|
||||||
|
ENDIF
|
||||||
|
BG${axis}
|
||||||
|
MC${axis}
|
||||||
|
${axis}DIFF=${axis}QTARGET - _TP${axis}
|
||||||
|
IF ( ((100*${axis}TOLQC) > @ABS\[${axis}DIFF\]) & (@ABS\[${axis}DIFF\] > ${axis}TOLQC) )
|
||||||
|
JP#${axis}LOOP,${axis}count>0
|
||||||
|
ENDIF
|
||||||
|
#${axis}ENDCLP
|
||||||
|
NO Restore speed to maximum
|
||||||
|
${axis}FIXPOS=0
|
||||||
|
${axis}SHLDFIX=0
|
||||||
|
SP${axis}=${axis}MAXSP
|
||||||
|
ENDIF"
|
||||||
|
}
|
||||||
|
|
||||||
|
|
||||||
|
# Generate subroutine to start the servo loop thread
|
||||||
|
puts "#CLSLOOP"
|
||||||
|
set tolquadcounts 1
|
||||||
|
set encodercounts 25000
|
||||||
|
set quadcounts 8192
|
||||||
|
puts "NO Initilise tolerance, max and min speeds
|
||||||
|
ATOLQC=100
|
||||||
|
AMAXSP=${encodercounts}
|
||||||
|
AMINSP=100*(${encodercounts}/93207)
|
||||||
|
AFIXPOS=0"
|
||||||
|
foreach {axis} {B C D E F} {
|
||||||
|
puts "${axis}TOLQC=${tolquadcounts}
|
||||||
|
${axis}MAXSP=${encodercounts}
|
||||||
|
${axis}MINSP=100*(${encodercounts}/$quadcounts)
|
||||||
|
${axis}FIXPOS=0"
|
||||||
|
}
|
||||||
|
foreach {axis} {A B C D E F} {
|
||||||
|
puts "${axis}DIFF=${axis}QTARGET - _TP${axis}
|
||||||
|
IF ( ((100*${axis}TOLQC) > @ABS\[${axis}DIFF\]) & (@ABS\[${axis}DIFF\] > ${axis}TOLQC) )
|
||||||
|
${axis}SHLDFIX=1
|
||||||
|
ELSE
|
||||||
|
${axis}SHLDFIX=0
|
||||||
|
ENDIF"
|
||||||
|
}
|
||||||
|
puts "XQ#SERVOLP,1
|
||||||
|
EN"
|
||||||
|
# Generate servo loop
|
||||||
|
puts "#SERVOLP"
|
||||||
|
genMOVE A $encodercounts -93165 $tolquadcounts
|
||||||
|
foreach {axis} {B C D E F} {
|
||||||
|
genMOVE $axis $encodercounts $quadcounts $tolquadcounts
|
||||||
|
}
|
||||||
|
puts "JP#SERVOLP"
|
||||||
30
site_ansto/instrument/gen_home_slits.tcl
Normal file
30
site_ansto/instrument/gen_home_slits.tcl
Normal file
@@ -0,0 +1,30 @@
|
|||||||
|
proc move_away_from_switch {axis} {
|
||||||
|
puts "NOTE Move slit forward 10mm if it is against the reverse limit switch
|
||||||
|
IF ((_TS${axis} & 4) = 0)
|
||||||
|
SH${axis}
|
||||||
|
PR${axis}=200000
|
||||||
|
BG${axis}
|
||||||
|
ENDIF"
|
||||||
|
}
|
||||||
|
|
||||||
|
puts "#HOME"
|
||||||
|
foreach {axis} {E F G H} {
|
||||||
|
move_away_from_switch $axis
|
||||||
|
}
|
||||||
|
puts "AM"
|
||||||
|
puts "NOTE Drive all slits into reverse limit switch"
|
||||||
|
puts "SH
|
||||||
|
JG ,,,,-25000,-25000,-25000,-25000
|
||||||
|
BGEFGH
|
||||||
|
AM"
|
||||||
|
puts "NOTE Move away from switches by 2mm and drive back slowly"
|
||||||
|
puts "PR ,,,,40000,40000,40000,40000
|
||||||
|
JG ,,,,-5000,-5000,-5000,-5000
|
||||||
|
BGEFGH
|
||||||
|
AM"
|
||||||
|
puts "NOTE Move forward from switch by 2mm and set zero"
|
||||||
|
puts "PR ,,,,40000,40000,40000,40000
|
||||||
|
BGEFGH
|
||||||
|
AM
|
||||||
|
DP ,,,,0,0,0,0"
|
||||||
|
puts "EN"
|
||||||
82
site_ansto/instrument/motorinfo.tcl
Normal file
82
site_ansto/instrument/motorinfo.tcl
Normal file
@@ -0,0 +1,82 @@
|
|||||||
|
package require Tk
|
||||||
|
|
||||||
|
proc unknown {args} {}
|
||||||
|
|
||||||
|
# Check that the current position matches the configured home position
|
||||||
|
proc checkHome {motor} {
|
||||||
|
global channel
|
||||||
|
upvar #0 $motor motName
|
||||||
|
upvar #0 ${motor}_status motStatus
|
||||||
|
set chan $channel($motName(host))
|
||||||
|
if {[info exists motName(absenc)] && $motName(absenc) == 1} {
|
||||||
|
dmc_sendCmd $chan "TP$motName(axis)"
|
||||||
|
set homeIndex absenchome
|
||||||
|
} else {
|
||||||
|
dmc_sendCmd $chan "TD$motName(axis)"
|
||||||
|
set homeIndex motorhome
|
||||||
|
}
|
||||||
|
set home [dmc_receive $chan]
|
||||||
|
set motStatus(position) $home
|
||||||
|
set motStatus(home) $motName($homeIndex)
|
||||||
|
if {$home == $motName($homeIndex)} {
|
||||||
|
set motStatus(homeTest) TEST_PASSED
|
||||||
|
} else {
|
||||||
|
set motStatus(homeTest) TEST_FAILED
|
||||||
|
}
|
||||||
|
return $motStatus(homeTest)
|
||||||
|
}
|
||||||
|
|
||||||
|
# This implementation of the "Motor" command stores the
|
||||||
|
# configured motor parameters in an array named
|
||||||
|
# after the motor.
|
||||||
|
proc Motor {name type par} {
|
||||||
|
global motors
|
||||||
|
upvar #0 $par arr
|
||||||
|
upvar #0 $name param_arr
|
||||||
|
upvar #0 ${name}_status status
|
||||||
|
array set param_arr [array get arr]
|
||||||
|
array set status [list position "" home "" upperLim "" lowerLim "" homeTest NOTDONE limitTest NOTDONE]
|
||||||
|
lappend motors $name
|
||||||
|
}
|
||||||
|
|
||||||
|
# Returns the test result status colour for the gui
|
||||||
|
proc color {status} {
|
||||||
|
switch $status {
|
||||||
|
TEST_PASSED {return green}
|
||||||
|
TEST_FAILED {return red}
|
||||||
|
default {return lightgrey}
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
|
# You can easily test the home position of individual motors
|
||||||
|
# with this gui
|
||||||
|
# Click on the button to run the checkHome command, the position
|
||||||
|
# (in encoder counts or motor steps) will be displayed with
|
||||||
|
# green if the configured home matches the reported position,
|
||||||
|
# red otherwise.
|
||||||
|
proc testgui {} {
|
||||||
|
package require Tk
|
||||||
|
global motors
|
||||||
|
toplevel .w
|
||||||
|
frame .w.top
|
||||||
|
|
||||||
|
foreach m $motors {
|
||||||
|
global ${m}_status
|
||||||
|
set info($m) [frame .w.top.f$m]
|
||||||
|
|
||||||
|
set testResult $info($m).e$m
|
||||||
|
button $info($m).$m -text $m -command "$testResult configure -background \[color \[checkHome $m\]\]"
|
||||||
|
entry $testResult -textvariable ${m}_status(position)
|
||||||
|
pack $info($m).$m -side left
|
||||||
|
pack $info($m).e$m -side left
|
||||||
|
}
|
||||||
|
|
||||||
|
set n 0
|
||||||
|
foreach m $motors {
|
||||||
|
set r [expr $n % 20]
|
||||||
|
set c [expr $n / 20]
|
||||||
|
grid $info($m) -row $r -column $c
|
||||||
|
incr n
|
||||||
|
}
|
||||||
|
pack .w.top
|
||||||
|
}
|
||||||
49
site_ansto/instrument/server_config.tcl
Normal file
49
site_ansto/instrument/server_config.tcl
Normal file
@@ -0,0 +1,49 @@
|
|||||||
|
# SICS common configuration
|
||||||
|
|
||||||
|
# $Revision: 1.9 $
|
||||||
|
# $Date: 2006-11-07 01:55:15 $
|
||||||
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||||
|
# Last revision by $Author: ffr $
|
||||||
|
|
||||||
|
#set sicsroot /usr/local/sics
|
||||||
|
set sicsroot ../
|
||||||
|
ServerOption LogFileBaseName $sicsroot/log/serverlog
|
||||||
|
|
||||||
|
installprotocolhandler
|
||||||
|
|
||||||
|
source utility.tcl
|
||||||
|
|
||||||
|
ServerOption statusfile $sicsroot/log/status.tcl
|
||||||
|
ServerOption RedirectFile $sicsroot/log/stdout
|
||||||
|
ServerOption LogFileDir $sicsroot/log
|
||||||
|
ServerOption QuieckPort [portnum $quieckport ]
|
||||||
|
ServerOption ServerPort [portnum $serverport ]
|
||||||
|
ServerOption InterruptPort [portnum $interruptport ]
|
||||||
|
ServerOption TelWord sicslogin
|
||||||
|
ServerOption TelnetPort [portnum $telnetport ]
|
||||||
|
ServerOption ReadUserPasswdTimeout 600000
|
||||||
|
ServerOption AcceptTimeOut 10
|
||||||
|
ServerOption ReadTimeOut 10
|
||||||
|
SicsUser manager ansto 1
|
||||||
|
SicsUser user sydney 2
|
||||||
|
SicsUser spy 007 3
|
||||||
|
MakeDataNumber SicsDataNumber $sicsroot/data/DataNumber
|
||||||
|
VarMake SicsDataPath Text Internal
|
||||||
|
SicsDataPath $sicsroot/data/
|
||||||
|
SicsDataPath lock
|
||||||
|
VarMake SicsDataPrefix Text Internal
|
||||||
|
SicsDataPrefix ansto
|
||||||
|
SicsDataPrefix lock
|
||||||
|
VarMake SicsDataPostFix Text Internal
|
||||||
|
SicsDataPostFix .hdf
|
||||||
|
SicsDataPostFix lock
|
||||||
|
VarMake Title Text User
|
||||||
|
VarMake Sample Text User
|
||||||
|
VarMake User Text User
|
||||||
|
VarMake starttime Text User
|
||||||
|
VarMake currentfile Text User
|
||||||
|
VarMake batchroot Text User
|
||||||
|
MakeDrive
|
||||||
|
|
||||||
|
# Useful for making configurable batch files.
|
||||||
|
publish set user
|
||||||
128
site_ansto/instrument/troubleShoot.tcl
Executable file
128
site_ansto/instrument/troubleShoot.tcl
Executable file
@@ -0,0 +1,128 @@
|
|||||||
|
#!/usr/bin/env tclsh
|
||||||
|
|
||||||
|
# $Revision: 1.8 $
|
||||||
|
# $Date: 2006-11-07 01:56:50 $
|
||||||
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||||
|
# Last revision by $Author: ffr $
|
||||||
|
|
||||||
|
# Load troubleshooting setup
|
||||||
|
source dmc2280_util.tcl
|
||||||
|
source troubleshoot_setup.tcl
|
||||||
|
source motorinfo.tcl
|
||||||
|
|
||||||
|
if { $argc > 0 } {
|
||||||
|
set configFileName [lindex $argv 0]
|
||||||
|
}
|
||||||
|
|
||||||
|
namespace eval sics_config {
|
||||||
|
proc loadConfig {fName} {
|
||||||
|
variable ContList
|
||||||
|
if [info exists ContList] {unset ContList}
|
||||||
|
# Temporarily define unknown proc to skip undefined procs
|
||||||
|
rename ::unknown _unknown
|
||||||
|
proc ::unknown {args} {}
|
||||||
|
if [catch {uplevel #0 source $fName} errMsg] {
|
||||||
|
rename ::unknown ""
|
||||||
|
rename _unknown ::unknown
|
||||||
|
error $errMsg
|
||||||
|
} else {
|
||||||
|
rename ::unknown ""
|
||||||
|
rename _unknown ::unknown
|
||||||
|
}
|
||||||
|
if [catch {set ContList [uplevel #0 info vars dmc2280_controller*]} result] {error $result}
|
||||||
|
if {[llength $ContList] == 0} {error "Error: There are no dmc2280_controllerN(host/port) arrays in the $fName configuration file"}
|
||||||
|
#Add the controller to the sics_config namespace
|
||||||
|
foreach c $ContList {upvar #0 $c cont; puts "$c IP:port = $cont(host):$cont(port)"}
|
||||||
|
}
|
||||||
|
|
||||||
|
proc subExists {contName sub} {
|
||||||
|
upvar #0 $contName controller
|
||||||
|
if [catch {::dmc_sendCmd $controller(socket) "LS $sub,0"} errMsg] {
|
||||||
|
error "Subroutine $sub does not exist on controller $contName"
|
||||||
|
}
|
||||||
|
::dmc_receive $controller(socket)
|
||||||
|
}
|
||||||
|
|
||||||
|
# Returns -1 if thread is not running, line number if it is
|
||||||
|
proc checkThread {contName thnum} {
|
||||||
|
upvar #0 $contName controller
|
||||||
|
::dmc_sendCmd $controller(socket) "MG _XQ$thnum"
|
||||||
|
set reply [::dmc_receive $controller(socket) ]
|
||||||
|
if {$reply == -1} {
|
||||||
|
error "Thread $thnum not running on controller $contName"
|
||||||
|
}
|
||||||
|
return $reply
|
||||||
|
}
|
||||||
|
|
||||||
|
# GUI STUFF
|
||||||
|
package require Tk
|
||||||
|
variable ContList
|
||||||
|
global ldFrame
|
||||||
|
set ldFrameName ".loadFile"
|
||||||
|
set ldFrame(button) $ldFrameName.ldConf
|
||||||
|
set ldFrame(entry) $ldFrameName.ldEntry
|
||||||
|
|
||||||
|
|
||||||
|
proc ::guiLoadC {} {
|
||||||
|
::sics_config::loadConfig [eval $::sics_config::ldFrame(entry) get]
|
||||||
|
}
|
||||||
|
|
||||||
|
proc ::guiConnect {w cont} {
|
||||||
|
::dmc_connect $cont
|
||||||
|
$w configure -activebackground green
|
||||||
|
$w configure -background green
|
||||||
|
}
|
||||||
|
|
||||||
|
proc ::guiCheckSubs {w cont} {
|
||||||
|
global contSubs
|
||||||
|
foreach sub $contSubs($cont) {
|
||||||
|
::sics_config::subExists $cont $sub
|
||||||
|
}
|
||||||
|
$w configure -activebackground green
|
||||||
|
$w configure -background green
|
||||||
|
}
|
||||||
|
|
||||||
|
proc ::guiCheckThreads {w cont} {
|
||||||
|
global contThreads
|
||||||
|
foreach thr $contThreads($cont) {
|
||||||
|
::sics_config::checkThread $cont $thr
|
||||||
|
}
|
||||||
|
$w configure -activebackground green
|
||||||
|
$w configure -background green
|
||||||
|
}
|
||||||
|
|
||||||
|
frame $ldFrameName
|
||||||
|
pack $ldFrameName
|
||||||
|
button $ldFrame(button) -text "Load config" -command {guiLoadC; ::sics_config::mkGui}
|
||||||
|
entry $ldFrame(entry) -textvariable configFileName -width -1
|
||||||
|
pack $ldFrame(button) -side left
|
||||||
|
pack $ldFrame(entry) -side left
|
||||||
|
|
||||||
|
|
||||||
|
proc mkGui {} {
|
||||||
|
variable ContList
|
||||||
|
lappend Headings $ContList
|
||||||
|
frame .t -bg black
|
||||||
|
table .t $ContList
|
||||||
|
pack .t
|
||||||
|
testgui
|
||||||
|
}
|
||||||
|
proc table {w headings args} {
|
||||||
|
set r 0
|
||||||
|
|
||||||
|
foreach name $headings {
|
||||||
|
lappend Header [label $w.$name -text $name]
|
||||||
|
}
|
||||||
|
foreach name $headings {
|
||||||
|
lappend Connect [button $w.connect$name -text connect -command "guiConnect $w.connect$name $name"]
|
||||||
|
lappend CheckSubs [button $w.chkSubs$name -text "Check subs" -command "guiCheckSubs $w.chkSubs$name $name"]
|
||||||
|
lappend CheckThreads [button $w.chkThrs$name -text "Check threads" -command "guiCheckThreads $w.chkThrs$name $name"]
|
||||||
|
}
|
||||||
|
eval grid $Header -sticky news -padx 1 -pady 1
|
||||||
|
eval grid $Connect -sticky news -padx 1 -pady 1
|
||||||
|
eval grid $CheckSubs -sticky news -padx 1 -pady 1
|
||||||
|
eval grid $CheckThreads -sticky news -padx 1 -pady 1
|
||||||
|
|
||||||
|
}
|
||||||
|
}
|
||||||
|
|
||||||
53
site_ansto/instrument/utility.tcl
Normal file
53
site_ansto/instrument/utility.tcl
Normal file
@@ -0,0 +1,53 @@
|
|||||||
|
# Some useful functions for SICS configuration.
|
||||||
|
|
||||||
|
# $Revision: 1.5 $
|
||||||
|
# $Date: 2006-11-07 01:57:45 $
|
||||||
|
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
|
||||||
|
# Last revision by $Author: ffr $
|
||||||
|
|
||||||
|
# Utility fucntion for setting the home and upper and lower
|
||||||
|
# limits for a motor
|
||||||
|
proc setHomeandRange {args} {
|
||||||
|
set usage "
|
||||||
|
Usage: setHomeandRange -motor motName -home homeVal -lowrange low -uprange high
|
||||||
|
eg
|
||||||
|
setHomeandRange -motor mchi -home 90 -lowrange 5 -uprange 7
|
||||||
|
this sets the home position to 90 degreess for motor mchi
|
||||||
|
with the lower limit at 85 and the upper limit at 97
|
||||||
|
"
|
||||||
|
if {$args == ""} {clientput $usage; return}
|
||||||
|
array set params $args
|
||||||
|
set motor $params(-motor)
|
||||||
|
set home $params(-home)
|
||||||
|
set lowlim [expr $home - $params(-lowrange)]
|
||||||
|
set uplim [expr $home + $params(-uprange)]
|
||||||
|
|
||||||
|
uplevel 1 "$motor hardlowerlim $lowlim"
|
||||||
|
uplevel 1 "$motor hardupperlim $uplim"
|
||||||
|
uplevel 1 "$motor softlowerlim $lowlim"
|
||||||
|
uplevel 1 "$motor softupperlim $uplim"
|
||||||
|
uplevel 1 "$motor home $home"
|
||||||
|
}
|
||||||
|
|
||||||
|
# Use this to create an array of named parameters to initialise motors.
|
||||||
|
proc params {args} {
|
||||||
|
upvar 1 "" x;
|
||||||
|
if [info exists x] {unset x}
|
||||||
|
foreach {k v} $args {set x([string tolower $k]) $v}
|
||||||
|
}
|
||||||
|
|
||||||
|
# Parse motor readings for virtual motor scripts.
|
||||||
|
proc SplitReply { text } {
|
||||||
|
set l [split $text =]
|
||||||
|
return [lindex $l 1]
|
||||||
|
}
|
||||||
|
|
||||||
|
# Sets motor position reading to pos by adjusting the softzero
|
||||||
|
proc setpos {motor pos} {
|
||||||
|
set currPos [SplitReply [$motor]]
|
||||||
|
set oldZero [SplitReply [$motor softzero]]
|
||||||
|
set newZero [expr $currPos - $pos + $oldZero]
|
||||||
|
uplevel #0 "$motor softzero $newZero"
|
||||||
|
}
|
||||||
|
publish setpos user
|
||||||
|
publish SplitReply user
|
||||||
Reference in New Issue
Block a user