linse/sics
0
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Remove superfluous trailing white space from TCL files

Browse Source
This commit is contained in:
Douglas Clowes
2014-05-16 12:30:51 +10:00
parent 89e4e37f9e
commit 92d3acb5d5
230 changed files with 1835 additions and 1835 deletions
Download Patch File Download Diff File Expand all files Collapse all files

2
site_ansto/instrument/lyrebird/config/anticollider/anticollider.tcl
View File

@@ -1,6 +1,6 @@
# Author: Ferdi Franceschini (ffr@ansto.gov.au)
source $cfPath(anticollider)/anticollider_common.tcl
source $cfPath(anticollider)/anticollider_common.tcl
# NOTE: This is called with a list of motorname target pairs
proc ::anticollider::enable {args} {

2
site_ansto/instrument/lyrebird/config/counter/counter.tcl
View File

@@ -5,7 +5,7 @@ namespace eval counter {
variable isc_numchannels
variable isc_monitor_address
variable isc_portlist
variable isc_beam_monitor_list
variable isc_beam_monitor_list
proc set_sobj_attributes {} {
}
}

26
site_ansto/instrument/lyrebird/config/goniometer/sct_goniometer.tcl
View File

@@ -1,5 +1,5 @@
##
# @file Goniometer controller
# @file Goniometer controller
#
# Author: Jing Chen (jgn@ansto.gov.au) June 2010
#
@@ -10,7 +10,7 @@
# PORT 62944
# tuning 1
# interval 1
# }
# }
#
# NOTE:
# If tuning=1 this will generate gom/set_gom, gchi/set_gchi and gphi/set_gphi
@@ -25,14 +25,14 @@ proc ::scobj::goniometer::set_gom {basePath} {
set newGOM [sct target]
hsetprop $basePath targetGom $newGOM
return idle
}
}
proc ::scobj::goniometer::set_gchi {basePath} {
set newGCHI [sct target]
hsetprop $basePath targetGchi $newGCHI
return idle
}
}
proc ::scobj::goniometer::set_gphi {basePath} {
set newGPHI [sct target]
hsetprop $basePath targetGphi $newGPHI
@@ -63,12 +63,12 @@ proc ::scobj::goniometer::rdStatFunc {basePath} {
hset $basePath/gom $stateArr(gom)
hset $basePath/gchi $stateArr(gchi)
hset $basePath/gphi $stateArr(gphi)
hset $basePath/gphi $stateArr(gphi)
hsetprop $basePath currGom $stateArr(gom)
hsetprop $basePath currGchi $stateArr(gchi)
hsetprop $basePath currGphi $stateArr(gphi)
#sct update $s3
sct utime readtime
}
@@ -110,21 +110,21 @@ proc ::scobj::goniometer::checkReplyFunc {} {
broadcast "ERROR: PLC cannot write new values for variable due to internal reason!"
} else {
sct utime readtime
}
}
return idle
}
##
# @brief Make a Goniometer controller
#
# @param argList, {name "goniometer" IP localhost PORT 62944 tuning 1 interval 1}
#
# @param argList, {name "goniometer" IP localhost PORT 62944 tuning 1 interval 1}
#
# name: name of goniometer controller object
# IP: IP address of RF generator moxa box
# PORT: Port number assigned to the generator on the moxa-box
# tuning: boolean, set tuning=1 to allow instrument scientists to set the axe positions
# interval: polling and ramping interval in seconds.
# interval: polling and ramping interval in seconds.
proc ::scobj::goniometer::mkGoniometer {argList} {
# Generate parameter array from the argument list
foreach {k v} $argList {

10
site_ansto/instrument/lyrebird/config/hmm/hmm_configuration.tcl
View File

@@ -21,7 +21,7 @@ proc ::histogram_memory::init_OAT_TABLE {} {
hmm configure fat_frame_frequency $freq
hmm configure fat_frame_source INTERNAL
OAT_TABLE -set X { 29.5 28.5 } NXC 30 Y { -0.5 0.5 } NYC 1024 T { 0 200000 } NTC 1
OAT_TABLE -set X { 29.5 28.5 } NXC 30 Y { -0.5 0.5 } NYC 1024 T { 0 200000 } NTC 1
} message ] {
if {$::errorCode=="NONE"} {return $message}
return -code error $message
@@ -65,9 +65,9 @@ proc ::histogram_memory::init_CAT_TABLE {} {
1. 1. 1. 1. 1. 1.
}
CAT_TABLE -set MESYTEC_TUBE_OFFSETS {
0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0. 0. 0.
0. 0. 0. 0. 0. 0.
}
CAT_TABLE -set MESYTEC_TUBE_HISTOGRAM_WEIGHTS {
@@ -107,7 +107,7 @@ proc ::histogram_memory::isc_initialize {} {
::histogram_memory::set_graphtype "two_theta" "boundaries"
# MJL TODO detector geometry for Lyrebird TBD. Figures need revision during commissioning
# Width = 25mm spacing * 30 tubes = 5000mm (??? degree coverage)
# Width = 25mm spacing * 30 tubes = 5000mm (??? degree coverage)
# Height = 1015mm (tube length)
# Radius = 2400mm
detector_active_height_mm 1015

4
site_ansto/instrument/lyrebird/config/motors/motor_configuration.tcl
View File

@@ -735,7 +735,7 @@ Motor pa_top $motor_driver_type [params \
pa_left part slits
pa_left long_name pa_top
pa_left softlowerlim -200
pa_left softupperlim 0
pa_left softupperlim 0
pa_left home 0
# mc6: Pre-sample bottom aperture -- Slit s2 bottom Blade
@@ -757,7 +757,7 @@ Motor pa_bottom $motor_driver_type [params \
pa_bottom part slits
pa_bottom long_name pa_bottom
pa_bottom softlowerlim -200
pa_bottom softupperlim 0
pa_bottom softupperlim 0
pa_bottom home 0
proc motor_set_sobj_attributes {} {

8
site_ansto/instrument/lyrebird/config/motors/positmotor_configuration.tcl
View File

@@ -27,10 +27,10 @@ set 20sample_table {
6 203.7
7 161.7
8 119.7
9 77.7
10 35.7
11 -46.3
12 -88.3
9 77.7
10 35.7
11 -46.3
12 -88.3
13 -130.3
14 -172.3
15 -214.3

16
site_ansto/instrument/lyrebird/config/motors/sct_flightTube.tcl
View File

@@ -30,7 +30,7 @@ namespace eval ::scobj::galil {
##
# @brief Read Angle value from Gumtree client and then send the command to the Motor
# @return The next state
# @return The next state
proc ::scobj::galil::getValue {nextState} {
set tmpAngle [sct target]
set comm "ANGLE=$tmpAngle"
@@ -40,7 +40,7 @@ namespace eval ::scobj::galil {
##
# @brief Get ACK from the Motor after sending an ANGLE command to the Motor
# @return IDLE
# @return IDLE
proc ::scobj::galil::rdStatusFunc {} {
set ack [sct result]
if {$ack == -1} {
@@ -49,7 +49,7 @@ namespace eval ::scobj::galil {
broadcast "Error $ack: Angle is not set correctly, check the error code $ack!"
}
return idle
}
}
proc ::scobj::galil::mkGalil {argList} {
@@ -59,7 +59,7 @@ proc ::scobj::galil::mkGalil {argList} {
}
set NS ::scobj::$pa(NAME)
set internal $pa(INTERVAL)
set internal $pa(INTERVAL)
set batObjName $pa(NAME)
set batpath /sics/$batObjName
@@ -74,9 +74,9 @@ proc ::scobj::galil::mkGalil {argList} {
#sicslist setatt $pa(NAME) klass instrument
#sicslist setatt $pa(NAME) long_name $pa(NAME)
hsetprop $batpath klass NXaperture
hfactory /sics/$pa(NAME)/Angle plain user float
hfactory /sics/$pa(NAME)/setAngle plain user float
hfactory /sics/$pa(NAME)/setAngle plain user float
makesctcontroller sct_ft galil $pa(IP):$pa(PORT)
#makesctcontroller sct_ft std $pa(IP):$pa(PORT)
@@ -84,14 +84,14 @@ proc ::scobj::galil::mkGalil {argList} {
# Get the TPF value from the Motor, then convert to current ANGLE position
hsetprop $batpath read ${NS}::getTPF
hsetprop $batpath ackCmd ${NS}::ackCmd $batpath
# Read the ANGLE value from the Gumtree client, then send roate command to Motor and get ACK from Motor.
hsetprop $batpath write ${NS}::getValue rdStatus
hsetprop $batpath rdStatus ${NS}::rdStatusFunc
::scobj::hinitprops $batObjName setAngle Angle
sct_ft poll $batpath $internal
sct_ft poll $batpath $internal
sct_ft write $batpath
}

4
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/andorhm.tcl
View File

@@ -1,6 +1,6 @@
#--------------------------------------------------------------
# This is the initialisation code for the ANDOR iKon-M
# camera and the CDDWWW WWW-server. It got separated into
# camera and the CDDWWW WWW-server. It got separated into
# a separate file in order to support moving that camera around.
#
# Mark Koennecke, November 2010
@@ -61,7 +61,7 @@ proc tempreply {} {
return idle
}
#-------------------------------------------------------------
proc MakeAndorHM {name host } {
proc MakeAndorHM {name host } {
ccdwww::MakeCCDWWW $name $host "ccdwww::initscript $name"
hfactory /sics/$name/daqmode plain mugger text
hset /sics/$name/daqmode single

36
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/astrium.tcl
View File

@@ -1,7 +1,7 @@
#--------------------------------------------------------------
# This is a new style driver for the Astrium chopper systems in
# the new sicsobj/scriptcontext based system. Please note that
# actual implementations may differ in the number of choppers
# actual implementations may differ in the number of choppers
# and the address of the chopper on the network.
#
# copyright: see file COPYRIGHT
@@ -10,23 +10,23 @@
# - reading parameters:
# astchopread - readastriumchopperpar - readastriumchopperpar - ...
# - writing
# astchopwrite - astchopwritereply
# astchopwrite - astchopwritereply
#
# Another remark:
# In order for chosta to work properly, the chopperparlist and
# In order for chosta to work properly, the chopperparlist and
# chopperlonglist must be aligned.
#
# Mark Koennecke, February 2009
#
# If something goes wrong with this, the following things ought
# If something goes wrong with this, the following things ought
# to be checked:
# - Is the standard Tcl scan command been properly renamed to stscan?
# - Is a communication possible with the chopper via telnet?
# This may not be the case because of other SICS servers blocking
# This may not be the case because of other SICS servers blocking
# things or the old driver being active and capturing the terminal
# server port in SerPortServer. Scriptcontext then fails silently.
# But may be we will fix the latter.
# - The other thing which happens is that the parameter list of
# But may be we will fix the latter.
# - The other thing which happens is that the parameter list of
# the chopper differs in little ways between instances.
#
# Mark Koennecke, April 2009
@@ -43,7 +43,7 @@ proc astriumchopperputerror {txt} {
}
}
#--------------------------------------------------------------
# Paramamters look like: name value, entries for parameters are
# Paramamters look like: name value, entries for parameters are
# separated by ;
#---------------------------------------------------------------
proc astriumsplitreply {chopper reply} {
@@ -62,20 +62,20 @@ proc astriumsplitreply {chopper reply} {
if {$val > 360} {
set val [expr $val -360.]
}
hupdate /sics/choco/${chopper}/dphas $val
hupdate /sics/choco/${chopper}/dphas $val
hdelprop /sics/choco/${chopper}/dphas geterror
}
if {[string first averl $par] >= 0} {
set val [string range $par 5 end]
hupdate /sics/choco/${chopper}/averl $val
hupdate /sics/choco/${chopper}/averl $val
hdelprop /sics/choco/${chopper}/averl geterror
}
}
}
}
#-------------------------------------------------------------
# update those parameters which are dependent on the chopper
# status just read. Some of them may or may not be there, this
# update those parameters which are dependent on the chopper
# status just read. Some of them may or may not be there, this
# is why this is protected by catch'es.
#-------------------------------------------------------------
proc astcopydependentpar {} {
@@ -91,7 +91,7 @@ proc astcopydependentpar {} {
}
#--------------------------------------------------------------
proc readastriumchopperpar {} {
global choppers
global choppers
set reply [sct result]
if {[string first ERR $reply] >= 0} {
astriumchopperputerror $reply
@@ -106,7 +106,7 @@ proc readastriumchopperpar {} {
sct send @@NOSEND@@
sct replycount 0
hupdate /sics/choco/asyst ""
hdelprop /sics/choco/asyst geterror
hdelprop /sics/choco/asyst geterror
return astchoppar
} else {
set oldval [hval /sics/choco/asyst]
@@ -157,7 +157,7 @@ proc astchopwrite {prefix} {
return astchopwritereply
}
#----------------------------------------------------------------
# Make sure to send a status request immediatly after a reply in
# Make sure to send a status request immediatly after a reply in
# order to avoid timing problems
#----------------------------------------------------------------
proc astchopwritereply {} {
@@ -393,7 +393,7 @@ proc astMakeChopperRatio {var} {
chocosct write $path
hsetprop $path checklimits astchopratiolimit
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckratio
hsetprop $path checkstatus astchopcheckratio
makesctdriveobj $var $path DriveAdapter chocosct
}
#------------------------------------------------------------------------
@@ -466,7 +466,7 @@ if {$poldi == 1} {
return idle
}
}
return [astchopwrite "nspee 1 "]
return [astchopwrite "nspee 1 "]
}
#-----------
set choppers [list chopper]
@@ -520,5 +520,5 @@ if {$focus == 1} {
astMakeChopperSpeed2 diskspeed
astMakeChopperRatio ratio
astMakeChopperPhase2 phase
Publish chosta Spy
Publish chosta Spy
}

4
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/backup.tcl
View File

@@ -10,7 +10,7 @@ proc backupCron {path {minutes 10} {days 1}} {
set minutes [expr $minutes * 60]
set days [expr $days * 24*3600]
if {! [info exists next_backup]} {
set next_backup(min) [nextBackupTime $now $minutes last]
set next_backup(min) [nextBackupTime $now $minutes last]
set next_backup(day) [nextBackupTime $now $days last]
set file [clock format $now -format "$path/backupd-%m-%d.tcl"]
if {![file exists $file]} {
@@ -18,7 +18,7 @@ proc backupCron {path {minutes 10} {days 1}} {
}
}
if {$now > $next_backup(min)} {
set next_backup(min) [nextBackupTime $now $minutes last]
set next_backup(min) [nextBackupTime $now $minutes last]
set file [clock format $last -format "$path/backup-%Hh%M.tcl"]
} else {
return 1

2
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/batch.tcl
View File

@@ -6,7 +6,7 @@
if { [info exists batchinit] == 0 } {
set batchinit 1
Publish batchroot Spy
Publish batchrun User
Publish batchrun User
}
proc SplitReply { text } {

18
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/ccdwww.tcl
View File

@@ -1,20 +1,20 @@
#------------------------------------------------------
# This is SICS HM driver code for the CCDWWW CCD camera
# WWW server as used at SINQ. It uses, of course, the
# WWW server as used at SINQ. It uses, of course, the
# scriptcontext asynchronous I/O system
#
# Mark Koennecke, September 2010
#-------------------------------------------------------
namespace eval ccdwww {}
#-------------------------------------------------------
# This is a default init script. The user has to initialise
# This is a default init script. The user has to initialise
# a list of nodes to send to the CCD in XML format as
# variable ccdwww::initnodes
#--------------------------------------------------------
proc ccdwww::initscript {name} {
global ccdwww::initnodes
append confdata "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
foreach var $ccdwww::initnodes {
set val [hval /sics/${name}/${var}]
@@ -68,8 +68,8 @@ proc ccdwww::httpstartreply {} {
return idle
}
#---------------------------------------------------------
# A CCD works like a camera. When exposing, it cannot be stopped,
# paused or anything. This is why the appropriate methods
# A CCD works like a camera. When exposing, it cannot be stopped,
# paused or anything. This is why the appropriate methods
# here have no implementation
#----------------------------------------------------------
proc ccdwww::httpcontrol {} {
@@ -111,7 +111,7 @@ proc ccdwww::httpdatareply {} {
set status [catch {httpreply} txt]
if {$status == 0} {
set path [file dirname [sct]]
hdelprop $path/data geterror
hdelprop $path/data geterror
}
return idle
}
@@ -135,13 +135,13 @@ proc ccdwww::httpevalstatus {name} {
clientput $data
sct update error
return idle
}
}
hdelprop [sct] geterror
if {$data == 0} {
httpdata $name
return httpstatusdata
} else {
sct update run
sct update run
[sct controller] queue [sct] progress read
return idle
}

24
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/deltatau.tcl
View File

@@ -1,5 +1,5 @@
#---------------------------------------------------------------
# These are the scripts for the delta-tau PMAC motor
# These are the scripts for the delta-tau PMAC motor
# controller.
#
# !!!!!!!!! Script Chains !!!!!!!!!!!
@@ -12,11 +12,11 @@
# -- For reading the status
# pmacsendaxer --- pmacrcvaxerr -- pmacrcvpos -- pmacrcvstat
# This means we check for an axis error first, then update the position,
# then check the axis status itself.
# then check the axis status itself.
# -- For setting the position
# pmacsendhardpos -- pmacrcvhardpos -- pmacrcvhardax
# This means, we send the positioning command, read the reply and read the
# axisstatus until the axis has started
# This means, we send the positioning command, read the reply and read the
# axisstatus until the axis has started
#
# copyright: see file COPYRIGHT
#
@@ -66,7 +66,7 @@ proc translateAxisError {key} {
}
#---------------------------------------------------------------------
proc evaluateAxisStatus {key} {
#----- Tcl does not like negative numbers as keys.
#----- Tcl does not like negative numbers as keys.
if {$key < 0} {
set key [expr 50 + abs($key)]
}
@@ -181,7 +181,7 @@ proc pmacrcvaxerr {motname num} {
sct update error
sct geterror $data
return idle
}
}
hupdate /sics/$motname/axiserror $data
if {$data != 0 } {
set err [translateAxisError $data]
@@ -206,7 +206,7 @@ proc pmacrcvpos {motname num} {
sct geterror $data
sct update error
return idle
}
}
hupdate /sics/$motname/hardposition $data
sct send "P${num}00"
return rcvstat
@@ -218,7 +218,7 @@ proc pmacrcvstat {motname num sct} {
clientput "ERROR: $motname : $data"
sct update error
return idle
}
}
set status [catch {evaluateAxisStatus $data} msg]
if {$status != 0} {
sct update error
@@ -260,7 +260,7 @@ proc pmacrcvhardpos {num} {
clientput "ERROR: $data"
sct seterror $data
return idle
}
}
sct send "P${num}00"
return rcvhardax
}
@@ -271,7 +271,7 @@ proc pmacrcvhardax {motname num sct} {
clientput "ERROR: $motname : $data"
sct seterror $data
return idle
}
}
set status [catch {evaluateAxisStatus $data} msg]
if {$status != 0} {
clientput "ERROR: $motname : $msg"
@@ -284,7 +284,7 @@ proc pmacrcvhardax {motname num sct} {
return rcvhardax
}
run {
$sct queue /sics/$motname/status progress read
$sct queue /sics/$motname/status progress read
return idle
}
}
@@ -353,5 +353,5 @@ proc MakeDeltaTau {name sct num} {
# $sct send [format "M%2.2d14=1" $num]
foreach par $parlist {
$sct queue /sics/$name/$par progress read
}
}
}

52
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/el734.tcl
View File

@@ -1,13 +1,13 @@
#--------------------------------------------------------
# This is a scriptcontext based driver for the EL734
# motor controller. This is part of an ongoing effort to
# expire older drivers and to consolidate on the new
# motor controller. This is part of an ongoing effort to
# expire older drivers and to consolidate on the new
# scriptcontext system.
#
# Scriptchains:
# Rather then having long script chains many of the
# intricacies of the EL734 are handled via a command
# processing state machine. See the docs below for
# Rather then having long script chains many of the
# intricacies of the EL734 are handled via a command
# processing state machine. See the docs below for
# details
#
# copyright: see file COPYRIGHT
@@ -19,24 +19,24 @@ namespace eval el734 {}
#---------------------------------------------------------
# The EL734 is a a tricky thing. Some special conditions
# apply:
# - On emergency stop an *ES is sent. But only the second
# response of this kind is valid because there can be
# spurious *ES on the line even when the emergency stop
# apply:
# - On emergency stop an *ES is sent. But only the second
# response of this kind is valid because there can be
# spurious *ES on the line even when the emergency stop
# has been released.
# - If someone fingers the EL734 or after startup it is in
# - If someone fingers the EL734 or after startup it is in
# local mode. Then two commands have to be sent in order to
# make it go into remote mode before retrying the command.
# - In some echo modes of the controller it sends a echo
# make it go into remote mode before retrying the command.
# - In some echo modes of the controller it sends a echo
# of the command. This has to be ignored in order to get at
# the real problem
#
# In order to deal with all this, el734::command is implemented
# as a state machine which calls another script when a valid
# In order to deal with all this, el734::command is implemented
# as a state machine which calls another script when a valid
# reponse has actually been found.
# The state of the current command processing
# is saved in a node property comstate. The actual command to send
# is in the property comstring. The script to call if we actually
# is in the property comstring. The script to call if we actually
# have a valid response is stored in the property comresponse
#---------------------------------------------------------------
proc el734::setcommand {command responsescript {motno 0}} {
@@ -45,10 +45,10 @@ proc el734::setcommand {command responsescript {motno 0}} {
sct comstring $command
sct commotno $motno
return command
}
}
#---------------------------------------------------------------
# As implemented now this can go in an endless loop if switching
# to local fails repeatedly. TODO: test if this happens with the
# to local fails repeatedly. TODO: test if this happens with the
# real device
#---------------------------------------------------------------
proc el734::command {} {
@@ -132,7 +132,7 @@ proc el734::checkerror {} {
}
}
return $reply
}
}
#========================== Position ===============================
proc el734::readpos {num} {
set com [format "u %d" $num]
@@ -214,7 +214,7 @@ proc el734::decodemsr {name msr} {
set msrdata(0x40) "Bad step"
set msrdata(0x100) posfault
set msrdata(0x400) posfault
set oredmsr [hval /sics/${name}/oredmsr]
if {$msr == 0} {
#-------- FINISHED
@@ -223,7 +223,7 @@ proc el734::decodemsr {name msr} {
if {$pos > 0 || $run > 0} {
return posfault
}
set orlist [array names oredata]
foreach code $orlist {
if {$oredmsr & $code} {
@@ -402,7 +402,7 @@ proc el734::refrun {controller name num} {
wait 2
set ss [hval /sics/${name}/ss]
if { [string first ?BSY $ss] < 0} {
break
break
}
set rupt [getint]
if { [string compare $rupt continue] != 0} {
@@ -426,7 +426,7 @@ proc el734::reset {name} {
#========================= Make ==================================
proc el734::make {name no controller} {
MakeSecMotor $name
hfactory /sics/${name}/oredmsr plain internal int
hfactory /sics/${name}/runfault plain internal int
hfactory /sics/${name}/posfault plain internal int
@@ -442,7 +442,7 @@ proc el734::make {name no controller} {
hsetprop /sics/${name}/hardlowerlim read el734::getlim $name $no
hsetprop /sics/${name}/hardlowerlim command el734::command
$controller poll /sics/${name}/hardlowerlim 120
hsetprop /sics/${name}/status read el734::readstatus $no $name
hsetprop /sics/${name}/status command el734::command
$controller poll /sics/${name}/status 40
@@ -472,7 +472,7 @@ proc el734::addrefstuff {name no controller} {
hfactory /sics/${name}/refnull plain user int
hsetprop /sics/${name}/refnull read el734::readref $no
hsetprop /sics/${name}/refnull command el734::command
$controller poll /sics/${name}/refnull 300
$controller poll /sics/${name}/refnull 300
hsetprop /sics/${name}/refnull write el734::setref $name $no
hsetprop /sics/${name}/refnull command el734::command
@@ -481,8 +481,8 @@ proc el734::addrefstuff {name no controller} {
hfactory /sics/${name}/ss plain internal text
hsetprop /sics/${name}/ss read el734::readss $no
hsetprop /sics/${name}/ss ssread el734::ssread
$controller poll /sics/${name}/ss 300
$controller poll /sics/${name}/ss 300
$name makescriptfunc refrun "el734::refrun $controller $name $no" user
}

12
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/el737sec.tcl
View File

@@ -1,5 +1,5 @@
#-----------------------------------------------------
# This is a second generation counter driver for
# This is a second generation counter driver for
# the PSI EL737 counter boxes using scriptcontext
# communication.
#
@@ -11,8 +11,8 @@
# status: el737readstatus - el737status
# \ el737statval - el737statread
# values: el737readvalues - el737val
# threshold write: el737threshsend - el737threshrcv - el737cmdreply
#
# threshold write: el737threshsend - el737threshrcv - el737cmdreply
#
# Mark Koennecke, February 2009
#-----------------------------------------------------
proc el737error {reply} {
@@ -107,7 +107,7 @@ proc el737control {} {
return idle
}
}
}
#----------------------------------------------------
proc el737readstatus {} {
@@ -187,7 +187,7 @@ proc swapFirst {l} {
}
#---------------------------------------------------
# There are two types of reponses to the RA command:
# the old form with 5 values and the new one
# the old form with 5 values and the new one
# with 9 values
#---------------------------------------------------
proc el737val {} {
@@ -315,7 +315,7 @@ proc MakeSecEL737 {name netaddr} {
hfactory /sics/${name}/RS plain internal int
hfactory /sics/${name}/RA plain internal intvarar 8
$conname debug -1
}

6
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/el755.tcl
View File

@@ -1,7 +1,7 @@
#-------------------------------------------------------------
# This is a scriptcontext driver for the PSI EL755 magnet
# This is a scriptcontext driver for the PSI EL755 magnet
# controller.
#
#
# scriptchains:
# read - readreply
# write - writereply - writereadback
@@ -57,7 +57,7 @@ proc el755::writereply {num} {
error $reply
}
sct send [format "I %d" $num]
return writereadback
return writereadback
}
#--------------------------------------------------------------------
proc el755::writereadback {num} {

72
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/fourcircle.tcl
View File

@@ -1,7 +1,7 @@
#----------------------------------------------------------
# This is a file full of support functions for four
# circle diffraction in the new four circle system. This
# is the common, shared stuff. There should be another
# This is a file full of support functions for four
# circle diffraction in the new four circle system. This
# is the common, shared stuff. There should be another
# file which contains the instrument specific adaptions.
#
# Mark Koennecke, August 2008, November 2008, February 2009
@@ -10,7 +10,7 @@ if { [info exists __singlexinit] == 0 } {
set __singlexinit 1
MakeSingleX
Publish projectdir Spy
Publish cell Spy
Publish cell Spy
Publish ub Spy
Publish spgrp Spy
Publish calcang Spy
@@ -18,7 +18,7 @@ if { [info exists __singlexinit] == 0 } {
Publish calctth Spy
Publish refclear User
Publish reflist Spy
# Publish refang User
# Publish refang User
Publish refdel User
Publish refhkl User
Publish refang User
@@ -38,7 +38,7 @@ if { [info exists __singlexinit] == 0 } {
Publish tabload user
Publish loadx User
Publish testx User
Publish collconf User
Publish collconf User
Publish hkllimit Spy
Publish hklgen User
Publish indw User
@@ -79,14 +79,14 @@ if { [info exists __singlexinit] == 0 } {
}
#---------------------------------------------------------
# support function for handling ranges in measuring
# reflections. This is tricky: When calculating if a
# reflection is scannable one has to take the range of
# reflections. This is tricky: When calculating if a
# reflection is scannable one has to take the range of
# the scan into account. SICS goes to great pain to calculate
# reflections in spite of restrictions. It tweaks ome, searches
# psi etc. In order to arrive at a scannable position for
# reflections in spite of restrictions. It tweaks ome, searches
# psi etc. In order to arrive at a scannable position for
# calculations and initial driving, the ranges in om and stt
# have to be corrected to include the scan range. These support
# functions take care of this.
# functions take care of this.
#----------------------------------------------------------
set __fmessomup 0
set __fmessomlow 0
@@ -209,7 +209,7 @@ proc getsetangles {} {
proc calchkl args {
set mo [string trim [SplitReply [singlex mode]]]
switch $mo {
bi {
bi {
if {[llength $args] < 4} {
set stt [singlex motval stt]
set om [singlex motval om]
@@ -333,7 +333,7 @@ proc refdel {id} {
}
#--------------------------------------------------------------
proc refhkl {id h k l } {
return [ref setx $id $h $k $l]
return [ref setx $id $h $k $l]
}
#-------------------------------------------------------------
proc refang args {
@@ -427,7 +427,7 @@ proc centerlist {preset {mode monitor} {skip 0} } {
set h [lindex $val 2]
set k [lindex $val 3]
set l [lindex $val 4]
clientput "Processing reflection $refid = $h $k $l"
clientput "Processing reflection $refid = $h $k $l"
set stt [lindex $val 5]
if {$stt > .0} {
set mo [string trim [SplitReply [singlex mode]]]
@@ -519,7 +519,7 @@ proc tablist {} {
}
#---------------------------------------------------------------------------
proc tabclear {} {
return [fmess table clear]
return [fmess table clear]
}
#---------------------------------------------------------------------------
proc tabadd {sttend scanvar step np preset } {
@@ -742,8 +742,8 @@ proc testx args {
proc collconf args {
set modelist [list monitor timer]
if {[llength $args] < 4} {
append res [SplitReply [fmess mode]]
append res [SplitReply [fmess fast]]
append res [SplitReply [fmess mode]]
append res [SplitReply [fmess fast]]
append res " " [SplitReply [fmess weak]]
append res " " [SplitReply [fmess weakthreshold]]
return $res
@@ -808,7 +808,7 @@ proc scanref {ref} {
xxxscan add $ommot $start $step
if {[string first o2t $scanvar] >= 0} {
set start [expr $stt - 2*$range]
xxxscan add $sttmot $start [expr $step * 2.]
xxxscan add $sttmot $start [expr $step * 2.]
}
set mode [string trim [SplitReply [fmess mode]]]
xxxscan run $np $mode $preset
@@ -859,7 +859,7 @@ proc hklgen { {sup no} } {
}
#----------------------------------------------------------------
proc indw {hw kw lw} {
return [fmess genw $hw $kw $lw]
return [fmess genw $hw $kw $lw]
}
#----------------------------------------------------------------
proc indsave {filename} {
@@ -873,7 +873,7 @@ proc indsave {filename} {
set idxlist [split [messref show $ref]]
puts $out [format " %12.6f %12.6f %12.6f" [lindex $idxlist 2] \
[lindex $idxlist 3] [lindex $idxlist 4]]
}
close $out
return "Done"
@@ -890,8 +890,8 @@ proc indlist {} {
proc indexconf args {
if {[llength $args] < 2} {
append res "simidxconf = "
append res [SplitReply [simidx sttlim]] ", "
append res [SplitReply [simidx anglim]] " "
append res [SplitReply [simidx sttlim]] ", "
append res [SplitReply [simidx anglim]] " "
return $res
} else {
simidx sttlim [lindex $args 0]
@@ -997,7 +997,7 @@ proc writerafinfile {filename cell} {
puts $out ""
puts $out "-1"
close $out
catch {file attributes $filename -permissions 00664}
catch {file attributes $filename -permissions 00664}
}
#-----------------------------------------------------------
proc writerafnbfile {filename cell} {
@@ -1014,7 +1014,7 @@ proc writerafnbfile {filename cell} {
puts $out ""
puts $out "-1"
close $out
catch {file attributes $filename -permissions 00664}
catch {file attributes $filename -permissions 00664}
}
#---------------------------------------------------------
proc checkResult {filename} {
@@ -1093,7 +1093,7 @@ proc refshow {} {
}
if {[string first 0RESULTS $line] >= 0} {
set dataappend 1
}
}
if {$dataappend == 1} {
append res $line "\n"
}
@@ -1127,7 +1127,7 @@ proc loadub {} {
gets $in line
stscan $line "%f %f %f" u31 u32 u33
singlex ub $u11 $u12 $u13 $u21 $u22 $u23 $u31 $u32 $u33
}
}
if {[string first "0DIRECT CELL" $line] >= 0} {
stscan $line "%s %s %f %f %f %f %f %f" junk junk2 a b c alpha beta gamma
singlex cell $a $b $c $alpha $beta $gamma
@@ -1201,7 +1201,7 @@ proc removeduplicatesold {peaklist} {
foreach fp $final {
if {abs($fp - $peak) < 2.} {
set valid 0
}
}
}
if {$valid == 1} {
lappend final $peak
@@ -1240,7 +1240,7 @@ proc removeduplicates {peaklist countlist} {
return $final
}
#--------------------------------------------------------------------
# Do not be confused by the use of phi. This is also used for finding
# Do not be confused by the use of phi. This is also used for finding
# peaks in omega in NB
#--------------------------------------------------------------------
proc findpeaksinscan {} {
@@ -1321,7 +1321,7 @@ proc searchbi {preset mode maxpeak} {
if {$status != 0} {
clientput "WARNING: Cannot reach chi $chipos, skipping"
continue
}
}
clientput "Searching at chi: $chipos"
success
switch $detmode {
@@ -1354,14 +1354,14 @@ proc searchbi {preset mode maxpeak} {
if {[string first continue $interrupt] < 0} {
error $msg
}
#--------- Do I need to extract peaks from the area detector data or is this to be
# left to anatric?
#--------- Do I need to extract peaks from the area detector data or is this to be
# left to anatric?
}
default {
error "Reflection search not supported for this detector mode"
}
}
}
}
}
}
#-----------------------------------------------------------------------
@@ -1447,7 +1447,7 @@ proc searchnb {preset mode maxpeak} {
error "Reflection search not supported for this detector mode"
}
}
}
}
}
}
#--------------------------------------------------------------------------------------
@@ -1598,7 +1598,7 @@ proc psiscan {h k l step stepom omnp preset {countmode NULL}} {
break
}
}
}
}
clientput "Scanning at $psi"
set ompos [string trim [SplitReply [om]]]
set status [catch {cscan om $ompos $stepom $omnp $preset} msg]
@@ -1610,7 +1610,7 @@ proc psiscan {h k l step stepom omnp preset {countmode NULL}} {
} else {
clientput "ERROR: $msg while scanning"
}
}
}
set stt [SplitReply [stt]]
set chi [SplitReply [chi]]
set phi [SplitReply [phi]]
@@ -1679,7 +1679,7 @@ proc savexxx {filename} {
return "Done"
}
#======================================================================================
# Stuff to support Hipadaba
# Stuff to support Hipadaba
#======================================================================================
proc ubrefinehdb args {
set path /instrument/reflection_list/ubrefresult

68
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/hdbutil.tcl
View File

@@ -1,6 +1,6 @@
#-----------------------------------------------------------------------
# This is a collection of utility procedures to help with Hipadaba and
# Gumtree Swiss Edition. This file is supposed to be sourced by any
# This is a collection of utility procedures to help with Hipadaba and
# Gumtree Swiss Edition. This file is supposed to be sourced by any
# instrument using Hipadaba.
#
# Copyright: see file COPYRIGHT
@@ -10,14 +10,14 @@
# Requirements:
# * the internal scan command xxxscan
# * scan data to live /graphics/scan_data
#
#
# Many updates, till November 2008, Mark Koennecke
#----------------------------------------------------------------------
if { [info exists hdbinit] == 0 } {
set hdbinit 1
MakeStateMon
Publish getgumtreexml Spy
if {[string first tmp $home] < 0} {
if {[string first tmp $home] < 0} {
set tmppath $home/tmp
} else {
set tmppath $home
@@ -30,7 +30,7 @@ if { [info exists hdbinit] == 0 } {
Publish hdbcollect User
Publish listbatchfiles Spy
Publish makemumopos User
Publish dropmumo User
Publish dropmumo User
Publish hdbbatchpath User
Publish cscan User
Publish sscan User
@@ -39,7 +39,7 @@ if { [info exists hdbinit] == 0 } {
Publish hmakescript Mugger
Publish hlink Mugger
Publish hcommand Mugger
Publish hdbstorenexus User
Publish hdbstorenexus User
Publish scaninfo Spy
}
#===================================================================
@@ -52,7 +52,7 @@ if { [info exists hdbinit] == 0 } {
# makeQuickPar name path
# makeslit path left right upper lower
# configures a slit. Missing motors can be indicated with NONE
# makestdadmin
# makestdadmin
# makecount path
# makerepeat path
# makekillfile path
@@ -60,8 +60,8 @@ if { [info exists hdbinit] == 0 } {
# makestdgui
# makewait path
# makeevproxy rootpath hdbname devicename
# makemumo rootpath mumoname
# makeexe
# makemumo rootpath mumoname
# makeexe
# confnxhdb path alias pass
# makestddrive path
#===================== hfactory adapters ==========================
@@ -71,7 +71,7 @@ proc hmake {path priv type {len 1}} {
#--------------------------------------------------------------------
proc hmakescript {path readscript writescript type {len 1}} {
hfactory $path script $readscript $writescript $type $len
}
}
#-------------------------------------------------------------------
proc hlink {path obj {treename NONE} } {
if {[string equal $treename NONE]} {
@@ -133,7 +133,7 @@ proc property_elements_old {path indent} {
# foreach v [split $value ,] {
# lappend proplist "$prefix$prefix<value>$v</value>\n"
# }
lappend proplist "$prefix$prefix<value>$value</value>\n"
lappend proplist "$prefix$prefix<value>$value</value>\n"
lappend proplist "$prefix</property>\n"
}
if [info exists proplist] {return $proplist}
@@ -151,7 +151,7 @@ proc property_elements {path indent} {
continue
}
lappend proplist "$prefix<property id=\"$key\">\n"
lappend proplist "$prefix$prefix<value>$value</value>\n"
lappend proplist "$prefix$prefix<value>$value</value>\n"
lappend proplist "$prefix</property>\n"
}
if [info exists proplist] {return $proplist}
@@ -193,7 +193,7 @@ proc searchPathForDrivable {name} {
}
}
return NONE
}
}
#----------------------------------------------------------------
proc searchForCommand {name} {
return [string trim [hmatchprop / sicscommand $name]]
@@ -305,7 +305,7 @@ proc mgbatch {filename} {
gets $f line
close $f
if {[string first MOUNTAINBATCH $line] > 0} {
#--------- This is a mountaingum batch file which does not need
#--------- This is a mountaingum batch file which does not need
# to be massaged
return $filename
}
@@ -313,7 +313,7 @@ proc mgbatch {filename} {
set realfilename [file tail $filename]
set out [open $tmppath/$realfilename w]
puts $out \#MOUNTAINBATCH
while {[gets $f line] >= 0} {
while {[gets $f line] >= 0} {
append buffer $line
if {[info complete $buffer] == 1} {
translateCommand $buffer $out
@@ -377,7 +377,7 @@ proc hdbcollect {obj userobj np} {
#-----------------------------------------------------------------------------
proc gethdbscanvardata {no} {
set np [string trim [SplitReply [xxxscan np]]]
if {$np == 0} {
if {$np == 0} {
return ".0 .0 .0"
}
set status [catch {SplitReply [xxxscan getvardata $no]} txt]
@@ -390,7 +390,7 @@ proc gethdbscanvardata {no} {
#----------------------------------------------------------------------------
proc gethdbscancounts {} {
set np [string trim [SplitReply [xxxscan np]]]
if {$np == 0} {
if {$np == 0} {
return "0 0 0"
}
set status [catch {SplitReply [xxxscan getcounts]} txt]
@@ -398,7 +398,7 @@ proc gethdbscancounts {} {
return [join $txt]
} else {
return "0 0 0"
}
}
}
#================= helper to get the list of batch files =================
proc listbatchfiles {} {
@@ -460,7 +460,7 @@ proc hsearchprop {root prop val} {
#============ various utility routines =====================================
proc hdbReadOnly args {
error "Parameter is READ ONLY"
}
}
#---------------------------------------------------------------------------
proc makesampleenv {path} {
hfactory $path plain spy none
@@ -512,7 +512,7 @@ proc makestdscangraphics {path} {
hsetprop $path/scan_variable dim 0
hsetprop $path/scan_variable transfer zip
hsetprop $path/scan_variable priv internal
hfactory $path/scan_variable/name plain user text
hfactory $path/scan_variable/name plain user text
hfactory $path/counts script "gethdbscancounts" hdbReadOnly intvarar 1
hsetprop $path/counts type data
hsetprop $path/counts transfer zip
@@ -626,7 +626,7 @@ proc makeevproxy {rootpath hdbname devicename} {
hlink $rootpath p${devicename} $hdbname
hsetprop $rootpath/$hdbname sicsdev $devicename
hsetprop $rootpath/$hdbname type drivable
sicspoll add $rootpath/$hdbname hdb 30
sicspoll add $rootpath/$hdbname hdb 30
}
#================== multi motor stuff =======================
proc getNamposList {mumo} {
@@ -660,7 +660,7 @@ proc updateNamePosValues {rootpath} {
proc makemumopos {mumo rootpath name} {
$mumo pos $name
updateNamePosValues $rootpath
}
}
#-----------------------------------------------------------
proc dropmumo {mumo rootpath name} {
$mumo drop $name
@@ -676,11 +676,11 @@ proc getDropList {mumo} {
proc makemumo {rootpath mumoname} {
hfactory $rootpath/namedposition script "getNamPos $mumoname" \
$mumoname text
hsetprop $rootpath/namedposition priv user
hsetprop $rootpath/namedposition priv user
hfactory $rootpath/namedposition/values script \
"getNamposList $mumoname" hdbReadOnly text
hsetprop $rootpath/namedposition/values visible false
hupdate $rootpath/namedposition/values
hupdate $rootpath/namedposition/values
hfactory $rootpath/assignname2current command \
"makemumopos $mumoname $rootpath"
hsetprop $rootpath/assignname2current priv user
@@ -688,14 +688,14 @@ proc makemumo {rootpath mumoname} {
hfactory $rootpath/assignname2current/name plain user text
hset $rootpath/assignname2current/name "Undefined"
hfactory $rootpath/dropnamedposition command \
"dropmumo $mumoname $rootpath"
"dropmumo $mumoname $rootpath"
hsetprop $rootpath/dropnamedposition priv user
hsetprop $rootpath/dropnamedposition type command
hfactory $rootpath/dropnamedposition/name plain user text
hfactory $rootpath/dropnamedposition/name/values script \
"getDropList $mumoname" hdbReadOnly text
hsetprop $rootpath/dropnamedposition/name/values visible false
hupdate $rootpath/dropnamedposition/name/values
hupdate $rootpath/dropnamedposition/name/values
}
#-----------------------------------------------------------------
proc hdbbatchpath {pathstring} {
@@ -713,7 +713,7 @@ proc makeexe {} {
hfactory $path/batchpath script "exe batchpath" hdbbatchpath text
hsetprop $path/batchpath priv user
hfactory $path/execute command exe
hsetprop $path/execute type command
hsetprop $path/execute type command
hsetprop $path/execute priv user
hfactory $path/execute/file plain user text
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
@@ -753,13 +753,13 @@ proc hdbstorenexus args {
}
}
#===================== Syntactical sugar around hdbscan ===================
# center scan. A convenience scan for the one and only Daniel Clemens
# at TOPSI. Scans around a given center point. Requires the scan command
# center scan. A convenience scan for the one and only Daniel Clemens
# at TOPSI. Scans around a given center point. Requires the scan command
# for TOPSI to work.
#
# another convenience scan:
# sscan var1 start end var1 start end .... np preset
# scans var1, var2 from start to end with np steps and a preset of preset
# sscan var1 start end var1 start end .... np preset
# scans var1, var2 from start to end with np steps and a preset of preset
#
# Mark Koennecke, August 1997
#
@@ -771,7 +771,7 @@ proc cscan { var center delta np preset } {
if { [string compare $t DRIV] != 0 } {
ClientPut [format "ERROR: %s is NOT drivable!" $var]
return
}
}
set t [SICSType $center]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: %s is no number!" $center]
@@ -807,7 +807,7 @@ proc cscan { var center delta np preset } {
}
}
#---------------------------------------------------------------------------
proc sscan args {
proc sscan args {
scan clear
#------- check arguments: the last two must be preset and np!
set l [llength $args]
@@ -940,5 +940,5 @@ proc makestddrive {path} {
hsetprop $path priv user
hfactory $path/motor plain user text
hsetprop $path/motor argtype drivable
hfactory $path/value plain user float
hfactory $path/value plain user float
}

2
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/motorhp.tcl
View File

@@ -57,7 +57,7 @@ proc motorload {filename} {
#------------------------------------------------------------------------
proc loadmotordir {dirname} {
set l [glob $dirname/*.par]
foreach e $l {
foreach e $l {
set ret [catch {motorload $e} msg]
if { $ret != 0} {
clientput "ERROR: failed to load $e with $msg"

8
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/nxsupport.tcl
View File

@@ -10,7 +10,7 @@ proc makeFileName args {
set p [string trim [SplitReply [sicsdatapath]]]
set pre [string trim [SplitReply [sicsdataprefix]]]
set po [string trim [SplitReply [sicsdatapostfix]]]
return [format "%s%s%5.5d2003%s" $p $pre $num $po]
return [format "%s%s%5.5d2003%s" $p $pre $num $po]
}
#==========================================================================
# new version, attending to the new 1000 grouping logic
@@ -98,17 +98,17 @@ proc writeStandardAttributes {fileName} {
proc appendMotor {np motor alias} {
set val [SplitReply [$motor]]
__transfer putfloat 0 $val
nxscript putslab $alias [list $np] [list 1] __transfer
nxscript putslab $alias [list $np] [list 1] __transfer
}
#---------------------------------------------------------------------
proc appendFloat {np alias val} {
__transfer putfloat 0 $val
nxscript putslab $alias [list $np] [list 1] __transfer
nxscript putslab $alias [list $np] [list 1] __transfer
}
#---------------------------------------------------------------------
proc appendCount {np value alias} {
__transfer putint 0 $value
nxscript putslab $alias [list $np] [list 1] __transfer
nxscript putslab $alias [list $np] [list 1] __transfer
}
#--------------------------------------------------------------------
proc appendSampleEnv {np device alias} {

50
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/phytron.tcl
View File

@@ -1,24 +1,24 @@
#------------------------------------------------------------------
# This is driver for the combination Phytron MCC-2 Motor Controller
# and SICS using the scriptcontext asynchronous I/O system. The
# MCC-2 has a funny protocl as that messages are enclosed into
# <STX> data <ETX> sequences. This protocol is handled by the
# C-language phytron protocol handler. Per default, the MCC-2 is
# This is driver for the combination Phytron MCC-2 Motor Controller
# and SICS using the scriptcontext asynchronous I/O system. The
# MCC-2 has a funny protocl as that messages are enclosed into
# <STX> data <ETX> sequences. This protocol is handled by the
# C-language phytron protocol handler. Per default, the MCC-2 is
# configured to use 57600 baud. I have configured it to use 9600
# baud and it ought to remember this. The command to change this
# 0IC1S9600, the command to read this is 0IC1R.
# baud and it ought to remember this. The command to change this
# 0IC1S9600, the command to read this is 0IC1R.
#
# So, if this thing does not work on a serial port then the solution is
# So, if this thing does not work on a serial port then the solution is
# to set the terminal server to 57600 and try again. And set the baud rate
# or leave it.
#
# There are surely many ways to use the MCC-2. It supports two axes, X and Y.
# There are surely many ways to use the MCC-2. It supports two axes, X and Y.
# All examples below are given for X only. This driver uses it in
# this way:
#
# Nothing works properly without a reference run. The reference run is done
# this way:
#
# Nothing works properly without a reference run. The reference run is done
# in the following way:
# 1) Send it into the negative limit switch with 0X0-
# 1) Send it into the negative limit switch with 0X0-
# 2) Set the mechanical position with 0XP20Swert to the negative limit
# 3) Set the encoder position with 0XP22Swert to the negative limit
#
@@ -46,7 +46,7 @@
#
# - setting speed:
# writespeed - rcvwspeed - rcvspeed
#
#
# Mark Koennecke, June 2009
#
# Added code to switch a brake on for schneider_m2
@@ -54,10 +54,10 @@
# Mark Koennecke, September 2009
#
# Added code to support the speed parameter
#
#
# Mark Koennecke, December 2009
#
# Added more code to configure non encoder phytron motors which need to
# Added more code to configure non encoder phytron motors which need to
# read another parameter for position
#
# Mark Koennecke, January 2011
@@ -234,21 +234,21 @@ proc phytron::make {name axis controller lowlim upperlim {enc 1}} {
$name softlowerlim $lowlim
$name hardupperlim $upperlim
$name softupperlim $upperlim
hsetprop /sics/${name}/hardposition read phytron::readpos $axis $enc
hsetprop /sics/${name}/hardposition posrcv phytron::posrcv
hsetprop /sics/${name}/hardposition posrcv phytron::posrcv
$controller poll /sics/${name}/hardposition 60
hsetprop /sics/${name}/hardposition write phytron::setpos $axis $name
hsetprop /sics/${name}/hardposition setrcv phytron::setrcv $controller $name
$controller write /sics/${name}/hardposition
hsetprop /sics/${name}/status read phytron::sendstatus $axis
hsetprop /sics/${name}/status rcvstatus phytron::rcvstatus $axis $controller $enc
hsetprop /sics/${name}/status posrcv phytron::statpos $axis $name
hsetprop /sics/${name}/status statposlim phytron::statposlim $axis
hsetprop /sics/${name}/status statneglim phytron::statneglim $axis
hsetprop /sics/${name}/status statend phytron::statend $axis
hsetprop /sics/${name}/status statposlim phytron::statposlim $axis
hsetprop /sics/${name}/status statneglim phytron::statneglim $axis
hsetprop /sics/${name}/status statend phytron::statend $axis
$controller poll /sics/${name}/status 60
hfactory /sics/${name}/speed plain user float
@@ -269,9 +269,9 @@ proc phytron::make {name axis controller lowlim upperlim {enc 1}} {
hupdate /sics/${name}/status idle
$controller queue /sics/${name}/hardposition progress read
$controller queue /sics/${name}/speed progress read
}
}
#===============================================================================================
# At MORPHEUS there is a special table where one motor needs a brake. This requires a digital I/O
# At MORPHEUS there is a special table where one motor needs a brake. This requires a digital I/O
# to be disabled before driving and enabled after driving. The code below adds this feature to
# a phytron motor
#-----------------------------------------------------------------------------------------------
@@ -306,6 +306,6 @@ proc phytron::configureM2 {motor axis out} {
hsetprop $path/hardposition write phytron::openset $out
hsetprop $path/hardposition openans phytron::openans $axis $motor
hsetprop $path/status statend phytron::outsend $axis $out
hsetprop $path/status statend phytron::outsend $axis $out
hsetprop $path/status outend phytron::outend
}

26
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/pimotor.tcl
View File

@@ -1,6 +1,6 @@
#----------------------------------------------------
# This is a scriptcontext motor driver for the
# prehistoric Physik Instrumente DC-406, C-804 DC
# This is a scriptcontext motor driver for the
# prehistoric Physik Instrumente DC-406, C-804 DC
# motor controller.
#
# copyright: see file COPYRIGHT
@@ -13,9 +13,9 @@
# - writespeed - speedreply
# - writenull - speedreply
#
# Mark Koennecke, November 2009, after the
# Mark Koennecke, November 2009, after the
# C original from 1998
# Made to work, Mark Koennecke, January 2011
# Made to work, Mark Koennecke, January 2011
#-----------------------------------------------------
namespace eval pimotor {}
@@ -82,7 +82,7 @@ proc pimotor::statusreply {num} {
clientput "Value = $val, length = $len"
if {abs($val) > 0} {
sct update run
[sct controller] queue [sct] progress read
[sct controller] queue [sct] progress read
return idle
}
}
@@ -145,20 +145,20 @@ proc pimotor::makepimotor {name num sct lowlim upperlim} {
$name softlowerlim $lowlim
$name hardupperlim $upperlim
$name softupperlim $upperlim
hsetprop /sics/${name}/hardposition read pimotor::read $num
hsetprop /sics/${name}/hardposition readreply pimotor::readreply
hsetprop /sics/${name}/hardposition readreply pimotor::readreply
$sct poll /sics/${name}/hardposition 60
hsetprop /sics/${name}/hardposition write pimotor::write $num $name
hsetprop /sics/${name}/hardposition writereply pimotor::writereply $name
$sct write /sics/${name}/hardposition
hsetprop /sics/${name}/status read pimotor::sendstatus $num
hsetprop /sics/${name}/status statusreply pimotor::statusreply $num
hsetprop /sics/${name}/status statuspos pimotor::statuspos $name
$sct poll /sics/${name}/status 60
hfactory /sics/${name}/speed plain user int
hsetprop /sics/${name}/speed read pimotor::readspeed $num
hsetprop /sics/${name}/speed readreply pimotor::readreply
@@ -167,11 +167,11 @@ proc pimotor::makepimotor {name num sct lowlim upperlim} {
hsetprop /sics/${name}/speed write pimotor::writespeed $num
hsetprop /sics/${name}/speed speedreply pimotor::speedreply $num
$sct write /sics/${name}/speed
$name makescriptfunc halt "pimotor::halt $sct $num" user
$name makescriptfunc on "pimotor::writeon $sct $num" user
$name makescriptfunc home "pimotor::writenull $sct $num" user
hupdate /sics/${name}/status idle
$sct queue /sics/${name}/hardposition progress read
$sct queue /sics/${name}/hardposition progress read
}

12
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/secsim.tcl
View File

@@ -1,5 +1,5 @@
#---------------------------------------------------------------
# This is a second generation simulation motor.
# This is a second generation simulation motor.
#
# copyright: see file COPYRIGHT
#
@@ -39,7 +39,7 @@ proc simstatusget {motname} {
}
#-------------------------------------------------------------
proc simstatusfault {motname } {
clientput "ERROR: I am feeling faulty!"
clientput "ERROR: I am feeling faulty!"
return error
}
#--------------------------------------------------------------
@@ -53,11 +53,11 @@ proc MakeSecSim {name lower upper delay} {
hfactory /sics/$name/starttime plain user int
hset /sics/$name/delay $delay
hdel /sics/$name/hardposition
hfactory /sics/$name/hardposition script "simhardget $name" "simhardset $name" float
# hfactory /sics/$name/hardposition script "simhardfaultget $name" "simhardset $name" float
hfactory /sics/$name/hardposition script "simhardget $name" "simhardset $name" float
# hfactory /sics/$name/hardposition script "simhardfaultget $name" "simhardset $name" float
hdel /sics/$name/status
hfactory /sics/$name/status script "simstatusget $name" "hdbReadOnly b" text
# hfactory /sics/$name/status script "simstatusfault $name" "hdbReadOnly b" text
hfactory /sics/$name/status script "simstatusget $name" "hdbReadOnly b" text
# hfactory /sics/$name/status script "simstatusfault $name" "hdbReadOnly b" text
$name makescriptfunc halt "simhalt $name" user
hupdate /sics/$name/hardupperlim $upper
hupdate /sics/$name/softupperlim $upper

10
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/simhm.tcl
View File

@@ -1,13 +1,13 @@
#-----------------------------------------------------
# This is a simulation driver for the second
# generation histogram memory. It provides
# This is a simulation driver for the second
# generation histogram memory. It provides
# for a fill value which is used to initialize
# data.
# data.
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, January 2010
#-----------------------------------------------------
#-----------------------------------------------------
namespace eval simhm {}
#-----------------------------------------------------
proc simhm::getcontrol {name} {
@@ -74,7 +74,7 @@ proc simhm::MakeSimHM {name rank {tof NULL} } {
hfactory /sics/${name}/control script \
"simhm::getcontrol $name" "simhm::setcontrol $name" float
hsetprop /sics/${name}/control priv user
hdel /sics/${name}/status
hfactory /sics/${name}/status script \
"simhm::getstatus $name" hdbReadOnly text

12
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/sinqhttp.tcl
View File

@@ -1,6 +1,6 @@
#--------------------------------------------------------
# This is an asynchronous scriptcontext driven driver for
# the SINQ style http based histogram memory.
# This is an asynchronous scriptcontext driven driver for
# the SINQ style http based histogram memory.
#
# script chains:
# -- control
@@ -17,7 +17,7 @@
# You will need to override hmhttpevalstatus to implement
# an update of the detector data
#
# Mark Koennecke, April 2010
# Mark Koennecke, April 2010
#---------------------------------------------------------
proc hmhttpsend {url} {
sct send $url
@@ -83,7 +83,7 @@ proc hmhttpdatareply {} {
set status [catch {hmhttpreply} txt]
if {$status == 0} {
set path [file dirname [sct]]
hdelprop $path/data geterror
hdelprop $path/data geterror
}
return idle
}
@@ -107,13 +107,13 @@ proc hmhttpevalstatus {name} {
clientput $data
sct update error
return idle
}
}
hdelprop [sct] geterror
set lines [split $data \n]
foreach line $lines {
set ld [split $line :]
sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]]
}
}
set daq [sct DAQ]
set old [hval [sct]]
if {$daq == 1} {

16
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/stddrive.tcl
View File

@@ -1,13 +1,13 @@
#------------------------------------------------------
# This is some code for a standard drivable object in
# the scriptcontext system. It implements an empty
# object which throws errors when accessed. Users
# of such an object can override it to do
# something more acceptable. This object also
# provides for basic limit checking and status
# object which throws errors when accessed. Users
# of such an object can override it to do
# something more acceptable. This object also
# provides for basic limit checking and status
# checking. It can serve as a basis for creating
# new drivable objects, for instance environment
# control devices. A possible user has as the
# control devices. A possible user has as the
# first thing in a write script to set the target
# node to the desired value.
#
@@ -61,7 +61,7 @@ proc stddrive::deread {} {
proc stddrive::dewrite {name} {
# hset /sics/${name}/stop 1
error "$name is not configured, cannot drive"
}
}
#--------------------------------------------------------
proc stddrive::deconfigure {name} {
set allowed [list upperlimit lowerlimit tolerance stop]
@@ -89,12 +89,12 @@ proc stddrive::makestddrive {name sicsclass sct} {
hset /sics/${name}/lowerlimit 10
hfactory /sics/${name}/stop plain user int
hset /sics/${name}/stop 0
hsetprop /sics/${name} checklimits stddrive::stdcheck $name
hsetprop /sics/${name} checkstatus stddrive::stdstatus $name
hsetprop /sics/${name} halt stddrive::stop $name
deconfigure $name
$sct write /sics/${name}
$sct poll /sics/${name} 60
$sct poll /sics/${name} 60
hupdate /sics/${name} -9999.99
}

50
site_ansto/instrument/lyrebird/config/tasmad/sicscommon/table.tcl
View File

@@ -14,11 +14,11 @@ if { [info exists __tableheader] == 0 } {
}
#=====================================================================
# Csv tcl package version 2.0
# A tcl library to deal with CSV (comma separated value)
# A tcl library to deal with CSV (comma separated value)
# files, generated and readable by some DOS/Windows programs
# Contain two functions:
# csv2list string ?separator?
# and
# and
# list2csv list ?separator?
# which converts line from CSV file to list and vice versa.
#
@@ -52,9 +52,9 @@ proc csv2list {str {separator ","}} {
junk2 str]} {
if {[string length $quoted]||$unquoted=="\"\""} {
regsub -all {""} $quoted \" unquoted
}
}
lappend list $unquoted
}
}
if {[regexp $regexp2 $str junk unquoted quoted]} {
if {[string length $quoted]||$unquoted=="\"\""} {
regsub -all {""} $quoted \" unquoted
@@ -62,7 +62,7 @@ proc csv2list {str {separator ","}} {
lappend list $unquoted
if {[uplevel info exist csvtail]} {
uplevel set csvtail {""}
}
}
} else {
if {[uplevel info exist csvtail]} {
uplevel [list set csvtail $str]
@@ -72,18 +72,18 @@ proc csv2list {str {separator ","}} {
}
}
return $list
}
}
proc list2csv {list {separator ","}} {
set l {}
set l {}
foreach elem $list {
if {[string match {} $elem]||
[regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\
$elem]} {
lappend l $elem
lappend l $elem
} else {
regsub -all {"} $elem {""} selem
lappend l "\"$selem\""
lappend l "\"$selem\""
}
}
return [join $l $separator]
@@ -99,21 +99,21 @@ proc csvfile {f {separator ","}} {
} elseif {![string length $line]} {
lappend list {}
continue
}
}
set rec [csv2list $line $separator]
set buffer [concat $buffer $rec]
if {![ string length $csvtail]} {
lappend list $buffer
lappend list $buffer
set buffer {}
}
}
}
if {[string length $csvtail]} {
return -code error -errorcode {CSV 2 "Multiline parse error"}\
"CSV file parse error"
}
return $list
}
}
proc csvstring {str {separator ","}} {
set csvtail ""
set list {}
@@ -124,30 +124,30 @@ proc csvstring {str {separator ","}} {
} elseif {![string length $line]} {
lappend list {}
continue
}
}
set rec [csv2list $line $separator]
set buffer [concat $buffer $rec]
if {![ string length $csvtail]} {
lappend list $buffer
lappend list $buffer
set buffer {}
}
}
}
if {[string length $cvstail]} {
return -code error -errorcode {CSV 2 "Multiline parse error"}\
"CSV string parse error"
}
return $list
}
}
package provide Csv 2.1
#========================================================================
# The plan here is such: operations which happen fast or immediatly are
# done at once. Count commands or anything given as command is appended
# to a list for later execution. The idea is that this contains the
# The plan here is such: operations which happen fast or immediatly are
# done at once. Count commands or anything given as command is appended
# to a list for later execution. The idea is that this contains the
# actual measuring payload of the row.
# Drivables are immediatly started.
# After processing the rows, there is a success to wait for motors to arrive
# Then the commands for later execution are run. This frees the user of the
# Then the commands for later execution are run. This frees the user of the
# the necessity to have the count or whatever command as the last thing in the row
#--------------------------------------------------------------------------------
proc testinterrupt {} {
@@ -155,7 +155,7 @@ proc testinterrupt {} {
if {[string first continue $int] < 0} {
error "Interrupted"
}
}
}
#--------------------------------------------------------------------------------
proc processtablerow {line} {
global __tableheader
@@ -225,7 +225,7 @@ proc processtablerow {line} {
}
#------------------------------------------------------------------------
proc tableexe {tablefile} {
global __tableheader
global __tableheader
if {[string first NULL $__tableheader] < 0} {
error "Tableexe already running, terminated"
}
@@ -253,7 +253,7 @@ proc loop args {
clientput $args
if {[llength $args] < 2} {
error \
"Usage: loop <no> <sicscommand>\n\t<no> number of repetions\n\t<sicscommand> any SICS command"
"Usage: loop <no> <sicscommand>\n\t<no> number of repetions\n\t<sicscommand> any SICS command"
}
set len [lindex $args 0]
set command [lrange $args 1 end]

54
site_ansto/instrument/lyrebird/config/tasmad/taspub_sics/nxtas.tcl
View File

@@ -1,18 +1,18 @@
#-------------------------------------------------------------------------
# Functions for writing NeXus files for a triple axis spectrometer and
# Functions for writing NeXus files for a triple axis spectrometer and
# configuration of the internal scan object to support this.
#
# Mark Koennecke, May 2005
# reworked to new NeXus standards, Mark Koennecke, February 2007
#-----------------------------------------------------------------------
catch {sicsdatafactory new __transfer}
catch {sicsdatafactory new __transfer}
set __tasdata(out) ""
#----------------------------------------------------------------------
proc appendMotor {np motor alias} {
set val [tasSplit [$motor]]
if { [string length $val] > 0} {
__transfer putfloat 0 $val
nxscript putslab $alias [list $np] [list 1] __transfer
nxscript putslab $alias [list $np] [list 1] __transfer
} else {
clientput "WARNING: failed to read $motor"
}
@@ -33,22 +33,22 @@ proc appendIfPresent {np obj alias} {
proc appendFloat {np alias val} {
if {[string length $val] > 0} {
__transfer putfloat 0 $val
nxscript putslab $alias [list $np] [list 1] __transfer
nxscript putslab $alias [list $np] [list 1] __transfer
} else {
clientput "WARNING: failed to read $alias"
clientput "WARNING: failed to read $alias"
}
}
#-------------------------------------------------------------------
proc appendCount {np value alias} {
__transfer putint 0 $value
nxscript putslab $alias [list $np] [list 1] __transfer
nxscript putslab $alias [list $np] [list 1] __transfer
}
#--------------------------------------------------------------------
#--------------------------------------------------------------------
proc donothing {obj userobj} {
}
#---------------------------------------------------------------------
proc xmlprepare {obj userobj} {
global __tasdata
global __tasdata
#------- normal prepare
tasscan prepare $obj $userobj
@@ -92,24 +92,24 @@ proc xmlprepare {obj userobj} {
#--------------------------------------------------------------------
proc xmlwritepoint {obj userobj np} {
global __tasdata scripthome
nxscript reopen $__tasdata(file) $scripthome/tasub.dic
append line [format " %3d" $np]
set scanvars [split [tasSplit [iscan getscanvars]]]
foreach var $scanvars {
if { [string length $var] > 1} {
set val [tasSplit [eval $var]]
append line [format "%9.4f " [tasSplit [$var]]]
appendMotor $np $var sc_$var
append line [format "%9.4f " [tasSplit [$var]]]
appendMotor $np $var sc_$var
lappend storedvars $var
}
}
foreach var $__tasdata(out) {
append line [format "%9.4f " [tasSplit [eval $var]]]
appendMotor $np $var sc_$var
appendMotor $np $var sc_$var
lappend storedvars $var
}
@@ -118,12 +118,12 @@ proc xmlwritepoint {obj userobj np} {
append line [format "%8.2f " [tasSplit [counter gettime]]]
append line [format "%8d " [tasSplit [counter getcounts]]]
clientput $line
appendCount $np [tasSplit [counter getcounts]] counts
appendCount $np [tasSplit [counter getmonitor 1]] cter_01
appendCount $np [tasSplit [counter getcounts]] cter_02
appendFloat $np motime [tasSplit [counter gettime]]
appendFloat $np motime [tasSplit [counter gettime]]
set varlist [list qh qk ql qm en ei ef a1 a2 a3 a4 a5 a6 sgu sgl]
foreach var $varlist {
@@ -131,11 +131,11 @@ proc xmlwritepoint {obj userobj np} {
appendMotor $np $var sc_${var}
}
}
if {$np == 0} {
makeTASLinks
}
nxscript close
}
#====================== actual XML stuff ============================
@@ -144,7 +144,7 @@ proc writeUserData {} {
writeTextVar usaff affiliation
writeTextVar usadd address
writeTextVar usmail email
writeTextVar lonam local
writeTextVar lonam local
}
#-------------------------------------------------------------------
proc writeMonochromator {} {
@@ -249,19 +249,19 @@ proc makeScanLinks {} {
if {$testalias == 1} {
nxscript putattribute $alias axis 1
set axis 1
}
}
}
}
}
}
# if axis = 0 there is no alias; so we create something in here from the
# scan data in iscan
# if axis = 0 there is no alias; so we create something in here from the
# scan data in iscan
if {$axis == 0} {
set data [tasSplit [iscan getvardata 0]]
set count 0
foreach e $data {
set ar($count) [string trim $e]
incr count
}
}
nxscript putarray danascanvar ar [llength $data]
}
}
@@ -293,7 +293,7 @@ proc xmltaswrite {obj userobj} {
writeAnalyzer
writeDetector
writeDetector
nxscript close
@@ -326,7 +326,7 @@ proc xmlpowderwrite {obj userobj} {
writeAnalyzer
writeDetector
writeDetector
makePowderLinks

50
site_ansto/instrument/lyrebird/config/tasmad/taspub_sics/tasp.tcl
View File

@@ -7,7 +7,7 @@
# O P T I O N S
#--------------------------------------------------------------------------
# simMode
# - 0 real instrument
# - 0 real instrument
# - 1 development simulation
# - 2 simserver at instrument
#--------------------------------------------------------------------------
@@ -16,7 +16,7 @@ set simMode 1
set ts psts230.psi.ch
set mupad 0
#---------- Enable this for more startup debugging
#---------- Enable this for more startup debugging
protocol set all
#--------------- define home
@@ -40,7 +40,7 @@ ServerOption ReadTimeOut 10
ServerOption AcceptTimeOut 10
ServerOption ReadUserPasswdTimeout 500000
ServerOption ReadUserPasswdTimeout 500000
ServerOption LogFileBaseName $loghome/tasplog
@@ -70,7 +70,7 @@ SicsUser lnsmanager lnsSICSlns 1
SicsUser user 10lns1 2
SicsUser taspuser 10lns1 2
#---------------------------------------------------------------------------
# M O T O R S
# M O T O R S
if {$simMode == 0} {
@@ -95,7 +95,7 @@ Motor MCV el734hp mota 3 # Monochromator curvature vertical
Motor SRO el734hp mota 12 # Sample table second ring
Motor MTL el734hp mota 4 # Monochromator translation lower
Motor MTU el734hp mota 5 # Monochromator Translation upper
Motor MGL el734hp mota 7 # Monochromator lower goniometer
Motor MGL el734hp mota 7 # Monochromator lower goniometer
MakeRS232Controller motb $ts 3003
@@ -115,14 +115,14 @@ Motor STL el734hp motb 1 # Sample lower translation
Motor STU el734hp motb 2 # Sample upper translation
Motor ATL el734hp motb 7 # Analyzer lower translation
Motor ATU el734hp motb 8 # Analyzer upper translation
#Motor SGL SIM -17 17 -1 .0 # Monochromator upper goniometer
#Motor SGU SIM -17 17 -1 .0 # Monochromator upper goniometer
Motor SGL el734hp motb 3 # Sample lower goniometer
Motor SGU el734hp motb 4 # Sample upper goniometer
Motor AGL el734hp motb 11 # Analyzer lower goniometer
#Motor AGU SIM -30. 30. -.1 2. # Analyzer upper goniometer
#Motor MSC SIM -30. 30. -.1 2. # Monochromator changer
#Motor ASC SIM -30. 30. -.1 2. # Analyzer changer
#Motor SGL SIM -17 17 -1 .0 # Monochromator upper goniometer
#Motor SGU SIM -17 17 -1 .0 # Monochromator upper goniometer
Motor SGL el734hp motb 3 # Sample lower goniometer
Motor SGU el734hp motb 4 # Sample upper goniometer
Motor AGL el734hp motb 11 # Analyzer lower goniometer
#Motor AGU SIM -30. 30. -.1 2. # Analyzer upper goniometer
#Motor MSC SIM -30. 30. -.1 2. # Monochromator changer
#Motor ASC SIM -30. 30. -.1 2. # Analyzer changer
#Motor CSC SIM -30. 30. -.1 2. # Collimator changer
mcv precision .1
} else {
@@ -141,10 +141,10 @@ Motor SGL sim -19 19 -1. 0 # Sample lower translation
Motor SGU SIM -30. 30. -.1 2. # Sample upper translation
Motor ATL sim -17 17 -.1 .1 # Analyzer lower translation
Motor ATU sim -17 17 -.1 .1 # Analyzer upper translation
Motor MGL sim -10 10 -.1 .1 # Monochromator lower goniometer
Motor SGL sim -16 16 -.1 .1 # Sample lower goniometer
Motor SGU sim -16 16 -.1 .1 # Sample upper goniometer
Motor AGL sim -10 10 -.1 .1 # Analyzer lower goniometer
Motor MGL sim -10 10 -.1 .1 # Monochromator lower goniometer
Motor SGL sim -16 16 -.1 .1 # Sample lower goniometer
Motor SGU sim -16 16 -.1 .1 # Sample upper goniometer
Motor AGL sim -10 10 -.1 .1 # Analyzer lower goniometer
#--------------------------------------------------------------------------
# C U R R E N T S
@@ -180,7 +180,7 @@ MakeCounter counter sim -1.
#--------------------------------------------------------------------------
VarMake instrument Text Mugger
instrument TASPUB
instrument lock
instrument lock
VarMake title Text User
VarMake user Text User
@@ -203,12 +203,12 @@ source $scripthome/stddrive.tcl
source $scripthome/slsecho.tcl
if {$simMode == 0} {
makesctcontroller slssct slsecho taspmagnet:5001
slsecho::makeslsecho i1 0 slssct
slsecho::makeslsecho i2 1 slssct
slsecho::makeslsecho i3 2 slssct
slsecho::makeslsecho i4 3 slssct
slsecho::makeslsecho i5 4 slssct
slsecho::makeslsecho i6 5 slssct
slsecho::makeslsecho i1 0 slssct
slsecho::makeslsecho i2 1 slssct
slsecho::makeslsecho i3 2 slssct
slsecho::makeslsecho i4 3 slssct
slsecho::makeslsecho i5 4 slssct
slsecho::makeslsecho i6 5 slssct
}
}
@@ -255,7 +255,7 @@ MakeTasUB tasub
MakeScanCommand iscan counter tas.hdd recover.bin
MakePeakCenter iscan
MakeTasScan iscan tasub
#-------------------------- new exe manager
#-------------------------- new exe manager
definealias do exe
alias batchroot exe batchpath
#-------------------------- normal drive command

4
site_ansto/instrument/lyrebird/config/tasmad/taspub_sics/taspubcom.tcl
View File

@@ -1,6 +1,6 @@
#---------------------------------------------------------------------------
# The triple axis people love to have the command set emulate the command
# set of TASMAD as closely as possible. This is implemented through
# The triple axis people love to have the command set emulate the command
# set of TASMAD as closely as possible. This is implemented through
# some scripting. This version is for the new syntax to be used with the
# new UB matrix calculaus for triple axis.
#

158
site_ansto/instrument/lyrebird/config/tasmad/taspub_sics/tasscript.tcl
View File

@@ -1,18 +1,18 @@
#-----------------------------------------------------------------------------
# This file contains all the scripted commands to make a SICS-TAS look
# almost like a MAD-TAS.
# almost like a MAD-TAS.
#
# This version is special to RITA-2!!
#
# Mark Koennecke, September 2005
#
# The specialities for RITA have been separated and this is controlled
# by testing the instrument name. This way I can use the same version for
# The specialities for RITA have been separated and this is controlled
# by testing the instrument name. This way I can use the same version for
# TASP, RITA-2 and EIGER
#
#
# Mark Koennecke, November 2010
#------------------------------------------------------------------------
# quite often we need to split a SICS answer of the form x = y and
# quite often we need to split a SICS answer of the form x = y and
# extract the y. This is done here.
#-----------------------------------------------------------------------
proc tasSplit {text} {
@@ -152,7 +152,7 @@ if { [info exists tasubinit] == 0 } {
}
#------------------------------------------------------------------------
# TASMAD relies on the order of variables in memory in order to interpret
# scan or drive commands. In the new syntax motor order is only preserved
# scan or drive commands. In the new syntax motor order is only preserved
# for the QE motors, not for real motors. This list configures the order.
#------------------------------------------------------------------------
set tasOrderList [list qh qk ql en]
@@ -166,7 +166,7 @@ for {set i 0} {$i < [llength $tasmot]} { incr i } {
set tasmap(l$mot) [format "%s softlowerlim " $mot]
set tasmap(z$mot) [format "madZero %s " $mot]
set tasmap(u$mot) [format "%s softupperlim " $mot]
}
}
set tasmap(ss) "scatSense ss "
set tasmap(sa) "scatSense sa "
set tasmap(sm) "scatSense sm "
@@ -186,7 +186,7 @@ for {set i 0} { $i < 8} { incr i} {
# clientput [format " %s = %s" $e $tasmap($e)]
#}
#----------------------------------------------------------------------
# put an angle into 360
# put an angle into 360
proc circlify {val} {
set p $val
while {$p > 360.0} {
@@ -207,12 +207,12 @@ proc madZero args {
set length [llength $args]
if { $length < 1} {
error "ERROR: expected at least motor name as a parameter to madZero"
}
}
set mot [lindex $args 0]
if {$length == 1 } {
#inquiry case
set zero [tasSplit [$mot softzero]]
return [format "madZero = %f " [expr -$zero]]
return [format "madZero = %f " [expr -$zero]]
} else {
# a new value has been given.
set val [lindex $args 1]
@@ -225,14 +225,14 @@ proc madZero args {
$mot softupperlim [circlify [expr $high - $displacement]]
$mot softlowerlim [circlify [expr $low - $displacement]]
}
}
}
#--------------------------------------------------------------------------
# This routine throws an error if a bad value for fx is given
#--------------------------------------------------------------------------
proc fxi { {val UNKNOWN} } {
if {[string compare $val UNKNOWN] ==0} {
return [format " fx = %2s " [tasSplit [tasub const]] ]
}
}
return [tasub const $val]
}
#-------------------------------------------------------------------------
@@ -258,17 +258,17 @@ proc scatSense {par {val -1000} } {
error "ERROR: unknown scattering sense $par"
}
}
#-------- inquiry case
#-------- inquiry case
if { $val == -1000 } {
switch $par {
sm {
return [format "sm = %d" [tasSplit [tasub mono ss]]]
return [format "sm = %d" [tasSplit [tasub mono ss]]]
}
ss {
return [format "ss = %d" [tasSplit [tasub ss]]]
return [format "ss = %d" [tasSplit [tasub ss]]]
}
sa {
return [format "sa = %d" [tasSplit [tasub ana ss]]]
return [format "sa = %d" [tasSplit [tasub ana ss]]]
}
default {
error "Unknown scattering sense requested"
@@ -325,9 +325,9 @@ proc scatSense {par {val -1000} } {
madZero $mot $newzero
$mot softupperlim $newupper
$mot softlowerlim $newlower
}
}
}
}
}
}
#-------------------------------------------------------------------------
# The output command
#-------------------------------------------------------------------------
@@ -350,11 +350,11 @@ proc ou args {
# typeATokenizer extracts tokens from a command string. Tokens can be
# either variable names or - indicating a series of variables.
# Returns the token value or END if the end of the string text is
# reached. Uses and updates a variable pos which indicates the current
# reached. Uses and updates a variable pos which indicates the current
# position in the string.
#---------------------------------------------------------------------------
proc typeATokenizer {text pos} {
upvar pos p
upvar pos p
set l [string length $text]
#------- check for end
if {$p >= $l} {
@@ -408,7 +408,7 @@ proc cl args {
}
}
return
}
}
#------ trying to clear individual fixed motors
set command [join $args]
set command [string tolower $command]
@@ -438,10 +438,10 @@ proc cl args {
error [format "ERROR: %s is no motor" $e]
} else {
clientput [format "%s unfixed" $e]
}
}
if {[string compare $e $stop] == 0 } {
break
}
}
}
} else {
#------ should be a single motor here
@@ -451,7 +451,7 @@ proc cl args {
error [format "ERROR: %s is no motor" $token]
} else {
clientput [format "%s unfixed" $token]
}
}
}
#------- do not forget to proceed
set token [typeATokenizer $command $pos]
@@ -478,7 +478,7 @@ proc fi args {
}
}
return
}
}
#------ parse motors to fix
set command [join $args]
set command [string tolower $command]
@@ -508,10 +508,10 @@ proc fi args {
error [format "ERROR: %s is no motor" $e]
} else {
clientput [format "%s fixed" $e]
}
}
if {[string compare $e $stop] == 0 } {
break
}
}
}
} else {
#------ should be a single motor here
@@ -521,7 +521,7 @@ proc fi args {
error [format "ERROR: %s is no motor" $token]
} else {
clientput [format "%s fixed" $token]
}
}
}
#------- do not forget to proceed
set token [typeATokenizer $command $pos]
@@ -532,7 +532,7 @@ proc fi args {
# handles pos as in type A syntax above.
#--------------------------------------------------------------------------
proc varToken {text pos} {
upvar pos p
upvar pos p
set l [string length $text]
#------- check for end
if {$p >= $l} {
@@ -565,7 +565,7 @@ proc varToken {text pos} {
# varSet parses a string containing MAD variable statements and sets the
# variables. Thereby it has to take care of mappings and special variables
# which have to be set by special functions. The only format allowed here
# are name value pairs.
# are name value pairs.
#--------------------------------------------------------------------------
proc varSet { command } {
global tasmap
@@ -580,7 +580,7 @@ proc varSet { command } {
[string compare $token local] == 0 } {
eval $command
return
}
}
if { [string compare $token out] == 0 || \
[string compare $token ou] == 0 } {
append txt $token " " [string range $command $pos end]
@@ -597,37 +597,37 @@ proc varSet { command } {
if { [info exists tasmap($token)] == 1} {
set ret [catch {eval $tasmap($token) $value} msg]
if { $ret != 0} {
error [format "ERROR: > %s < while setting %s" $msg $token]
error [format "ERROR: > %s < while setting %s" $msg $token]
} else {
clientput [format " %s = %s" $token $value]
}
} else {
} else {
set ret [catch {eval $token $value} msg]
if { $ret != 0 } {
error [format "ERROR: error %s while setting %s" $msg $token]
error [format "ERROR: error %s while setting %s" $msg $token]
} else {
clientput [format " %s = %s" $token $value]
}
}
}
set token [varToken $command $pos]
set value [varToken $command $pos]
}
catch {tasub update} msg
}
#--------------------------------------------------------------------------
# co for count is the funny MAD count procedure. Please note, that the
# co for count is the funny MAD count procedure. Please note, that the
# count mode is automatically set through the last MN or TI variable.
#--------------------------------------------------------------------------
proc coritacount {mode preset nloop} {
set rmode [ritamode]
set rmode [ritamode]
hm countmode $mode
hm preset $preset
for { set i 0} {$i < $nloop} {incr i} {
set ret [catch {eval hm countblock} msg]
set ret [catch {eval hm countblock} msg]
if {$ret != 0} {
error $msg
}
#----- format output
#----- format output
set cts [tasSplit [hm sum 0 127 0 127]]
set m1 [tasSplit [counter getmonitor 1]]
set m2 [tasSplit [counter getmonitor 2]]
@@ -642,18 +642,18 @@ proc coritacount {mode preset nloop} {
append txt [format " %s = %d" $win [sumPSDWindow $i]]
}
clientput $txt
}
}
}
}
#------------------------------------------------------------------------
proc conormalcount {mode preset nloop} {
counter setmode $mode
for { set i 0} {$i < $nloop} {incr i} {
set ret [catch {eval counter count $preset } msg]
set ret [catch {eval counter count $preset } msg]
if {$ret != 0} {
error $msg
}
#----- format output
#----- format output
set cts [tasSplit [counter getcounts]]
set m1 [tasSplit [counter getmonitor 1]]
set m2 [tasSplit [counter getmonitor 2]]
@@ -664,7 +664,7 @@ proc conormalcount {mode preset nloop} {
" Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d, Time = %8.2f" \
$cts $m1 $m2 $m3 $time]
}
}
}
#-------------------------------------------------------------------------
proc co args {
global ritaspecial
@@ -712,17 +712,17 @@ proc co args {
#----------------------------------------------------------------------------
proc fm args {
#------ do the scan first
append com "sc " [ join $args]
append com "sc " [ join $args]
set ret [catch {eval $com} msg]
if { $ret != 0 } {
error $msg
}
}
# iscan simscan 15 .3 1000
#----- calculate the center
set ret [catch {eval peak value} msg]
if { $ret != 0 } {
error $msg
}
}
if { [string first "WARN" $msg ] >= 0 } {
error [format "ERROR: failed to find peak: %s" $msg]
}
@@ -737,7 +737,7 @@ proc fm args {
set ret [catch {eval dr $var $val} msg]
if { $ret != 0 } {
error $msg
}
}
}
#------------------------------------------------------------------------
# fz does almost the same as fm, but also sets the current position to be
@@ -745,17 +745,17 @@ proc fm args {
#------------------------------------------------------------------------
proc fz args {
#------ do the scan first
append com "sc " [ join $args]
append com "sc " [ join $args]
set ret [catch {eval $com} msg]
if { $ret != 0 } {
error $msg
}
}
iscan simscan 15 .3 1000
#----- calculate the center
set ret [catch {eval peak value} msg]
if { $ret != 0 } {
error $msg
}
}
if { [string first "WARN" $msg ] >= 0 } {
error [format "ERROR: failed to find peak: %s" $msg]
}
@@ -770,7 +770,7 @@ proc fz args {
set ret [catch {eval dr $var $val} msg]
if { $ret != 0 } {
error $msg
}
}
#------- now do zero point
set temp [eval $var hardposition]
set newZero [tasSplit $temp]
@@ -785,16 +785,16 @@ proc pr args {
set line [join $args]
set line [string tolower $line]
set pos 0
set token [varToken $line $pos]
set token [varToken $line $pos]
while { [string compare $token -end] } {
#-------- check for mapped values first
if { [info exists tasmap($token)] == 1 } {
set val [tasSplit [eval $tasmap($token)]]
clientput [format " %s = %s" $token $val]
clientput [format " %s = %s" $token $val]
} else {
#------ simple variables go here
set val [tasSplit [$token] ]
clientput [format " %s = %s" $token $val]
clientput [format " %s = %s" $token $val]
}
set token [varToken $line $pos]
}
@@ -858,7 +858,7 @@ proc lz args {
incr count
if { $count == 6 } {
append outPut " \n"
}
}
}
return $outPut
}
@@ -962,7 +962,7 @@ proc le args {
append output [format "POSN: %s" $val]
append output [format "TARG: %s" $val2]
return $output
return $output
}
#-----------------------------------------------------------------------
# fmtMot formats a motors parameters in order to fit the format for
@@ -980,7 +980,7 @@ proc fmtMot mot {
set txt [format "%-7s%1s %7.2f %7.2f %7.2f" $mot $fix $pos $target \
$zero]
return $txt
}
}
#-------------------------------------------------------------------------
# lt --> list targets
#-------------------------------------------------------------------------
@@ -1011,7 +1011,7 @@ proc lt args {
[fmtMot MTL] " " ]
append output [format "%s | %s\n" \
[fmtMot MTU] " " ]
return $output
return $output
}
#--------------------------------------------------------------------
# li --> list everything
@@ -1044,9 +1044,9 @@ proc log args {
if { [ llength $args] == 0 } {
if { [string compare $madlog disabled] == 0 } {
return "Logging is disabled"
} else {
} else {
return [format "Logging to %s" $madlog]
}
}
}
#------args, action according to keyword
set key [string tolower [lindex $args 0]]
@@ -1070,7 +1070,7 @@ proc log args {
append output "\tLog close : stop logging\n"
return $output
}
}
}
}
#--------------------------------------------------------------------------
@@ -1080,7 +1080,7 @@ proc sz args {
global tasmot
set usage "\n Usage: \n\t sz motor newval \n"
set line [string tolower [join $args]]
set pos 0
set pos 0
set mot [varToken $line $pos]
set val [varToken $line $pos]
if { [lsearch $tasmot $mot] < 0 } {
@@ -1091,7 +1091,7 @@ proc sz args {
}
#-------- output, output, output.........
append output [format "Values : Lo(hard) Lo(soft) Posn%s" \
" Target Hi(soft) Hi(hard) Zero\n"]
" Target Hi(soft) Hi(hard) Zero\n"]
set zero [tasSplit [madZero $mot]]
set loh [tasSplit [eval $mot hardlowerlim]]
set loh [expr $loh + $zero]
@@ -1134,7 +1134,7 @@ proc pa args {
set fil $fil.pal
}
polfile $fil
}
}
#--------------------------------------------------------------------------
# on and off for switching spin flippers
#-------------------------------------------------------------------------
@@ -1148,7 +1148,7 @@ proc checkarg args {
return $flipper
} else {
error [format "%s not a recognized flipper" $flipper]
}
}
}
#------------------------------------------------------------------------
proc on args {
@@ -1198,7 +1198,7 @@ proc syncdrive {mot pos} {
}
}
#--------------------------------------------------------------------------
# "set posttion" sp to reset the zero-position.
# "set posttion" sp to reset the zero-position.
# syntax: "SP <axes> <value>" to set the softzero value of <axes>
# in a way that the targetposition is set to <value>.
# J. Stahn, 10. 2001
@@ -1255,7 +1255,7 @@ proc scan {name} {
info {
set scanvar [findscanvar]
append result [tasSplit [iscan np]] ",1," $scanvar
append result ,
append result ,
append result [string trim [tasSplit [iscan getfile]]]
return $result
}
@@ -1291,7 +1291,7 @@ proc dr args {
error "ERROR: do not know what to drive to $token"
}
} else {
set lastVar $token
set lastVar $token
lappend motors $lastVar
}
set token [varToken $command $pos]
@@ -1340,7 +1340,7 @@ proc sc args {
set lastVar quarkPhaser
set pos 0
set state 0
# states:
# states:
# 0 = expectToken, 1 = expectPosition, 2 = continuePosition
# 3 = expectIncrement, 4 = continueIncrement
@@ -1423,7 +1423,7 @@ proc sc args {
error "ERROR: nothing to scan"
}
set __tasdata(qe) 0
set qeVars [list qh qk ql ei ef en qm ki kf]
set qeVars [list qh qk ql ei ef en qm ki kf]
foreach var $scanvars {
if {[lsearch -exact $qeVars [string tolower $var]] >= 0} {
set __tasdata(qe) 1
@@ -1445,7 +1445,7 @@ proc sc args {
set start [expr $scanpos($var) - $inc($var) * ($np - 1)/2.]
iscan add $var $start $inc($var)
}
return [iscan run $np $mode $preset]
return [iscan run $np $mode $preset]
}
#---------------------------------------------------------------------
proc cell args {
@@ -1454,7 +1454,7 @@ proc cell args {
#--------------------------------------------------------------------
proc ref args {
if { [llength $args] == 0} {
return [tasub listref]
return [tasub listref]
}
set key [string trim [lindex $args 0]]
if { [string compare $key clear] == 0} {
@@ -1470,13 +1470,13 @@ proc ref args {
} elseif {[string compare $key aux] == 0} {
set qpos [lrange $args 1 end]
append cmd "tasub addauxref " [join $qpos]
return [eval $cmd]
return [eval $cmd]
} else {
return [eval tasub addref $args]
}
}
#--------------------------------------------------------------------
proc makeub args {
proc makeub args {
if { [llength $args] >= 2} {
tasub makeub [lindex $args 0] [lindex $args 1]
return OK
@@ -1485,7 +1485,7 @@ proc makeub args {
}
}
#--------------------------------------------------------------------
proc makeauxub {qh qk ql} {
proc makeauxub {qh qk ql} {
tasub makeauxub $qh $qk $ql
}
#-------------------------------------------------------------------
@@ -1493,18 +1493,18 @@ proc addauxref {qh qk ql} {
tasub addauxref $qh $qk $ql
}
#--------------------------------------------------------------------
proc makeubfromcell args {
proc makeubfromcell args {
return [tasub makeubfromcell]
}
#---------------------------------------------------------------------
proc listub args {
proc listub args {
append output [tasSplit [tasub cell]]
append output "\n"
append output [tasub listub]
append output [tasub listref]
return $output
}
#----------------------------------------------------------------------
#----------------------------------------------------------------------
proc sf args {
tasscan fast 1
set ret [catch {eval sc $args} msg]