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

4
site_ansto/instrument/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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/tas/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]