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

add Pelican

Browse Source 
r3112 | jgn | 2011-04-20 12:44:37 +1000 (Wed, 20 Apr 2011) | 1 line
This commit is contained in:
Jing Chen
2011-04-20 12:44:37 +10:00
committed by Douglas Clowes
parent baf6961a82
commit 506a265815
35 changed files with 0 additions and 8897 deletions
Download Patch File Download Diff File Expand all files Collapse all files

79
site_ansto/instrument/pelican/config/commands/commands.tcl
View File

@@ -7,85 +7,6 @@ namespace eval motor {
variable is_homing_list "" variable is_homing_list ""
} }
#namespace eval sample {
# command select {int=0:8 sampid} {
# SampleNum $sampid
# }
#}
#namespace eval beamstops {
# command selbsn {int=1,2,3,4,5,6 bs} {
# selbs $bs "UNDEF" "UNDEF"
# }
# command selbsxz {int=1,2,3,4,5,6 bs float bx float bz} {
# selbs $bs $bx $bz
# }
#}
#namespace eval optics {
# VarMake ::optics::select::section text user
# VarMake ::optics::polarizer::in text user
# VarMake ::optics::lens::selection text user
# command rotary_attenuator {int=0,15,45,90,180 angle} {
# drive att $angle
# }
# command entrance_aperture {
# int=0,45,90,135,180,270 angle
# } {
# drive srce $angle
# }
# TODO Do we need this
# command sample_aperture {
# int=25,50 size
# text=circ,squ,open,rect shape
# } {
# SApXmm $size
# SApZmm $size
# SApShape $shape
# }
##############################
##
# @brief The "guide" command uses a lookup table to setup the collimation system
# @param row, selects a row from the guide configuration table
#
# eg\n
# guide ga
# command guide "
# text=[join [array names ::optics::guide_configuration] , ] configuration
# " {
#
# variable guide_configuration
# variable guide_configuration_columns
#
# if [ catch {
#
# foreach {compselection position} $guide_configuration($configuration) {
# foreach el $compselection guide $guide_configuration_columns {
# lappend to_config $guide
# lappend to_config [set ::optics::${guide}_map($el)]
# }
# ::optics::guide -set feedback status BUSY
# set msg [eval "drive $to_config"]
# EApPosY $position
# }
# GuideConfig $configuration
# } message ] {
# ::optics::guide -set feedback status IDLE
# if {$::errorCode=="NONE"} {return $message}
# return -code error $message
# }
# ::optics::guide -set feedback status IDLE
# }
# ::optics::guide -addfb text status
# ::optics::guide -set feedback status IDLE
#}
proc ::commands::isc_initialize {} { proc ::commands::isc_initialize {} {
::commands::ic_initialize ::commands::ic_initialize
} }

3
site_ansto/instrument/pelican/config/hmm/hmm_configuration.tcl
View File

@@ -10,9 +10,6 @@ proc ::histogram_memory::init_OAT_TABLE {} {
proc ::histogram_memory::pre_count {} {} proc ::histogram_memory::pre_count {} {}
proc ::histogram_memory::post_count {} {} proc ::histogram_memory::post_count {} {}
proc ::histogram_memory::isc_initialize {} { proc ::histogram_memory::isc_initialize {} {
# Instrument specific X and Y dimension names
#variable INST_NXC "oat_nxc_eff"
#variable INST_NYC "oat_nyc_eff"
if [ catch { if [ catch {
::histogram_memory::init_hmm_objs ::histogram_memory::init_hmm_objs

77
site_ansto/instrument/pelican/config/tasmad/sicscommon/ASCIIplot.tcl
View File

@@ -1,77 +0,0 @@
proc AsciiPlot_findScale {ydatalist scale baseline} {
upvar $scale sc
upvar $baseline bl
set min +99999999.99
set max -99999999.99
foreach yval $ydatalist {
if {$yval > $max} {
set max $yval
}
if {$yval < $min} {
set min $yval
}
}
set sc [expr 61./($max-$min)]
set bl [expr int(-$min*$sc+1.)]
}
proc AsciiPlot_clearLine {line} {
upvar $line Zeile
for {set i 0} {$i < 64} {incr i} {
set Zeile($i) " "
}
set Zeile(64) "\n"
}
proc AsciiPlot_printLine {xtxt line} {
upvar $line Zeile
set txtline ""
set txtline "$txtline$xtxt"
for {set i 0} {$i <= 64} {incr i} {
set txtline "$txtline$Zeile($i)"
}
ClientPut $txtline
}
proc AsciiPlot_list {xdata ydata} {
AsciiPlot_findScale $ydata scale baseValue
set xty 0
set avgy 0
foreach xval $xdata yval $ydata {
set xty [expr $xty+$xval*$yval]
set avgy [expr $avgy+$yval]
AsciiPlot_clearLine line
set line(0) "!"
set height [expr int($yval*$scale+$baseValue)]
if {$height >= 1} {
if {$height < 69} {
set line($height) "*"
} else {
set line(68) "*"
}
}
AsciiPlot_printLine [format %+#1.3e $xval] line
}
ClientPut "\ncenter of gravity = [expr 1.*$xty/$avgy]\n"
}
proc AsciiPlot_xydata2list {xydatalist xdata ydata} {
upvar $xdata xd
upvar $ydata yd
set xd {}
set yd {}
set xydl [$xydatalist list]
foreach {x y} $xydl {
lappend xd $x
lappend yd $y
}
}
proc AsciiPlot {data} {
AsciiPlot_xydata2list $data xdata ydata
AsciiPlot_list $xdata $ydata
}
Publish AsciiPlot Spy
alias asciiplot AsciiPlot

112
site_ansto/instrument/pelican/config/tasmad/sicscommon/andorhm.tcl
View File

@@ -1,112 +0,0 @@
#--------------------------------------------------------------
# This is the initialisation code for the ANDOR iKon-M
# 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
#--------------------------------------------------------------
#source $scripthome/ccdwww.tcl
#---------------------------------------------------------------
set ccdwww::initnodes [list daqmode camerano accucycle accucounts \
triggermode temperature imagepar shutterlevel \
shuttermode openingtime closingtime flip rotate \
hspeed vspeed vamp]
#--------------------------------------------------------------
proc writecooler {} {
set target [sct target]
set status [ccdwww::httpsend "/ccd/cooling?status=$target"]
andisct queue /sics/andi/cooler read read
andisct queue /sics/andi/temperature read read
}
#--------------------------------------------------------------
proc readcooler {} {
sct send "/ccd/iscooling"
return coolerreply
}
#---------------------------------------------------------------
proc coolerreply {} {
set reply [sct result]
set status [catch {ccdwww::httptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
} else {
catch {hdelprop [sct] geterror}
if {$data == 0} {
sct update off
} else {
sct update on
}
}
return idle
}
#---------------------------------------------------------
proc readtemp {} {
ccdwww::httpsend "/ccd/temperature"
return tempreply
}
#--------------------------------------------------------
proc tempreply {} {
set reply [sct result]
set status [catch {ccdwww::httptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
} else {
catch {hdelprop [sct] geterror}
sct update $data
}
return idle
}
#-------------------------------------------------------------
proc MakeAndorHM {name host } {
ccdwww::MakeCCDWWW $name $host "ccdwww::initscript $name"
hfactory /sics/$name/daqmode plain mugger text
hset /sics/$name/daqmode single
hfactory /sics/$name/camerano plain mugger int
hset /sics/$name/camerano 0
hfactory /sics/$name/accucycle plain mugger int
hset /sics/$name/accucycle 20
hfactory /sics/$name/accucounts plain mugger int
hset /sics/$name/accucounts 5
hfactory /sics/$name/triggermode plain mugger int
hset /sics/$name/triggermode 0
hfactory /sics/$name/temperature plain mugger int
hset /sics/$name/temperature -30
hfactory /sics/$name/imagepar plain mugger intar 6
hset /sics/$name/imagepar 1 1 1 1024 1 1024
hfactory /sics/$name/shutterlevel plain mugger int
hset /sics/$name/shutterlevel 0
hfactory /sics/$name/shuttermode plain mugger int
hset /sics/$name/shuttermode 0
hfactory /sics/$name/openingtime plain mugger int
hset /sics/$name/openingtime 20
hfactory /sics/$name/closingtime plain mugger int
hset /sics/$name/closingtime 20
hfactory /sics/$name/flip plain mugger intar 2
hset /sics/$name/flip 0 1
hfactory /sics/$name/rotate plain mugger int
hset /sics/$name/rotate 0
hfactory /sics/$name/hspeed plain mugger int
hset /sics/$name/hspeed 2
hfactory /sics/$name/vspeed plain mugger int
hset /sics/$name/vspeed 0
hfactory /sics/$name/vamp plain mugger int
hset /sics/$name/vamp 1
hfactory /sics/$name/cooler plain mugger text
hset /sics/$name/cooler off
hsetprop /sics/$name/cooler write writecooler
hsetprop /sics/$name/cooler httpreply ccdwww::httpreply
hsetprop /sics/$name/cooler read readcooler
hsetprop /sics/$name/cooler coolerreply coolerreply
${name}sct write /sics/$name/cooler
${name}sct poll /sics/$name/cooler 30
hfactory /sics/$name/sensor_temperature plain mugger float
hsetprop /sics/$name/sensor_temperature read readtemp
hsetprop /sics/$name/sensor_temperature tempreply tempreply
${name}sct poll /sics/$name/sensor_temperature 30
$name dim 1024 1024
$name init
}

524
site_ansto/instrument/pelican/config/tasmad/sicscommon/astrium.tcl
View File

@@ -1,524 +0,0 @@
#--------------------------------------------------------------
# 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
# and the address of the chopper on the network.
#
# copyright: see file COPYRIGHT
#
# SCRIPT CHAINS:
# - reading parameters:
# astchopread - readastriumchopperpar - readastriumchopperpar - ...
# - writing
# astchopwrite - astchopwritereply
#
# Another remark:
# 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
# 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
# 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
# the chopper differs in little ways between instances.
#
# Mark Koennecke, April 2009
#--------------------------------------------------------------
MakeSICSObj choco AstriumChopper
#-------------------------------------------------------------
proc astriumchopperputerror {txt} {
global choppers chopperparlist
foreach chopper $choppers {
foreach par $chopperparlist {
set path /sics/choco/${chopper}/${par}
hsetprop $path geterror $txt
}
}
}
#--------------------------------------------------------------
# Paramamters look like: name value, entries for parameters are
# separated by ;
#---------------------------------------------------------------
proc astriumsplitreply {chopper reply} {
set parlist [split [string trim $reply] ";"]
foreach par $parlist {
catch {stscan $par "%s %s" token val} count
if {[string first ERROR $count] < 0 && $count == 2} {
set val [string trim $val]
set token [string trim $token]
catch {hupdate /sics/choco/${chopper}/${token} $val}
catch {hdelprop /sics/choco/${chopper}/${token} geterror}
} else {
#-------- special fix for dphas and averl
if {[string first dphas $par] >= 0} {
set val [string range $par 5 end]
if {$val > 360} {
set val [expr $val -360.]
}
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
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
# is why this is protected by catch'es.
#-------------------------------------------------------------
proc astcopydependentpar {} {
global choppers
foreach chop $choppers {
set val [hval /sics/choco/${chop}/aspee]
catch {hupdate /sics/choco/${chop}/speed $val}
set val [hval /sics/choco/${chop}/nphas]
set dp [hval /sics/choco/${chop}/dphas]
set val [expr $val + $dp]
catch {hupdate /sics/choco/${chop}/phase $val}
}
}
#--------------------------------------------------------------
proc readastriumchopperpar {} {
global choppers
set reply [sct result]
if {[string first ERR $reply] >= 0} {
astriumchopperputerror $reply
return idle
}
if {[string first "not valid" $reply] >= 0 } {
astriumchopperputerror "ERROR: chopper responded with not valid"
return idle
}
set count [sct replycount]
if {$count == -1} {
sct send @@NOSEND@@
sct replycount 0
hupdate /sics/choco/asyst ""
hdelprop /sics/choco/asyst geterror
return astchoppar
} else {
set oldval [hval /sics/choco/asyst]
hupdate /sics/choco/asyst "$oldval $reply"
astriumsplitreply [lindex $choppers $count] $reply
incr count
sct replycount $count
if {$count < [llength $choppers] } {
sct send @@NOSEND@@
return astchoppar
} else {
astcopydependentpar
return idle
}
}
}
#--------------------------------------------------------------
proc astchopread {} {
sct send "asyst 1"
sct replycount -1
return astchoppar
}
#---------------------------------------------------------------
proc astriumMakeChopperParameters {} {
global choppers chopperparlist
foreach chopper $choppers {
hfactory /sics/choco/${chopper} plain spy none
foreach par $chopperparlist {
set path /sics/choco/${chopper}/${par}
hfactory $path plain internal text
chocosct connect $path
}
}
hfactory /sics/choco/asyst plain user text
hsetprop /sics/choco/asyst read astchopread
hsetprop /sics/choco/asyst astchoppar readastriumchopperpar
hfactory /sics/choco/stop plain user int
chocosct poll /sics/choco/asyst 60
#--------- This is for debugging
# chocosct poll /sics/choco/asyst 10
}
#=================== write support ==============================
proc astchopwrite {prefix} {
set val [sct target]
sct send "$prefix $val"
sct writestart 1
hupdate /sics/choco/stop 0
return astchopwritereply
}
#----------------------------------------------------------------
# Make sure to send a status request immediatly after a reply in
# order to avoid timing problems
#----------------------------------------------------------------
proc astchopwritereply {} {
set reply [sct result]
if {[string first ERR $reply] >= 0} {
sct print $reply
hupdate /sics/choco/stop 1
return idle
}
if {[string first "chopper error" $reply] >= 0} {
sct print "ERROR: $reply"
hupdate /sics/choco/stop 1
return idle
}
if {[string first "not valid" $reply] >= 0 } {
sct print "ERROR: chopper responded with not valid"
hupdate /sics/choco/stop 1
return idle
}
set state [sct writestart]
if {$state == 1} {
sct writestart 0
sct send "asyst 1"
sct replycount -1
return astchopwritereply
} else {
set status [readastriumchopperpar]
if {[string first idle $status] >= 0} {
return idle
} else {
return astchopwritereply
}
}
}
#--------------------------------------------------------------------
proc astchopcompare {path1 path2 delta} {
set v1 [hval $path1]
set v2 [hval $path2]
if {abs($v1 - $v2) < $delta} {
return 1
} else {
return 0
}
}
#--------------------------------------------------------------------
proc astchopcheckspeed {chopper} {
set stop [hval /sics/choco/stop]
if {$stop == 1} {
return fault
}
chocosct queue /sics/choco/asyst progress read
set tg [sct target]
set p1 /sics/choco/${chopper}/nspee
set p2 /sics/choco/${chopper}/aspee
set tst [astchopcompare $p1 $p2 50]
if {$tst == 1 } {
wait 1
return idle
} else {
return busy
}
}
#---------------------------------------------------------------------
proc astchopcheckphase {chopper} {
set stop [hval /sics/choco/stop]
if {$stop == 1} {
return fault
}
chocosct queue /sics/choco/asyst progress read
set p2 [hval /sics/choco/${chopper}/dphas]
if {abs($p2) < .03} {
wait 15
return idle
} else {
return busy
}
}
#---------------------------------------------------------------------
proc astchopcheckratio {} {
global choppers
set stop [hval /sics/choco/stop]
if {$stop == 1} {
return fault
}
set ch1 [lindex $choppers 0]
set ch2 [lindex $choppers 1]
chocosct queue /sics/choco/asyst progress read
set p1 [hval /sics/choco/${ch1}/aspee]
set p2 [hval /sics/choco/${ch2}/aspee]
set target [sct target]
if {$p2 < 10} {
return busy
}
if {abs($p1/$p2 - $target*1.) < .3} {
set tst 1
} else {
set tst 0
}
if {$tst == 1 } {
wait 1
return idle
} else {
return busy
}
}
#----------------------------------------------------------------------
proc astchopstop {} {
sct print "No real way to stop choppers but I will release"
sct send @@NOSEND@@
hupdate /sics/choco/stop 1
return idle
}
#---------------------------------------------------------------------
proc astspeedread {chopper} {
set val [hval /sics/choco/${chopper}/aspee]
sct update $val
sct send @@NOSEND@@
return idle
}
#---------------------------------------------------------------------
proc astchopspeedlimit {chidx} {
global choppers maxspeed
set chname [lindex $choppers $chidx]
set val [sct target]
if {$val < 0 || $val > $maxspeed} {
error "Desired chopper speed out of range"
}
if {$chidx > 0} {
set state [hval /sics/choco/${chname}/state]
if {[string first async $state] < 0} {
error "Chopper in wrong state"
}
}
return OK
}
#----------------------------------------------------------------------
proc astMakeChopperSpeed1 {var} {
global choppers
set ch [lindex $choppers 0]
set path /sics/choco/${ch}/speed
hfactory $path plain mugger float
hsetprop $path read astspeedread $ch
hsetprop $path write astchopwrite "nspee 1 "
hsetprop $path astchopwritereply astchopwritereply
chocosct write $path
hsetprop $path checklimits astchopspeedlimit 0
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckspeed $ch
hsetprop $path priv manager
makesctdriveobj $var $path DriveAdapter chocosct
}
#----------------------------------------------------------------------
proc astMakeChopperSpeed2 {var} {
global choppers
set ch [lindex $choppers 1]
set path /sics/choco/${ch}/speed
hfactory $path plain mugger float
hsetprop $path read astspeedread $ch
hsetprop $path write astchopwrite "nspee 2 "
hsetprop $path astchopwritereply astchopwritereply
chocosct write $path
hsetprop $path checklimits astchopspeedlimit 0
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckspeed $ch
hsetprop $path priv manager
makesctdriveobj $var $path DriveAdapter chocosct
}
#-----------------------------------------------------------------------
proc astchopphaselimit {} {
set val [sct target]
if {$val < -359.9 || $val > 359.9} {
error "chopper phase out of range"
}
return OK
}
#---------------------------------------------------------------------
proc astphaseread {chopper} {
set val [hval /sics/choco/${chopper}/aphas]
sct update $val
sct send @@NOSEND@@
return idle
}
#-----------------------------------------------------------------------
proc astMakeChopperPhase1 {var} {
global choppers
set ch [lindex $choppers 0]
set path /sics/choco/${ch}/phase
hfactory $path plain mugger float
hsetprop $path read astphaseread $ch
hsetprop $path write astchopwrite "nphas 1 "
hsetprop $path astchopwritereply astchopwritereply
chocosct write $path
hsetprop $path checklimits astchopphaselimit
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckphase $ch
hsetprop $path priv manager
makesctdriveobj $var $path DriveAdapter chocosct
}
#-----------------------------------------------------------------------
proc astMakeChopperPhase2 {var} {
global choppers
set ch [lindex $choppers 1]
set path /sics/choco/${ch}/phase
hfactory $path plain mugger float
hsetprop $path read astphaseread $ch
hsetprop $path write astchopwrite "nphas 2 "
hsetprop $path astchopwritereply astchopwritereply
chocosct write $path
hsetprop $path checklimits astchopphaselimit
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckphase $ch
hsetprop $path priv manager
makesctdriveobj $var $path DriveAdapter chocosct
}
#----------------------------------------------------------------------
proc astchopratiolimit {} {
set val [sct target]
if {$val < 1} {
error "Ratio out of range"
}
return OK
}
#-----------------------------------------------------------------------
proc astMakeChopperRatio {var} {
global choppers
set ch [lindex $choppers 1]
set path /sics/choco/${ch}/Ratio
hdel $path
hfactory $path plain mugger float
chocosct connect $path
hsetprop $path write astchopwrite "ratio 2 "
hsetprop $path astchopwritereply astchopwritereply
chocosct write $path
hsetprop $path checklimits astchopratiolimit
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckratio
makesctdriveobj $var $path DriveAdapter chocosct
}
#------------------------------------------------------------------------
proc chosta {} {
global chopperlonglist chopperparlist choppers chopperheader
set result "$chopperheader\n"
append line [format "%-20s " ""]
set count 1
foreach ch $choppers {
append line [format "%-20s " $ch]
incr count
}
append result $line "\n"
set nchop [llength $choppers]
set len [llength $chopperlonglist]
for {set i 0} {$i < $len} {incr i} {
set line ""
set par [lindex $chopperlonglist $i]
append line [format "%-20s " $par]
for {set n 0} {$n < $nchop} {incr n} {
set chname [lindex $choppers $n]
set parname [lindex $chopperparlist $i]
set val [hval /sics/choco/${chname}/${parname}]
append line [format "%-20s " $val]
}
append result $line "\n"
}
return $result
}
#======================= Configuration Section ==========================
if {$amor == 1} {
set choppers [list chopper1 chopper2]
set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra t_cho \
durch vakum valve sumsi spver state]
set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \
"Loss Current" Ratio Vibration Temperature "Water Flow" Vakuum \
Valve Sumsi]
set chopperheader "AMOR Chopper Status"
makesctcontroller chocosct std ${ts}:3014 "\r\n" 60
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
chocosct debug -1
set maxspeed 5000
set minphase 0
astriumMakeChopperParameters
astMakeChopperSpeed1 chopperspeed
astMakeChopperPhase2 chopper2phase
Publish chosta Spy
}
#----------------------------- POLDI -----------------------------------------
if {$poldi == 1} {
proc poldiastchopphaselimit {} {
set val [sct target]
if {$val < 80 || $val > 100} {
error "chopper phase out of range"
}
return OK
}
#-------
proc poldispeedwrite {} {
set val [sct target]
set l [split [config myrights] =]
set rights [string trim [lindex $l 1]]
if {$rights == 2} {
if {$val < 4990 || $val > 15000} {
clientput "ERROR: Users may only drive the chopper between 5000 - 15000 RPM"
hupdate /sics/choco/stop 1
return idle
}
}
return [astchopwrite "nspee 1 "]
}
#-----------
set choppers [list chopper]
set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra vibax t_cho \
flowr vakum valve sumsi spver state]
set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \
"Loss Current" Ratio Vibration "Actual Vibration" Temperature "Water Flow" Vakuum \
Valve Sumsi]
set chopperheader "POLDI Chopper Status"
makesctcontroller chocosct std lnsts13:3005 "\r\n" 60
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
chocosct debug -1
set maxspeed 15000
set minphase 80
astriumMakeChopperParameters
# astMakeChopperSpeed1 chopperspeed
set path /sics/choco/chopper/speed
hfactory $path plain user float
hsetprop $path read astspeedread chopper
hsetprop $path write poldispeedwrite
hsetprop $path astchopwritereply astchopwritereply
chocosct write $path
hsetprop $path checklimits astchopspeedlimit 0
hsetprop $path halt astchopstop
hsetprop $path checkstatus astchopcheckspeed chopper
hsetprop $path priv user
makesctdriveobj chopperspeed $path DriveAdapter chocosct
astMakeChopperPhase1 chopperphase
hsetprop /sics/choco/chopper/phase checklimit poldiastchopphaselimit
Publish chosta Spy
}
#----------------------------- FOCUS -----------------------------------------------------
if {$focus == 1} {
set choppers [list fermi disk]
set chopperparlist [list state amode aspee nspee nphas dphas averl ratio vibra t_cho \
durch vakum valve sumsi]
set chopperlonglist [list "Chopper State" "Chopper Mode" "Actual Speed" "Set Speed" \
"Phase" "Phase Error" \
"Loss Current" Ratio Vibration Temperature "Water Flow" \
Vakuum Valve Sumsi]
set chopperheader "FOCUS Chopper Status"
makesctcontroller chocosct std psts227:3008 "\r\n" 60
# makesctcontroller chocosct std localhost:8080 "\r\n" 60
chocosct debug -1
set maxspeed 20000
set minphase 0
astriumMakeChopperParameters
astMakeChopperSpeed1 fermispeed
astMakeChopperSpeed2 diskspeed
astMakeChopperRatio ratio
astMakeChopperPhase2 phase
Publish chosta Spy
}

32
site_ansto/instrument/pelican/config/tasmad/sicscommon/backup.tcl
View File

@@ -1,32 +0,0 @@
proc nextBackupTime {now period last} {
upvar $last l
set l [expr $now / $period * $period]
return [expr $l + $period]
}
proc backupCron {path {minutes 10} {days 1}} {
global next_backup
set now [clock seconds]
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(day) [nextBackupTime $now $days last]
set file [clock format $now -format "$path/backupd-%m-%d.tcl"]
if {![file exists $file]} {
backup $file
}
}
if {$now > $next_backup(min)} {
set next_backup(min) [nextBackupTime $now $minutes last]
set file [clock format $last -format "$path/backup-%Hh%M.tcl"]
} else {
return 1
}
if {$now > $next_backup(day)} {
set next_backup(day) [nextBackupTime $now $days last]
set file [clock format $last -format "$path/backupd-%m-%d.tcl"]
}
backup $file
return 1
}

29
site_ansto/instrument/pelican/config/tasmad/sicscommon/batch.tcl
View File

@@ -1,29 +0,0 @@
#--------------------------------------------
# The old batchrun, batchroot pair
# Mark Koennecke, since 1996
#--------------------------------------------
if { [info exists batchinit] == 0 } {
set batchinit 1
Publish batchroot Spy
Publish batchrun User
}
proc SplitReply { text } {
set l [split $text =]
return [lindex $l 1]
}
#---------------------
proc batchrun file {
exe [string trim [SplitReply [batchroot]]/$file]
}
#---------------------
proc batchroot args {
if {[llength $args] > 1} {
exe batchpath [lindex $args 0]
return OK
} else {
set bp [SplitReply [exe batchpath]]
return "batchroot = $bp"
}
}

169
site_ansto/instrument/pelican/config/tasmad/sicscommon/ccdwww.tcl
View File

@@ -1,169 +0,0 @@
#------------------------------------------------------
# This is SICS HM driver code for the CCDWWW CCD camera
# 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
# 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}]
append confdata "<$var>$val</$var>\n"
}
return $confdata
}
#-------------------------------------------------------
proc ccdwww::httpsend {url} {
sct send $url
return httpreply
}
#-------------------------------------------------------
proc ccdwww::httpsendstart {url} {
sct send $url
return httpstartreply
}
#--------------------------------------------------------
proc ccdwww::httptest {data} {
if {[string first ASCERR $data] >= 0} {
error $data
}
if {[string first ERROR $data] >= 0} {
error $data
}
return $data
}
#--------------------------------------------------------
proc ccdwww::httpreply {} {
set reply [sct result]
set status [catch {httptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
} else {
hdelprop [sct] geterror
}
return idle
}
#---------------------------------------------------------
proc ccdwww::httpstartreply {} {
set reply [sct result]
set status [catch {httptest $reply} data]
if {$status != 0} {
sct geterror $data
} else {
hdelprop [sct] geterror
}
clientput $data
after 100
return idle
}
#---------------------------------------------------------
# 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 {} {
set target [sct target]
switch $target {
1000 {
set path [file dirname [sct]]
set preset [hval $path/preset]
set ret [ccdwww::httpsendstart "/ccd/expose?time=$preset"]
hupdate $path/status run
[sct controller] queue $path/status progress read
return $ret
}
1001 {}
1002 {}
1003 {}
1005 {
set path [file dirname [sct]]
set script [hval $path/initscript]
set confdata [eval $script]
clientput $confdata
return [ccdwww::httpsend "post:/ccd/configure:$confdata"]
}
default {
sct print "ERROR: bad start target $target given to control"
return idle
}
}
}
#---------------------------------------------------------
proc ccdwww::httpdata {name} {
set path "/sics/${name}/data"
set com [format "node:%s:/ccd/data" $path]
sct send $com
return httpdatareply
}
#--------------------------------------------------------
proc ccdwww::httpdatareply {} {
set status [catch {httpreply} txt]
if {$status == 0} {
set path [file dirname [sct]]
hdelprop $path/data geterror
}
return idle
}
#--------------------------------------------------------
proc ccdwww::httpstatus {} {
sct send /ccd/locked
return httpevalstatus
}
#-------------------------------------------------------
proc ccdwww::httpstatusdata {} {
catch {httpdatareply}
sct update idle
return idle
}
#---------------------------------------------------------
proc ccdwww::httpevalstatus {name} {
set reply [sct result]
set status [catch {httptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
sct update error
return idle
}
hdelprop [sct] geterror
if {$data == 0} {
httpdata $name
return httpstatusdata
} else {
sct update run
[sct controller] queue [sct] progress read
return idle
}
}
#---------------------------------------------------------
proc ccdwww::MakeCCDWWW {name host initscript} {
sicsdatafactory new ${name}transfer
makesctcontroller ${name}sct sinqhttpopt $host ${name}transfer 600
MakeSecHM $name 2
hsetprop /sics/${name}/control write ccdwww::httpcontrol
hsetprop /sics/${name}/control httpreply ccdwww::httpreply
hsetprop /sics/${name}/control httpstartreply ccdwww::httpstartreply
${name}sct write /sics/${name}/control
hsetprop /sics/${name}/data read ccdwww::httpdata $name
hsetprop /sics/${name}/data httpdatareply ccdwww::httpdatareply
hsetprop /sics/${name}/status read ccdwww::httpstatus
hsetprop /sics/${name}/status httpevalstatus ccdwww::httpevalstatus $name
hsetprop /sics/${name}/status httpstatusdata ccdwww::httpstatusdata
${name}sct poll /sics/${name}/status 60
hfactory /sics/${name}/initscript plain mugger text
hset /sics/${name}/initscript $initscript
}

1
site_ansto/instrument/pelican/config/tasmad/sicscommon/debsics
View File

@@ -1 +0,0 @@
gdb -d /afs/psi.ch/user/k/koennecke/src/workspace/sics -d /afs/psi.ch/user/k/koennecke/src/workspace/sics/psi SICServer $*

357
site_ansto/instrument/pelican/config/tasmad/sicscommon/deltatau.tcl
View File

@@ -1,357 +0,0 @@
#---------------------------------------------------------------
# These are the scripts for the delta-tau PMAC motor
# controller.
#
# !!!!!!!!! Script Chains !!!!!!!!!!!
# -- For reading parameters:
# sendpmacread code -- pmacreadreply
# -- For setting standard parameters
# sendpmacwrite code -- pmacreadreply
# -- For reading limits
# sendpmaclim -- readpmaclim
# -- 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.
# -- 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
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, December 2008, March 2009
#---------------------------------------------------------------
proc translatePMACError {key} {
set pmacerr(ERR001) "Command not allowed while executing"
set pmacerr(ERR002) "Password error"
set pmacerr(ERR003) "Unrecognized command"
set pmacerr(ERR004) "Illegal character"
set pmacerr(ERR005) "Command not allowed"
set pmacerr(ERR006) "No room in buffer for command"
set pmacerr(ERR007) "Buffer already in use"
set pmacerr(ERR008) "MACRO auxiliary communication error"
set pmacerr(ERR009) "Bad program in MCU"
set pmacerr(ERR010) "Both HW limits set"
set pmacerr(ERR011) "Previous move did not complete"
set pmacerr(ERR012) "A motor is open looped"
set pmacerr(ERR013) "A motor is not activated"
set pmacerr(ERR014) "No motors"
set pmacerr(ERR015) "No valid program in MCU"
set pmacerr(ERR016) "Bad program in MCU"
set pmacerr(ERR017) "Trying to resume after H or Q"
set pmacerr(ERR018) "Invalid operation during move"
set pmacerr(ERR019) "Illegal position change command during move"
return $pmacerr($key)
}
#------------------------------------------------------------------
proc translateAxisError {key} {
switch [string trim $key] {
0 {return "no error"}
1 { return "limit violation"}
2 -
3 -
4 { return "jog error"}
5 {return "command not allowed"}
6 {return "watchdog triggered"}
7 {return "current limit reached"}
8 -
9 {return "Air cushion error"}
10 {return "MCU lim reached"}
11 {return "following error triggered"}
12 {return "EMERGENCY STOP ACTIVATED"}
13 {return "Driver electronics error"}
default { return "Unknown axis error $key"}
}
}
#---------------------------------------------------------------------
proc evaluateAxisStatus {key} {
#----- Tcl does not like negative numbers as keys.
if {$key < 0} {
set key [expr 50 + abs($key)]
}
switch $key {
0 -
14 {return idle}
1 -
2 -
3 -
4 -
5 -
6 -
7 -
8 -
9 -
10 -
56 -
11 {return run}
55 {error "Axis is deactivated"}
54 {error "emergency stop activated, please release"}
53 {error "Axis inhibited"}
51 -
52 {error "Incoming command is blocked"}
}
}
#-----------------------------------------------------------------------
proc checkpmacresult {} {
set data [sct result]
if {[string first ASCERR $data] >= 0} {
error $data
}
if {[string first ERR $data] >= 0} {
error [translatePMACError $data]
}
return [string trim $data]
}
#------------------------------------------------------------------------
proc sendpmacread {code} {
sct send $code
return pmacreadreply
}
#------------------------------------------------------------------------
proc pmacreadreply {} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct geterror $data
} else {
sct update $data
}
return idle
}
#----------------------------------------------------------------------
proc sendpmaclim {code} {
sct send $code
return pmacreadlim
}
#-----------------------------------------------------------------------
proc pmacreadlim {motname} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct geterror $data
} else {
set scale [hval /sics/${motname}/scale_factor]
sct update [expr $data * $scale]
}
return idle
}
#------------------------------------------------------------------------
proc sendpmacwrite {code} {
set value [sct target]
sct send "$code=$value"
return pmacwritereply
}
#------------------------------------------------------------------------
proc pmacwritereply {} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
sct geterror $data
sct print "ERROR: $data"
} else {
set con [sct controller]
$con queue [sct] read read
}
return idle
}
#-------------------------------------------------------------------------
proc configurePMACPar {name par code sct} {
set path /sics/$name/$par
hsetprop $path read "sendpmacread $code"
hsetprop $path pmacreadreply pmacreadreply
$sct poll $path 30
hsetprop $path write "sendpmacwrite $code"
hsetprop $path pmacwritereply pmacwritereply
$sct write $path
}
#-------------------------------------------------------------------------
proc makePMACPar {name par code sct priv} {
set path /sics/$name/$par
hfactory $path plain $priv float
configurePMACPar $name $par $code $sct
}
#========================== status functions =============================
proc pmacsendaxerr {num} {
sct send "P${num}01"
return rcvaxerr
}
#------------------------------------------------------------------------
proc pmacrcvaxerr {motname num} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
clientput "ERROR: $motname : $data"
sct update error
sct geterror $data
return idle
}
hupdate /sics/$motname/axiserror $data
if {$data != 0 } {
set err [translateAxisError $data]
if {[string first following $err] >= 0} {
clientput "WARNING: $motname : $err"
sct update poserror
} else {
clientput "ERROR: $motname : $err"
sct update error
}
return idle
}
hupdate /sics/$motname/axiserror $data
sct send "Q${num}10"
return rcvpos
}
#------------------------------------------------------------------------
proc pmacrcvpos {motname num} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
clientput "ERROR: $motname : $data"
sct geterror $data
sct update error
return idle
}
hupdate /sics/$motname/hardposition $data
sct send "P${num}00"
return rcvstat
}
#------------------------------------------------------------------------
proc pmacrcvstat {motname num sct} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
clientput "ERROR: $motname : $data"
sct update error
return idle
}
set status [catch {evaluateAxisStatus $data} msg]
if {$status != 0} {
sct update error
} else {
sct update $msg
switch $msg {
idle {
# force an update of the motor position
$sct queue /sics/$motname/hardposition progress read
}
run {
# force an update of ourselves, while running
$sct queue /sics/$motname/status progress read
}
}
}
return idle
}
#-------------------------------------------------------------------------
proc configurePMACStatus {motname num sct} {
set path /sics/$motname/status
hsetprop $path read "pmacsendaxerr $num"
hsetprop $path rcvaxerr "pmacrcvaxerr $motname $num"
hsetprop $path rcvpos "pmacrcvpos $motname $num"
hsetprop $path rcvstat "pmacrcvstat $motname $num $sct"
$sct poll $path 60
}
#======================= setting hard position ===========================
proc pmacsendhardpos {motname num} {
hupdate /sics/$motname/status run
set value [sct target]
sct send [format "P%2.2d23=0 Q%2.2d01=%12.4f M%2.2d=1" $num $num $value $num]
return rcvhardpos
}
#-------------------------------------------------------------------------
proc pmacrcvhardpos {num} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
clientput "ERROR: $data"
sct seterror $data
return idle
}
sct send "P${num}00"
return rcvhardax
}
#------------------------------------------------------------------------
proc pmacrcvhardax {motname num sct} {
set status [catch {checkpmacresult} data]
if {$status != 0} {
clientput "ERROR: $motname : $data"
sct seterror $data
return idle
}
set status [catch {evaluateAxisStatus $data} msg]
if {$status != 0} {
clientput "ERROR: $motname : $msg"
sct seterror $msg
return idle
}
switch $msg {
idle {
sct send "P${num}00"
return rcvhardax
}
run {
$sct queue /sics/$motname/status progress read
return idle
}
}
}
#------------------------------------------------------------------------
proc configurePMAChardwrite {motname num sct} {
set path /sics/$motname/hardposition
hsetprop $path write "pmacsendhardpos $motname $num"
hsetprop $path rcvhardpos "pmacrcvhardpos $num"
hsetprop $path rcvhardax "pmacrcvhardax $motname $num $sct"
}
#======================= Halt =============================================
proc pmacHalt {sct num} {
$sct send "M${num}=8" halt
return OK
}
#==================== Reference Run =======================================
proc pmacrefrun {motorname sct num} {
set path /sics/${motorname}/status
$sct send "M${num}=9"
hupdate /sics/${motorname}/status run
set motstat run
wait 3
while {[string compare $motstat run] == 0} {
$sct queue $path progress read
wait 1
set motstat [string trim [hval $path]]
}
return "Done"
}
#--------------------------------------------------------------------------
proc MakeDeltaTau {name sct num} {
MakeSecMotor $name
hsetprop /sics/${name}/hardupperlim read "sendpmaclim I${num}13"
hsetprop /sics/${name}/hardupperlim pmacreadlim "pmacreadlim $name"
$sct poll /sics/${name}/hardupperlim 180
hsetprop /sics/${name}/hardlowerlim read "sendpmaclim I${num}14"
hsetprop /sics/${name}/hardlowerlim pmacreadlim "pmacreadlim $name"
$sct poll /sics/${name}/hardlowerlim 180
# configurePMACPar $name hardlowerlim "Q${num}09" $sct
# configurePMACPar $name hardupperlim "Q${num}08" $sct
configurePMACPar $name hardposition "Q${num}10" $sct
configurePMAChardwrite $name $num $sct
hfactory /sics/$name/numinmcu plain internal int
hupdate /sics/$name/numinmcu ${num}
makePMACPar $name enable "M${num}14" $sct mugger
makePMACPar $name scale_factor "Q${num}00" $sct mugger
makePMACPar $name maxspeed "Q${num}03" $sct mugger
makePMACPar $name commandspeed "Q${num}04" $sct mugger
makePMACPar $name maxaccel "Q${num}05" $sct mugger
makePMACPar $name commandedaccel "Q${num}06" $sct mugger
makePMACPar $name offset "Q${num}07" $sct mugger
makePMACPar $name axisstatus "P${num}00" $sct internal
makePMACPar $name axiserror "P${num}01" $sct internal
makePMACPar $name poshwlimitactive "M${num}21" $sct internal
makePMACPar $name neghwlimitactive "M${num}22" $sct internal
makePMACPar $name liftaircushion "M${num}96" $sct internal
configurePMACStatus $name $num $sct
$name makescriptfunc halt "pmacHalt $sct $num" user
$name makescriptfunc refrun "pmacrefrun $name $sct $num" user
set parlist [list scale_factor hardposition maxspeed \
commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \
neghwlimitactive liftaircushion hardlowerlim hardupperlim]
# $sct send [format "M%2.2d14=1" $num]
foreach par $parlist {
$sct queue /sics/$name/$par progress read
}
}

488
site_ansto/instrument/pelican/config/tasmad/sicscommon/el734.tcl
View File

@@ -1,488 +0,0 @@
#--------------------------------------------------------
# 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
# 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
# details
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, February 2011
#--------------------------------------------------------
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
# has been released.
# - 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
# 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
# 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
# have a valid response is stored in the property comresponse
#---------------------------------------------------------------
proc el734::setcommand {command responsescript {motno 0}} {
sct comresponse $responsescript
sct comstate start
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
# real device
#---------------------------------------------------------------
proc el734::command {} {
set state [sct comstate]
switch $state {
start {
set com [sct comstring]
sct send $com
sct comstate waitresponse
}
waitstart {
wait 1
sct comstate start
return [el734::command]
}
waitresponse {
set reply [sct result]
if {[string first "*ES" $reply] >= 0} {
set com [sct comstring]
sct send $com
sct comstate waitES
return command
}
if {[string first "?LOC" $reply] >= 0} {
sct send "RMT 1"
sct comstate waitrmt
return command
}
if {[string first "?BSY" $reply] >= 0} {
set mot [sct commotno]
if {$mot != 0} {
set com [format "S %d" $mot]
} else {
set com "S"
}
sct send $com
sct comstate waitstart
return command
}
set com [sct comstring]
set idx [string first $com $reply]
if {[string first $com $reply] >= 0} {
sct send @@NOSEND@@
sct comstate waitresponse
return command
}
set responsescript [sct comresponse]
return [eval $responsescript]
}
waitES {
set reply [sct result]
if {[string first "*ES" $reply] >= 0} {
clientput "Emergency STOP ENGAGED, release to continue"
error "Emergency Stop ENGAGED"
}
set responsescript [sct comresponse]
return [eval $responsescript]
}
waitrmt {
sct send "ECHO 0"
sct comstate start
}
}
return command
}
#-------------------------------------------------------------------
proc el734::checkerror {} {
set err(?ADR) "Bad address"
set err(?CMD) "Bad command"
set err(?PAR) "Bad parameter"
set err(?RNG) "Parameter out of range"
set err(?BSY) "Motor busy"
set err(*MS) "Bad step"
set err(*ES) "Emergency stop engaged"
set reply [string trim [sct result]]
set errlist [array names err]
foreach entry $errlist {
if {[string first $entry $reply] >= 0} {
error $err($entry)
}
}
return $reply
}
#========================== Position ===============================
proc el734::readpos {num} {
set com [format "u %d" $num]
return [el734::setcommand $com el734::posresponse]
}
#-------------------------------------------------------------------
proc el734::posresponse {} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
sct update $reply
return idle
} else {
clientput $reply
return idle
}
}
#-------------------------------------------------------------------
proc el734::setpos {name num} {
set newpos [sct target]
set com [format "p %d %f" $num $newpos]
hupdate /sics/${name}/status run
hupdate /sics/${name}/oredmsr 3
hupdate /sics/${name}/runfault 0
hupdate /sics/${name}/posfault 0
return [el734::setcommand $com "el734::setposresponse $name"]
}
#-------------------------------------------------------------------
proc el734::setposresponse {name} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
[sct controller] queue /sics/${name}/status progress read
return idle
} else {
clientput $reply
return idle
}
}
#===================== Limits =====================================
proc el734::getlim {name num} {
set com [format "H %d" $num]
return [el734::setcommand $com "el734::limresponse $name"]
}
#-----------------------------------------------------------------
proc el734::limresponse {name} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
stscan $reply "%f %f" low high
hupdate /sics/${name}/hardlowerlim $low
hupdate /sics/${name}/hardupperlim $high
return idle
} else {
clientput $reply
return idle
}
}
#------------------------------------------------------------------
proc el734::setlim {controller name num low high} {
set com [format "H %d %f %f" $num $low $high]
$controller send $com
$controller queue /sics/${name}/hardlowerlim progress read
wait 1
return Done
}
#======================== status ================================
proc el734::decodemsr {name msr} {
set oredata(0x02) idle:none
set oredata(0x10) error:lowlim
set oredata(0x20) error:hilim
set oredata(0x80) posfault:runfault
set oredata(0x200) posfault:posfault
set oredata(0x1000) "error:air cushion"
set oredata(0x40) "error:bad step"
set oredata(0x100) error:positionfault
set oredata(0x400) error:positionfault
set msrdata(0x20) hilim
set msrdata(0x10) lowlim
set msrdata(0x1000) "air cushion"
set msrdata(0x40) "Bad step"
set msrdata(0x100) posfault
set msrdata(0x400) posfault
set oredmsr [hval /sics/${name}/oredmsr]
if {$msr == 0} {
#-------- FINISHED
set pos [hval /sics/${name}/posfault]
set run [hval /sics/${name}/runfault]
if {$pos > 0 || $run > 0} {
return posfault
}
set orlist [array names oredata]
foreach code $orlist {
if {$oredmsr & $code} {
set l [split $oredata($code) :]
set txt [lindex $l 1]
set ret [lindex $l 0]
hupdate /sics/${name}/lasterror $txt
if {[string compare $ret error] == 0} {
clientput "ERROR: $txt on motor $name"
}
return $ret
}
}
if {$oredmsr == 0} {
return idle
}
} else {
#------------ Still Running.........
set msrlist [array names msrdata]
foreach code $msrlist {
if {$msr & $code} {
clientput "ERROR: $msrdata($code) on motor $name"
return error
}
}
if {$msr & 0x80} {
set val [hval /sics/${name}/runfault]
incr val
hupdate /sics/${name}/runfault $val
}
if {$msr & 0x200} {
set val [hval /sics/${name}/posfault]
incr val
hupdate /sics/${name}/posfault $val
}
hupdate /sics/${name}/oredmsr [expr $oredmsr | $msr]
return run
}
}
#----------------------------------------------------------------
proc el734::readstatus {num name} {
set com [format "msr %d" $num]
return [el734::setcommand $com "el734::statresponse $name $num"]
}
#----------------------------------------------------------------
proc el734::statresponse {name num} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
stscan $reply "%d" msr
set status [el734::decodemsr $name $msr]
sct update $status
switch $status {
run {
set con [sct controller]
$con queue /sics/${name}/hardposition progress read
$con queue /sics/${name}/status progress read
}
idle {
set com [format "u %d" $num]
return [el734::setcommand $com "el734::posstat $name" ]
}
}
return idle
} else {
clientput $reply
return idle
}
}
#----------------------------------------------------------------
proc el734::posstat {name} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
hupdate /sics/${name}/hardposition $reply
return idle
} else {
clientput $reply
return idle
}
}
#========================== Halt =================================
proc el734::halt {controller no} {
set com [format "S %d" $no]
$controller send $com
return Done
}
#========================= Speed ================================
proc el734::readspeed {num} {
set com [format "J %d" $num]
return [el734::setcommand $com el734::speedresponse]
}
#-------------------------------------------------------------------
proc el734::speedresponse {} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
sct update $reply
return idle
} else {
clientput $reply
return idle
}
}
#-------------------------------------------------------------------
proc el734::setspeed {name num} {
set newpos [sct target]
set com [format "J %d %d" $num $newpos]
return [el734::setcommand $com "el734::setspeedresponse $name $num"]
}
#-------------------------------------------------------------------
proc el734::setspeedresponse {name num} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
return [el734::readspeed $num]
} else {
clientput $reply
return idle
}
}
#========================= refnull ================================
proc el734::readref {num} {
set com [format "V %d" $num]
return [el734::setcommand $com el734::refresponse]
}
#-------------------------------------------------------------------
proc el734::refresponse {} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
sct update $reply
return idle
} else {
clientput $reply
return idle
}
}
#-------------------------------------------------------------------
proc el734::setref {name num} {
set newpos [sct target]
set com [format "V %d %d" $num $newpos]
return [el734::setcommand $com "el734::setrefresponse $name $num"]
}
#-------------------------------------------------------------------
proc el734::setrefresponse {name num} {
set stat [catch {checkerror} reply]
if {$stat == 0} {
return [el734::readref $num]
} else {
clientput $reply
return idle
}
}
#============================= SS =================================
proc el734::readss {num} {
set com [format "SS %d" $num]
sct send $com
return ssread
}
#-----------------------------------------------------------------
proc el734::ssread {} {
sct update [sct result]
return idle
}
#======================== setpos ================================
proc el734::forcepos {controller name num newpos} {
set com [format "U %d %f" $num $newpos]
$controller send $com
$controller queue /sics/${name}/hardposition progress read
wait 1
return Done
}
#======================= refrun ==================================
proc el734::refrun {controller name num} {
clientput "Starting reference run"
$controller send [format "R %d" $num]
$controller queue /sics/${name}/ss progress read
while {1} {
wait 2
set ss [hval /sics/${name}/ss]
if { [string first ?BSY $ss] < 0} {
break
}
set rupt [getint]
if { [string compare $rupt continue] != 0} {
error "Refererence run interrupted"
}
$controller queue /sics/${name}/ss progress read
}
$controller queue /sics/${name}/hardposition progress read
wait 2
return "Reference run Finished"
}
#================================================================
proc el734::reset {name} {
set x [hval /sics/${name}/hardlowerlim]
hupdate /sics/${name}/softlowerlim $x
set x [hval /sics/${name}/hardupperlim]
hupdate /sics/${name}/softupperlim $x
hupdate /sics/${name}/softzero 0
hupdate /sics/${name}/fixed -1
}
#========================= 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
hfactory /sics/${name}/lasterror plain internal text
hsetprop /sics/${name}/hardposition read el734::readpos $no
hsetprop /sics/${name}/hardposition command el734::command
hsetprop /sics/${name}/hardposition write el734::setpos $name $no
hsetprop /sics/${name}/hardposition command el734::command
$controller write /sics/${name}/hardposition
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
hfactory /sics/${name}/speed plain user int
hsetprop /sics/${name}/speed read el734::readspeed $no
hsetprop /sics/${name}/speed command el734::command
$controller poll /sics/${name}/speed 120
hsetprop /sics/${name}/speed write el734::setspeed $name $no
hsetprop /sics/${name}/speed command el734::command
$controller write /sics/${name}/speed
$name makescriptfunc halt "el734::halt $controller $no" user
$name makescriptfunc reset "el734::reset $name" user
$name makescriptfunc sethardlim "el734::setlim $controller $name $no" mugger
hfactory /sics/${name}/sethardlim/low plain mugger float
hfactory /sics/${name}/sethardlim/high plain mugger float
hfactory /sics/${name}/motno plain internal int
hupdate /sics/${name}/motno $no
}
#-------------------------------------------------------------------------------
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
hsetprop /sics/${name}/refnull write el734::setref $name $no
hsetprop /sics/${name}/refnull command el734::command
$controller write /sics/${name}/refnull
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
$name makescriptfunc refrun "el734::refrun $controller $name $no" user
}

321
site_ansto/instrument/pelican/config/tasmad/sicscommon/el737sec.tcl
View File

@@ -1,321 +0,0 @@
#-----------------------------------------------------
# This is a second generation counter driver for
# the PSI EL737 counter boxes using scriptcontext
# communication.
#
# copyright: see file COPYRIGHT
#
# Scriptchains:
# start: el737sendstart - el737cmdreply
# pause,cont, stop: el737sendcmd - el737cmdreply
# status: el737readstatus - el737status
# \ el737statval - el737statread
# values: el737readvalues - el737val
# threshold write: el737threshsend - el737threshrcv - el737cmdreply
#
# Mark Koennecke, February 2009
#-----------------------------------------------------
proc el737error {reply} {
if {[string first ERR $reply] >= 0} {
error $reply
}
if {[string first ? $reply] < 0} {
return ok
}
if {[string first "?OV" $reply] >= 0} {
error overflow
}
if {[string first "?1" $reply] >= 0} {
error "out of range"
}
if {[string first "?2" $reply] >= 0} {
error "bad command"
}
if {[string first "?3" $reply] >= 0} {
error "bad parameter"
}
if {[string first "?4" $reply] >= 0} {
error "bad counter"
}
if {[string first "?5" $reply] >= 0} {
error "parameter missing"
}
if {[string first "?6" $reply] >= 0} {
error "to many counts"
}
return ok
}
#---------------------------------------------------
proc el737cmdreply {} {
set reply [sct result]
set status [catch {el737error $reply} err]
if {$status != 0} {
sct geterror $err
set data [sct send]
if {[string first overflow $err] >= 0} {
clientput "WARNING: trying to fix $err on command = $data"
sct send $data
return el737cmdreply
} else {
clientput "ERROR: $err, command = $data"
}
}
return idle
}
#---------------------------------------------------
proc sctroot {} {
set path [sct]
return [file dirname $path]
}
#----------------------------------------------------
proc el737sendstart {} {
set obj [sctroot]
set mode [string tolower [string trim [hval $obj/mode]]]
set preset [string trim [hval $obj/preset]]
hdelprop [sct] geterror
switch $mode {
timer {
set cmd [format "TP %.2f" $preset]
}
default {
set cmd [format "MP %d" [expr int($preset)]]
}
}
sct send $cmd
set con [sct controller]
$con queue $obj/status progress read
catch {hupdate $obj/status run}
catch {hupdate $obj/values 0 0 0 0 0 0 0 0}
return el737cmdreply
}
#----------------------------------------------------
proc el737sendcmd {cmd} {
hdelprop [sct] geterror
sct send $cmd
return el737cmdreply
}
#---------------------------------------------------
proc el737control {} {
set target [sct target]
switch $target {
1000 {return [el737sendstart] }
1001 {return [el737sendcmd S] }
1002 {return [el737sendcmd PS] }
1003 {return [el737sendcmd CO] }
default {
sct print "ERROR: bad start target $target given to control"
return idle
}
}
}
#----------------------------------------------------
proc el737readstatus {} {
hdelprop [sct] geterror
sct send RS
return el737status
}
#-------------------------------------------------
proc el737statval {} {
el737readvalues
return el737statread
}
#-------------------------------------------------
proc el737statread {} {
el737val
sct update idle
return idle
}
#--------------------------------------------------
proc el737status {} {
set reply [sct result]
set status [catch {el737error $reply} err]
if {$status != 0} {
sct geterror $err
sct update error
sct print "ERROR: $err"
return idle
}
set path [sct]
set con [sct controller]
hupdate [sctroot]/RS $reply
switch [string trim $reply] {
0 {
return el737statval
}
1 -
2 {
sct update run
$con queue $path progress read
}
5 -
6 {
sct update nobeam
$con queue $path progress read
}
default {
sct update pause
$con queue $path progress read
}
}
set count [sct moncount]
if {$count >= 10} {
set root [sctroot]
$con queue $root/values progress read
sct moncount 0
} else {
incr count
sct moncount $count
}
return idle
}
#------------------------------------------------
proc el737readvalues {} {
hdelprop [sct] geterror
sct send RA
return el737val
}
#--------------------------------------------------
proc swapFirst {l} {
set m1 [lindex $l 0]
set cts [lindex $l 1]
lappend res $cts $m1
for {set i 2} {$i < [llength $l]} {incr i} {
lappend res [lindex $l $i]
}
return $res
}
#---------------------------------------------------
# There are two types of reponses to the RA command:
# the old form with 5 values and the new one
# with 9 values
#---------------------------------------------------
proc el737val {} {
set reply [sct result]
set status [catch {el737error $reply} err]
if {$status != 0} {
sct geterror $err
sct print "ERROR: $err"
return idle
}
hupdate [sctroot]/RA $reply
set l [split $reply]
set root [sctroot]
if {[llength $l] > 5} {
set l2 [lrange $l 1 end]
set l2 [swapFirst $l2]
catch {hupdate ${root}/values [join $l2]}
catch {set time [lindex $l 0]}
catch {hupdate ${root}/time $time}
} else {
set last [expr [llength $l] - 1]
set l2 [lrange $l 0 $last]
set l2 [swapFirst $l2]
hupdate ${root}/values [join $l2]
set time [lindex $l $last]
hupdate ${root}/time $time
}
set mode [hval ${root}/mode]
switch $mode {
timer {
hupdate ${root}/control $time
}
default {
set mon [lindex $l2 1]
hupdate ${root}/control $time
}
}
return idle
}
#----------------------------------------------
proc el737threshsend {} {
set val [string trim [sct target]]
set root [sctroot]
set cter [string trim [hval $root/thresholdcounter]]
sct send [format "DL %1.1d %f" $cter $val]
return el737threshrecv
}
#---------------------------------------------
proc el737threshrecv {} {
set reply [sct result]
set status [catch {el737error $reply} err]
if {$status != 0} {
sct geterror $err
sct print "ERROR: $err"
}
set root [sctroot]
set cter [string trim [hval $root/thresholdcounter]]
sct send [format "DR %1.1d" $cter]
set sctcon [sct controller]
$sctcon queue [sct] progress read
return el737cmdreply
}
#---------------------------------------------
proc el737threshread {} {
set root [sctroot]
set cter [string trim [hval $root/thresholdcounter]]
sct send [format "DL %1.1d" $cter]
return el737thresh
}
#----------------------------------------------
proc el737thresh {} {
set reply [sct result]
set status [catch {el737error $reply} err]
if {$status != 0} {
sct geterror $err
sct print "ERROR: $err"
return idle
}
stscan $reply "%f" val
sct update $val
return idle
}
#----------------------------------------------
proc el737func {controller path} {
$controller queue $path write
}
#============================================
proc MakeSecEL737 {name netaddr} {
MakeSecCounter $name 8
set conname ${name}sct
makesctcontroller $conname std $netaddr "\r" 10
$conname send "RMT 1"
$conname send "RMT 1"
$conname send "ECHO 2"
set path /sics/${name}/values
hsetprop $path read el737readvalues
hsetprop $path el737val el737val
$conname poll $path 60
set path /sics/${name}/status
hsetprop $path read el737readstatus
hsetprop $path el737status el737status
hsetprop $path el737statval el737statval
hsetprop $path el737statread el737statread
hsetprop $path moncount 0
$conname poll $path 60
set path /sics/${name}/control
hsetprop $path write el737control
hsetprop $path el737cmdreply el737cmdreply
$conname write $path
hfactory /sics/${name}/thresholdcounter plain mugger int
hsetprop /sics/${name}/thresholdcounter __save true
set path /sics/${name}/threshold
hfactory $path plain mugger float
hsetprop $path write el737threshsend
hsetprop $path el737threshrcv el737threshrcv
hsetprop $path el737cmdreply el737cmdreply
$conname write $path
hsetprop $path read el737threshread
hsetprop $path el737thresh el737thresh
# $conname poll $path 60
hfactory /sics/${name}/RS plain internal int
hfactory /sics/${name}/RA plain internal intvarar 8
$conname debug -1
}

97
site_ansto/instrument/pelican/config/tasmad/sicscommon/el755.tcl
View File

@@ -1,97 +0,0 @@
#-------------------------------------------------------------
# This is a scriptcontext driver for the PSI EL755 magnet
# controller.
#
# scriptchains:
# read - readreply
# write - writereply - writereadback
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, November 2009
#--------------------------------------------------------------
namespace eval el755 {}
#--------------------------------------------------------------
proc el755::read {num} {
sct send [format "I %d" $num]
return readreply
}
#--------------------------------------------------------------
proc el755::readreply {num} {
set reply [sct result]
if {[string first ? $reply] >= 0} {
if {[string first ?OV $reply] >= 0} {
sct send [format "I %d" $num]
# clientput "EL755 did an overflow...."
return readreply
}
error $reply
}
set n [stscan $reply "%f %f" soll ist]
if {$n < 2} {
sct send [format "I %d" $num]
clientput "Invalid response $reply from EL755"
return readreply
}
sct update $ist
return idle
}
#------------------------------------------------------------------
proc el755::write {num} {
set cur [sct target]
sct send [format "I %d %f" $num $cur]
return writereply
}
#------------------------------------------------------------------
proc el755::writereply {num} {
set reply [sct result]
if {[string first ? $reply] >= 0} {
if {[string first ?OV $reply] >= 0} {
set cur [sct target]
sct send [format "I %d %f" $num $cur]
# clientput "EL755 did an overflow...."
return writereply
}
error $reply
}
sct send [format "I %d" $num]
return writereadback
}
#--------------------------------------------------------------------
proc el755::writereadback {num} {
set reply [sct result]
if {[string first ? $reply] >= 0} {
if {[string first ?OV $reply] >= 0} {
set cur [sct target]
sct send [format "I %d" $num]
# clientput "EL755 did an overflow...."
return writereadback
}
error $reply
}
set n [stscan $reply "%f %f" soll ist]
if {$n < 2} {
sct send [format "I %d" $num]
clientput "Invalid response $reply from EL755"
return writereadback
}
set cur [sct target]
if {abs($cur - $soll) < .1} {
return idle
}
return el755::write $num
}
#--------------------------------------------------------------------
proc el755::makeel755 {name num sct} {
stddrive::makestddrive $name EL755Magnet $sct
set path /sics/${name}
hsetprop $path read el755::read $num
hsetprop $path readreply el755::readreply $num
hsetprop $path write el755::write $num
hsetprop $path writereply el755::writereply $num
hsetprop $path writereadback el755::writereadback $num
$sct poll $path 60
$sct write $path
}

1773
site_ansto/instrument/pelican/config/tasmad/sicscommon/fourcircle.tcl
View File

File diff suppressed because it is too large Load Diff

BIN
site_ansto/instrument/pelican/config/tasmad/sicscommon/fsync.jar
View File

Binary file not shown.

944
site_ansto/instrument/pelican/config/tasmad/sicscommon/hdbutil.tcl
View File

@@ -1,944 +0,0 @@
#-----------------------------------------------------------------------
# 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
#
# Collected from various files: Mark Koennecke, March 2008
#
# 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} {
set tmppath $home/tmp
} else {
set tmppath $home
}
Publish mgbatch Spy
Publish loadmgbatch Spy
Publish hsearchprop Spy
Publish hdbscan User
Publish hdbprepare User
Publish hdbcollect User
Publish listbatchfiles Spy
Publish makemumopos User
Publish dropmumo User
Publish hdbbatchpath User
Publish cscan User
Publish sscan User
Publish scan Spy
Publish hmake Mugger
Publish hmakescript Mugger
Publish hlink Mugger
Publish hcommand Mugger
Publish hdbstorenexus User
Publish scaninfo Spy
}
#===================================================================
# Configuration commands provided:
# hdbReadOnly
# makesampleenv path
# makestdscan path
# makestdscangraphics path
# makestdbatch
# makeQuickPar name path
# makeslit path left right upper lower
# configures a slit. Missing motors can be indicated with NONE
# makestdadmin
# makecount path
# makerepeat path
# makekillfile path
# makesuccess path
# makestdgui
# makewait path
# makeevproxy rootpath hdbname devicename
# makemumo rootpath mumoname
# makeexe
# confnxhdb path alias pass
# makestddrive path
#===================== hfactory adapters ==========================
proc hmake {path priv type {len 1}} {
hfactory $path plain $priv $type $len
}
#--------------------------------------------------------------------
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]} {
set treename $ob
}
append realpath $path / $treename
hfactory $realpath link $obj
}
#-------------------------------------------------------------------
proc hcommand {path script} {
hfactory $path command $script
}
#================ make XML tree =====================================
proc getdataType {path} {
return [lindex [split [hinfo $path] ,] 0]
}
#---------------------------------------------------------------------
proc makeInitValue {path type prefix} {
append result ""
if {[string compare $type none] != 0 && [string compare $type func] != 0} {
set test [catch {hgetprop $path transfer} msg]
set tst [catch {hval $path} val]
if {$test != 0 && $tst == 0} {
append result "$prefix <initValue>\n"
append result "$prefix $val\n"
append result "$prefix </initValue>\n"
}
}
return $result
}
#----------------------------------------------------------------------
proc make_nodes {path result indent} {
set nodename [file tail $path];
set type [getdataType $path]
set prefix [string repeat " " $indent]
set newIndent [expr $indent + 2]
#array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
set prop_list(control) true
set we_have_control [info exists prop_list(control)]
if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} {
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
foreach p [property_elements $path $newIndent] {
append result $p
}
foreach x [hlist $path] {
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
}
# append result [makeInitValue $path $type $prefix]
append result "$prefix</component>\n"
}
return $result
}
#-------------------------------------------------------------------
proc property_elements_old {path indent} {
set prefix [string repeat " " $indent]
foreach {key value} [string map {= " "} [hlistprop $path]] {
if {[string compare -nocase $key "control"] == 0} {continue}
lappend proplist "$prefix<property id=\"$key\">\n"
# foreach v [split $value ,] {
# lappend proplist "$prefix$prefix<value>$v</value>\n"
# }
lappend proplist "$prefix$prefix<value>$value</value>\n"
lappend proplist "$prefix</property>\n"
}
if [info exists proplist] {return $proplist}
}
#-----------------------------------------------------------------------
proc property_elements {path indent} {
set prefix [string repeat " " $indent]
set data [hlistprop $path]
set propList [split $data \n]
foreach prop $propList {
set pl [split $prop =]
set key [string trim [lindex $pl 0]]
set value [string trim [lindex $pl 1]]
if {[string length $key] < 1} {
continue
}
lappend proplist "$prefix<property id=\"$key\">\n"
lappend proplist "$prefix$prefix<value>$value</value>\n"
lappend proplist "$prefix</property>\n"
}
if [info exists proplist] {return $proplist}
}
#--------------------------------------------------------------------------
proc getgumtreexml {path} {
append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
if {[string compare $path "/" ] == 0} {
foreach n [hlist $path] {
set result [make_nodes /$n $result 2]
}
} else {
foreach n [hlist $path] {
set result [make_nodes $path/$n $result 2]
}
}
append result "</hipadaba:SICS>\n"
}
#==================== Gumtree batch =========================================
proc searchPathForDrivable {name} {
set path [string trim [hmatchprop / sicsdev $name]]
if {[string compare $path NONE] != 0} {
return $path
}
set txt [findalias $name]
if {[string compare $txt NONE] == 0} {
return NONE
}
set l1 [split $txt =]
set l [split [lindex $l1 1] ,]
foreach alias $l {
set alias [string trim $alias]
set path [string trim [hmatchprop / sicsdev $alias]]
if {[string compare $path NONE] != 0} {
return $path
}
}
return NONE
}
#----------------------------------------------------------------
proc searchForCommand {name} {
return [string trim [hmatchprop / sicscommand $name]]
}
#----------------------------------------------------------------
proc treatsscan {scanpath command out} {
set l [split $command]
set len [llength $l]
set noVar [expr ($len-2)/3]
set np [lindex $l [expr $len -2]]
set preset [lindex $l [expr $len -1]]
for {set i 0} {$i < $noVar} {incr i} {
set start [expr $i * 3]
set scanVar [lindex $l [expr 1 + $start]]
set scanStart [lindex $l [expr 2 + $start]]
set scanEnd [lindex $l [expr 3 + $start]]
set scanStep [expr ($scanEnd*1. - $scanStart*1.)/$np*1.]
append hdbVar $scanVar ,
append hdbStart $scanStart ,
append hdbStep $scanStep ,
}
set hdbVar [string trim $hdbVar ,]
set hdbStart [string trim $hdbStart ,]
set hdbStep [string trim $hdbStep ,]
puts $out "\#NODE: $scanpath"
puts $out "clientput BatchPos = 1"
puts $out "hdbscan $hdbVar $hdbStart $hdbStep $np monitor $preset"
}
#----------------------------------------------------------------
proc treatcscan {scanpath command out} {
set l [split $command]
set scanVar [lindex $l 1]
set scanCenter [lindex $l 2]
set scanStep [lindex $l 3]
set np [lindex $l 4]
set preset [lindex $l 5]
set hdbStart [expr $scanCenter - ($np*1.0)/2. * $scanStep*1.0]
puts $out "\#NODE: $scanpath"
puts $out "clientput BatchPos = 1"
puts $out "hdbscan $scanVar $hdbStart $scanStep $np monitor $preset"
}
#----------------------------------------------------------------
proc translateCommand {command out} {
set drivelist [list drive dr run]
set textList [list for while source if]
# clientput "Translating: $command"
set command [string trim $command]
if {[string length $command] < 2} {
return
}
set l [split $command]
set obj [string trim [lindex $l 0]]
#------- check for drive commands
set idx [lsearch $drivelist $obj]
if {$idx >= 0} {
set dev [lindex $l 1]
set path [searchPathForDrivable $dev]
if {[string compare $path NONE] != 0} {
set realTxt [hgetprop $path sicsdev]
set realL [split $realTxt =]
set realDev [lindex $realL 1]
set mapList [list $dev $realDev]
set newCom [string map $mapList $command]
puts $out "\#NODE: $path"
puts $out "clientput BatchPos = 1"
puts $out $newCom
return
}
}
#------ check for well known broken commands
set idx [lsearch $textList $obj]
if {$idx >= 0} {
puts $out "\#NODE: /batch/commandtext"
puts $out "clientput BatchPos = 1"
set buffer [string map {\n @nl@} $command]
puts $out "hset /batch/commandtext $buffer"
return
}
#--------- check for simple commands
set path [searchForCommand $command]
if {[string compare $path NONE] != 0} {
puts $out "\#NODE: $path"
puts $out "clientput BatchPos = 1"
puts $out $command
return
}
set scancom [searchForCommand hdbscan]
#---------- deal with scans
if {[string first sscan $obj] >= 0} {
if {[catch {treatsscan $scancom $command $out}] == 0} {
return
}
}
if {[string first cscan $obj] >= 0} {
if {[catch {treatsscan $scancom $command $out}] == 0} {
return
}
}
#--------- give up: output as a text node
puts $out "\#NODE: /batch/commandtext"
puts $out "clientput BatchPos = 1"
set buffer [string map {\n @nl@} $command]
puts $out "hset /batch/commandtext $buffer"
}
#----------------------------------------------------------------
proc mgbatch {filename} {
global tmppath
set f [open $filename r]
gets $f line
close $f
if {[string first MOUNTAINBATCH $line] > 0} {
#--------- This is a mountaingum batch file which does not need
# to be massaged
return $filename
}
set f [open $filename r]
set realfilename [file tail $filename]
set out [open $tmppath/$realfilename w]
puts $out \#MOUNTAINBATCH
while {[gets $f line] >= 0} {
append buffer $line
if {[info complete $buffer] == 1} {
translateCommand $buffer $out
unset buffer
} else {
append buffer \n
}
}
close $out
return $tmppath/$realfilename
}
#----------------------------------------------------------------
proc loadmgbatch {filename} {
set txt [exe fullpath $filename]
set l [split $txt =]
set realf [lindex $l 1]
set realf [mgbatch $realf]
return [exe print $realf]
}
#============== hdbscan =========================================
proc hdbscan {scanvars scanstart scanincr np mode preset} {
global stdscangraph hdbscanactive
xxxscan clear
xxxscan configure script
xxxscan function prepare hdbprepare
xxxscan function collect hdbcollect
set varlist [split $scanvars ,]
set startlist [split $scanstart ,]
set incrlist [split $scanincr ,]
catch {hset $stdscangraph/scan_variable/name [lindex $varlist 0]}
set count 0
foreach var $varlist {
if {[string first / $var] >= 0} {
set var [string trim [SplitReply [hgetprop $var sicsdev]]]
}
xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count]
incr count
}
set hdbscanactive 1
set status [catch {xxxscan run $np $mode $preset} msg]
set hdbscanactive 0
if {$status == 0} {
return $msg
} else {
error $msg
}
}
#------------------------------------------------------------------------------
proc hdbprepare {obj userdata } {
global stdscangraph
stdscan prepare $obj userdata
catch {hupdate $stdscangraph/dim}
}
#------------------------------------------------------------------------------
proc hdbcollect {obj userobj np} {
global stdscangraph
stdscan collect $obj $userobj $np
catch {hupdate $stdscangraph/scan_variable}
catch {hupdate $stdscangraph/counts}
}
#-----------------------------------------------------------------------------
proc gethdbscanvardata {no} {
set np [string trim [SplitReply [xxxscan np]]]
if {$np == 0} {
return ".0 .0 .0"
}
set status [catch {SplitReply [xxxscan getvardata $no]} txt]
if {$status == 0} {
return [join $txt]
} else {
return ".0 .0 .0"
}
}
#----------------------------------------------------------------------------
proc gethdbscancounts {} {
set np [string trim [SplitReply [xxxscan np]]]
if {$np == 0} {
return "0 0 0"
}
set status [catch {SplitReply [xxxscan getcounts]} txt]
if {$status == 0} {
return [join $txt]
} else {
return "0 0 0"
}
}
#================= helper to get the list of batch files =================
proc listbatchfiles {} {
set ext [list *.tcl *.job *.run]
set txt [SplitReply [exe batchpath]]
set dirlist [split $txt :]
set txt [SplitReply [exe syspath]]
set dirlist [concat $dirlist [split $txt :]]
# clientput $dirlist
set result [list ""]
foreach dir $dirlist {
foreach e $ext {
set status [catch {glob [string trim $dir]/$e} filetxt]
if {$status == 0} {
set filelist [split $filetxt]
foreach f $filelist {
# clientput "Working at $f"
set nam [file tail $f]
if { [lsearch $result $nam] < 0} {
# clientput "Adding $nam"
lappend result $nam
}
}
} else {
# clientput "ERROR: $filetxt"
}
}
}
foreach bf $result {
append resulttxt $bf ,
}
return [string trim $resulttxt ,]
}
#-------------------------------------------------------------------------
proc hsearchprop {root prop val} {
set children [hlist $root]
set childlist [split $children \n]
if {[llength $childlist] <= 0} {
error "No children"
}
foreach child $childlist {
if {[string length $child] < 1} {
continue
}
catch {hgetprop $root/$child $prop} msg
if { [string first ERROR $msg] < 0} {
set value [string trim [SplitReply $msg]]
if { [string equal -nocase $value $val] == 1} {
return $root/$child
}
}
set status [catch {hsearchprop $root/$child $prop $val} node]
if {$status == 0} {
return $node
}
}
error "Not found"
}
#============ various utility routines =====================================
proc hdbReadOnly args {
error "Parameter is READ ONLY"
}
#---------------------------------------------------------------------------
proc makesampleenv {path} {
hfactory $path plain spy none
hsetprop $path type graphdata
hsetprop $path viewer mountaingumui.TimeSeries
hfactory $path/vars plain user text
hset $path/vars tomato
hfactory $path/rank plain user int
hset $path/rank 1
hfactory $path/dim plain user intar 1
hset $path/dim 300
hfactory $path/getdata plain user text
hsetprop $path/getdata type logcommand
hfactory $path/getdata/2010ttime plain spy text
hfactory $path/getdata/2010ime plain spy text
}
#--------------------------------------------------
proc makestdscan {path} {
hfactory $path command hdbscan
hsetprop $path type command
hsetprop $path viewer mountaingumui.ScanEditor
hsetprop $path priv user
hfactory $path/scan_variables plain user text
hsetprop $path/scan_variables argtype drivable
hfactory $path/scan_start plain user text
hfactory $path/scan_increments plain user text
hfactory $path/NP plain user int
hfactory $path/mode plain user text
hsetprop $path/mode values "monitor,timer"
hfactory $path/preset plain user float
}
#---------------------------------------------------
proc makestdscangraphics {path} {
global stdscangraph
set stdscangraph $path
hfactory $path plain spy none
hsetprop $path type graphdata
hsetprop $path viewer default
hattach $path title title
hfactory $path/rank plain mugger int
hset $path/rank 1
hsetprop $path/rank priv internal
hfactory $path/dim script "xxxscan np" hdbReadOnly intar 1
hsetprop $path/dim priv internal
hfactory $path/scan_variable script "gethdbscanvardata 0" hdbReadOnly floatvarar 1
hsetprop $path/scan_variable type axis
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/counts script "gethdbscancounts" hdbReadOnly intvarar 1
hsetprop $path/counts type data
hsetprop $path/counts transfer zip
hsetprop $path/counts priv internal
}
#----------------------------------------------------
proc makeQuickPar {name path} {
hfactory /quickview/$name plain mugger text
hset /quickview/$name $path
}
#---------------------------------------------------
proc makestdbatch {} {
hfactory /batch plain spy none
hfactory /batch/bufferlist script listbatchfiles hdbReadOnly text
sicspoll add /batch/bufferlist hdb 30
hfactory /batch/commandtext plain spy text
hsetprop /batch/commandtext viewer mountaingumui.TextEdit
hsetprop /batch/commandtext commandtext true
hfactory /batch/currentline plain user int
}
#-----------------------------------------------------
proc makeslit {path left right upper bottom} {
hfactory $path plain spy none
hsetprop $path type part
if {![string equal $left NONE]} {
hattach $path $left left
}
if {![string equal $right NONE]} {
hattach $path $right right
}
if {![string equal $upper NONE]} {
hattach $path $upper upper
}
if {![string equal $bottom NONE]} {
hattach $path $bottom bottom
}
}
#---------------------------------------------------------
proc makestdadmin {} {
hfactory /instrument/experiment plain spy none
hattach /instrument/experiment title title
hattach /instrument/experiment user user
set status [catch {hattach /instrument/experiment/user adress address} msg]
if {$status != 0} {
set status [catch {hattach /instrument/experiment/user address address} msg]
}
hattach /instrument/experiment/user phone phone
hattach /instrument/experiment/user email email
hfactory /instrument/experiment/datafilenumber script sicsdatanumber \
hdbReadOnly int
hsetprop /instrument/experiment/datafilenumber priv internal
hfactory /instrument/experiment/batchpath script "exe batchpath" \
hdbbatchpath text
hsetprop /instrument/experiment/batchpath priv user
sicspoll add /instrument/experiment/batchpath hdb 60
sicspoll add /instrument/experiment/datafilenumber hdb 60
}
#----------------------------------------------------------
proc makecount {path} {
hfactory $path command count
hsetprop $path type command
hsetprop $path priv user
hfactory $path/mode plain user text
hsetprop $path/mode values "monitor,timer"
hfactory $path/preset plain user float
hset $path/preset 60000
hset $path/mode monitor
}
#----------------------------------------------------------
proc makerepeat {path} {
hfactory $path command repeat
hsetprop $path type command
hsetprop $path priv user
hfactory $path/num plain user int
hfactory $path/mode plain user text
hsetprop $path/mode values "monitor,timer"
hfactory $path/preset plain user float
hset $path/preset 60000
hset $path/mode monitor
}
#----------------------------------------------------------
proc makekillfile {path} {
hcommand $path killfile
hsetprop $path type command
hsetprop $path priv manager
}
#----------------------------------------------------------
proc makesuccess {path} {
hcommand $path success
hsetprop $path type command
hsetprop $path priv user
}
#-----------------------------------------------------------
proc makestdgui {} {
hfactory /gui plain spy none
hfactory /gui/status plain internal text
status hdbinterest /gui/status
}
#------------------------------------------------------------
proc makewait {path} {
hfactory $path command wait
hsetprop $path type command
hsetprop $path priv user
hfactory $path/time plain user int
}
#------------------------------------------------------------
proc makeevproxy {rootpath hdbname devicename} {
MakeProxy p${devicename} $devicename float
p${devicename} map upperlimit upperlimit float user
p${devicename} map lowerlimit lowerlimit float user
hlink $rootpath p${devicename} $hdbname
hsetprop $rootpath/$hdbname sicsdev $devicename
hsetprop $rootpath/$hdbname type drivable
sicspoll add $rootpath/$hdbname hdb 30
}
#================== multi motor stuff =======================
proc getNamposList {mumo} {
set txt [$mumo list]
set l [split $txt "\n"]
set lala [llength $l]
for {set i 1} {$i < [llength $l]} {incr i} {
set pos [lindex $l $i]
if {[string length $pos] > 1} {
append result [lindex $l $i] ","
}
}
if { ![info exists result] } {
# clientput "nampos = $txt"
append result UNKNOWN
}
return [string trimright $result ","]
}
#------------------------------------------------------------
proc getNamPos {mumo} {
set txt [$mumo find]
set l [split $txt =]
return [string trim [lindex $l 1]]
}
#-----------------------------------------------------------
proc updateNamePosValues {rootpath} {
hupdate $rootpath/namedposition/values
hupdate $rootpath/dropnamedposition/name/values
}
#------------------------------------------------------------
proc makemumopos {mumo rootpath name} {
$mumo pos $name
updateNamePosValues $rootpath
}
#-----------------------------------------------------------
proc dropmumo {mumo rootpath name} {
$mumo drop $name
updateNamePosValues $rootpath
}
#------------------------------------------------------------
proc getDropList {mumo} {
set txt [getNamposList $mumo]
append txt ",all"
return $txt
}
#-------------------------------------------------------------
proc makemumo {rootpath mumoname} {
hfactory $rootpath/namedposition script "getNamPos $mumoname" \
$mumoname text
hsetprop $rootpath/namedposition priv user
hfactory $rootpath/namedposition/values script \
"getNamposList $mumoname" hdbReadOnly text
hsetprop $rootpath/namedposition/values visible false
hupdate $rootpath/namedposition/values
hfactory $rootpath/assignname2current command \
"makemumopos $mumoname $rootpath"
hsetprop $rootpath/assignname2current priv user
hsetprop $rootpath/assignname2current type command
hfactory $rootpath/assignname2current/name plain user text
hset $rootpath/assignname2current/name "Undefined"
hfactory $rootpath/dropnamedposition command \
"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
}
#-----------------------------------------------------------------
proc hdbbatchpath {pathstring} {
exe batchpath $pathstring
catch {batchroot $pathstring}
catch {hupdate /instrument/commands/batch/execute/file/values}
catch {hupdate /instrument/commands/batch/batchpath}
catch {hupdate /instrument/experiment/batchpath}
catch {hupdate /batch/bufferlist}
}
#------------------------------------------------------------------
proc makeexe {} {
set path /instrument/commands/batch
hfactory $path plain spy none
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 priv user
hfactory $path/execute/file plain user text
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
sicspoll add $path/execute/file/values hdb 60
}
#------------------------------------------------------------------
proc confnxhdb {path alias pass} {
hsetprop $path nxalias $alias
hsetprop $path nxpass $pass
}
#----------------------------------------------------------------------
proc hdbstorenexus args {
if {[llength $args] < 2} {
error "hdbstorenexus called with insufficient number of arguments"
}
set path [lindex $args 0]
set pass [lindex $args 1]
set childlist [split [hlist $path] \n]
foreach child $childlist {
if {[string length $child] < 1} {
continue
}
set status [catch {hgetpropval $path/$child nxpass} passval]
if {$status == 0} {
set status [catch {hgetpropval $path/$child nxslab} slabval]
# ------- slabbed writing
if {$status == 0 && [string first $pass $passval] >= 0} {
set slabsizes [eval $slabval [lrange $args 2 end]]
nxscript puthdbslab $path/$child [lindex $slabsizes 0] [lindex $slabsizes 1]
}
#--------- normal writing
if {[string first $pass $passval] >= 0} {
nxscript puthdb $path/$child
}
}
eval hdbstorenexus $path/$child $pass [lrange $args 2 end]
}
}
#===================== 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
# 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
#
# Mark Koennecke, August 1997
#
# Reworked for hdbscan, Mark Koennecke, November 2008
#-----------------------------------------------------------------------------
proc cscan { var center delta np preset } {
#------ start with some argument checking
set t [SICSType $var]
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]
return
}
set t [SICSType $delta]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: %s is no number!" $delta]
return
}
set t [SICSType $np]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: %s is no number!" $np]
return
}
set t [SICSType $preset]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: %s is no number!" $preset]
return
}
set mode [string trim [SplitReply [scan mode]]]
#-------- store command in lastscancommand
set txt [format "cscan %s %s %s %s %s" $var $center \
$delta $np $preset]
catch {lastscancommand $txt}
#--------- calculate start and do scan
set start [expr $center - $np * $delta]
set ret [catch {hdbscan $var $start $delta [expr ($np * 2) + 1] $mode $preset} msg]
if { $ret != 0} {
error $msg
} else {
return $msg
}
}
#---------------------------------------------------------------------------
proc sscan args {
scan clear
#------- check arguments: the last two must be preset and np!
set l [llength $args]
if { $l < 5} {
ClientPut "ERROR: Insufficient number of arguments to sscan"
return
}
set preset [lindex $args [expr $l - 1]]
set np [lindex $args [expr $l - 2]]
set t [SICSType $preset]
ClientPut $t
ClientPut [string first $t "NUM"]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: expected number for preset, got %s" \
$preset]
return
}
set t [SICSType $np]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: expected number for np, got %s" \
$np]
return
}
#--------- do variables
set nvar [expr ($l - 2) / 3]
for { set i 0 } { $i < $nvar} { incr i } {
set var [lindex $args [expr $i * 3]]
set t [SICSType $var]
if {[string compare $t DRIV] != 0} {
ClientPut [format "ERROR: %s is not drivable" $var]
return
}
set start [lindex $args [expr ($i * 3) + 1]]
set t [SICSType $start]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: expected number for start, got %s" \
$start]
return
}
set end [lindex $args [expr ($i * 3) + 2]]
set t [SICSType $end]
if { [string compare $t NUM] != 0 } {
ClientPut [format "ERROR: expected number for end, got %s" \
$end]
return
}
#--------- do scan parameters
append scanvars $var ","
append scanstarts $start ","
set step [expr double($end - $start)/double($np-1)]
append scansteps $step ","
}
#------------- set lastcommand text
set txt [format "sscan %s" [join $args]]
catch {lastscancommand $txt}
#------------- start scan
set scanvars [string trim $scanvars ,]
set scanstarts [string trim $scanstarts ,]
set scansteps [string trim $scansteps ,]
set mode [string trim [SplitReply [scan mode]]]
set ret [catch {hdbscan $scanvars $scanstarts $scansteps $np $mode $preset} msg]
if {$ret != 0} {
error $msg
} else {
return $msg
}
}
#------------------------------------------------------------------------------
proc splitScanVar {txt} {
set l1 [split $txt =]
set var [lindex $l1 0]
set vl [split $var .]
lappend result [lindex $vl 1]
lappend result [string trim [lindex $l1 1]]
lappend result [string trim [lindex $l1 2]]
}
#-----------------------------------------------------------------------------
proc scaninfo {} {
set novar [string trim [SplitReply [xxxscan noscanvar]]]
if {$novar == 0} {
return "0,1,NONE,0.,0.,default.dat"
}
append result "scaninfo = "
append result [string trim [SplitReply [xxxscan np]]] "," $novar
for {set i 0} {$i < $novar} {incr i} {
set vl [splitScanVar [xxxscan getvarpar $i]]
append result ", " [lindex $vl 0]
}
set vl [splitScanVar [xxxscan getvarpar 0]]
append result "," [lindex $vl 1]
append result "," [lindex $vl 2]
append result "," [SplitReply [xxxscan getfile]]
append result "," [SplitReply [sample]]
append result "," [sicstime]
append result "," [SplitReply [lastscancommand]]
return $result
}
#-------------------------------------------------------------
proc scan args {
if {[llength $args] < 1} {
error "Need keyword for scan"
}
set key [string trim [lindex $args 0]]
switch $key {
uuinterest { return [xxxscan uuinterest] }
pinterest {}
getcounts { set cts [SplitReply [xxxscan getcounts]]
return "scan.Counts = $cts"
}
mode {
if {[llength $args] > 1} {
return [counter mode [lindex $args 1]]
} else {
return [counter mode]
}
}
clear {
return [xxxscan clear]
}
default {
error "scan does not support keyword $key"
}
}
}
#-------------------------------------------------------------
proc makestddrive {path} {
hfactory $path command drive
hsetprop $path type command
hsetprop $path viewer mountaingumui.DriveEditor
hsetprop $path priv user
hfactory $path/motor plain user text
hsetprop $path/motor argtype drivable
hfactory $path/value plain user float
}

BIN
site_ansto/instrument/pelican/config/tasmad/sicscommon/kt.sinqbck
View File

Binary file not shown.

82
site_ansto/instrument/pelican/config/tasmad/sicscommon/motorhp.tcl
View File

@@ -1,82 +0,0 @@
#---------------------------------------------------------------------------
# These scripts save and load motor positions for EL734 motors connected
# directly to SICS through the terminal server. For all others, use
# David Madens el734_motor program
#
# Mark Koennecke, April 2004
#-------------------------------------------------------------------------
if { ![info exists motorhpscript] } {
set motorhpscript 1
Publish motorinternsave Mugger
Publish motorsave Mugger
Publish motorload Mugger
Publish loadmotordir Mugger
Publish savemotorarray Mugger
}
#----------------------------------------------------------------------
# save motor parameters from controller, number to file described by
# file descriptor fd
#----------------------------------------------------------------------
proc motorinternsave {controller number fd} {
lappend parlist mn ec ep a fd fm d e f g h j k l m q t v w z mem
puts $fd [format "%s send ec %d 0 0" $controller $number]
foreach e $parlist {
set data [$controller send $e $number]
puts $fd [format "%s send %s %d %s" $controller $e $number $data]
}
}
#----------------------------------------------------------------------
# save a motor parameter set to a directory. The filename is automatically
# created in order to help motorload
#---------------------------------------------------------------------
proc motorsave {controller number dirname} {
set filename [format "%s/%s%2.2d.par" $dirname $controller $number]
set f [open $filename w]
motorinternsave $controller $number $f
close $f
}
#----------------------------------------------------------------------------
# Loading motor parameters. Because some of the commands change the position
# of the motor, the position is saved first and redefined after processing
# the data. It is assumed that the filename is in the format as made
# by motorsave.
#---------------------------------------------------------------------------
proc motorload {filename} {
set fil [file tail $filename]
set ind [string last . $fil]
set number [string range $fil [expr $ind - 2] [expr $ind - 1]]
set controller [string range $fil 0 [expr $ind - 3]]
set pos [$controller send u $number]
fileeval $filename
$controller send uu $number $pos
}
#--------------------------------------------------------------------------
# load a motor directory
#------------------------------------------------------------------------
proc loadmotordir {dirname} {
set l [glob $dirname/*.par]
foreach e $l {
set ret [catch {motorload $e} msg]
if { $ret != 0} {
clientput "ERROR: failed to load $e with $msg"
}
}
}
#-----------------------------------------------------------------------
# save a whole array of motors. The array must have the following form:
# An entry: controllerlist conatins a list of all controllers
# There exists an entry with the controller name in the array which contains
# a list of motor number
#------------------------------------------------------------------------
proc savemotorarray {motar dir} {
upvar $motar motorarray
set controllerList $motorarray(controllerlist)
foreach controller $controllerList {
set motlist $motorarray($controller)
foreach mot $motlist {
motorsave $controller $mot $dir
}
}
}

126
site_ansto/instrument/pelican/config/tasmad/sicscommon/nxsupport.tcl
View File

@@ -1,126 +0,0 @@
#===========================================================================
# Support routines for scripting NeXus files with nxscript.
#
# Mark Koennecke, February 2003
# Mark Koennecke, January 2004
#==========================================================================
proc makeFileName args {
sicsdatanumber incr
set num [SplitReply [sicsdatanumber]]
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]
}
#==========================================================================
# new version, attending to the new 1000 grouping logic
proc newFileName args {
set ret [catch {nxscript makefilename} msg]
if {$ret != 0} {
clientput "ERROR: Misconfiguration of file writing variables"
clientput "Defaulting filename to emergency.hdf"
set fil emergency.hdf
} else {
set fil $msg
}
return $fil
}
#==========================================================================
proc writeFloatVar {alias var} {
set ret [catch {set val [SplitReply [$var]]} val]
if { $ret != 0} {
clientput [format "ERROR: failed to read %s, %s" $var $val]
return
} else {
set val [string trim $val]
set ret [catch {expr $val * 1.0} val]
if { $ret == 0} {
nxscript putfloat $alias [expr $val * 1.0 ]
} else {
clientput "ERROR: bad value $val when reading $var"
}
}
}
#==========================================================================
proc writeIntVar {alias var} {
set ret [catch {set val [SplitReply [$var]]} val]
if { $ret != 0} {
clientput [format "ERROR: failed to read %s, %s" $var $val]
return
} else {
set val [string trim $val]
set ret [catch {expr $val * 1.0} val]
if { $ret == 0} {
nxscript putint $alias [expr int($val * 1.0) ]
} else {
clientput "ERROR: bad value $val when reading $var"
}
}
}
#=========================================================================
proc writeTextVar {alias var} {
set ret [catch {$var} val]
if { $ret != 0} {
clientput [format "ERROR: failed to read %s" $var]
return
} else {
set index [string first = $val]
if {$index >= 0} {
set txt [string trim [string range $val [expr $index + 1] end]]
nxscript puttext $alias $txt
} else {
clientput [format "ERROR: failed to read %s" $var]
}
}
}
#========================================================================
proc writeTextAttribute {attName var} {
set ret [catch {set val [SplitReply [$var]]} val]
if { $ret != 0} {
clientput [format "ERROR: failed to read %s" $var]
return
} else {
nxscript putglobal $attName [string trim $val]
}
}
#=======================================================================
proc writeStandardAttributes {fileName} {
nxscript putglobal file_name $fileName
nxscript putglobal file_time [sicstime]
writeTextAttribute instrument instrument
writeTextAttribute owner user
writeTextAttribute owner_telephone_number phone
writeTextAttribute owner_fax_number fax
writeTextAttribute owner_email email
writeTextAttribute owner_address address
}
#---------------------------------------------------------------------
proc appendMotor {np motor alias} {
set val [SplitReply [$motor]]
__transfer putfloat 0 $val
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
}
#---------------------------------------------------------------------
proc appendCount {np value alias} {
__transfer putint 0 $value
nxscript putslab $alias [list $np] [list 1] __transfer
}
#--------------------------------------------------------------------
proc appendSampleEnv {np device alias} {
#--------- test for presence
set status [catch {SplitReply [$device]} val]
if {$status != 0} {
return
}
#--------- test for validity
set status [catch {expr $val * 1.0} msg]
if {$status != 0} {
return
}
appendFloat $np $alias $val
}

311
site_ansto/instrument/pelican/config/tasmad/sicscommon/phytron.tcl
View File

@@ -1,311 +0,0 @@
#------------------------------------------------------------------
# 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.
#
# 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.
# 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
# in the following way:
# 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
#
# Position ever afterwards with 0XAwert, read encoder with 0XP22R
#
# While driving 0X=H return ACKN, else ACKE
#
# Stopping goes via 0XSN
#
# copyright: see file COPYRIGHT
#
# Script chains:
#
# - reading position:
# readpos - posrcv
#
# - writing postion:
# setpos - setrcv
#
# - reading status:
# sendstatus - rcvstatus - statpos
#
# - reading speed:
# readspeed - rcvspeed
#
# - setting speed:
# writespeed - rcvwspeed - rcvspeed
#
# Mark Koennecke, June 2009
#
# Added code to switch a brake on for schneider_m2
#
# 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
# read another parameter for position
#
# Mark Koennecke, January 2011
#-------------------------------------------------------------------------
namespace eval phytron {}
#-----------------------------------------------------------------------
proc phytron::check {} {
set data [sct result]
if {[string first AscErr $data] >= 0} {
error $data
}
return $data
}
#------------------------------------------------------------------------
proc phytron::readpos {axis enc} {
# the following command must be P20R without encoder, P22R with encoder
if {$enc == 1} {
sct send "0${axis}P22R"
} else {
sct send "0${axis}P20R"
}
return posrcv
}
#------------------------------------------------------------------------
proc phytron::posrcv {} {
set data [phytron::check]
set pos [string range $data 3 end]
sct update $pos
return idle
}
#------------------------------------------------------------------------
proc phytron::setpos {axis name} {
set val [sct target]
sct send "0${axis}A$val"
hupdate /sics/${name}/status run
return setrcv
}
#------------------------------------------------------------------------
proc phytron::setrcv {controller name} {
set data [phytron::check]
if {[string first NACK $data] >= 0} {
error "Invalid command"
}
$controller queue /sics/${name}/status progress read
return idle
}
#-------------------------------------------------------------------------
proc phytron::sendstatus {axis} {
sct send "0${axis}=H"
return rcvstatus
}
#-------------------------------------------------------------------------
proc phytron::rcvstatus {axis controller enc} {
set status [catch {phytron::check} data]
if {$status != 0} {
sct update error
clientput $error
}
if {[string first ACKN $data] >= 0} {
sct update run
$controller queue [sct] progress read
}
if {[string first ACKE $data] >= 0} {
phytron::readpos $axis $enc
return posrcv
}
return idle
}
#-------------------------------------------------------------------------
proc phytron::statpos {axis name} {
set data [phytron::check]
set pos [string range $data 3 end]
hupdate /sics/${name}/hardposition $pos
sct send "0${axis}=I+"
return statposlim
}
#------------------------------------------------------------------------
proc phytron::statposlim {axis} {
set data [phytron::check]
if {[string first ACKE $data] >= 0} {
sct update error
clientput "Hit positive limit switch"
return idle
}
sct send "0${axis}=I-"
return statneglim
}
#------------------------------------------------------------------------
proc phytron::statneglim {axis} {
set data [phytron::check]
if {[string first ACKE $data] >= 0} {
sct update error
clientput "Hit negative limit switch"
return idle
}
sct send "0${axis}=E"
return statend
}
#------------------------------------------------------------------------
proc phytron::statend {axis} {
set data [phytron::check]
if {[string first ACKE $data] >= 0} {
sct update error
clientput "Electronics error"
return idle
}
sct update idle
return idle
}
#------------------------------------------------------------------------
proc phytron::readspeed {axis} {
sct send "0${axis}P14R"
return rcvspeed
}
#------------------------------------------------------------------------
proc phytron::rcvspeed {} {
set data [phytron::check]
set speed [string range $data 3 end]
sct update $speed
return idle
}
#------------------------------------------------------------------------
proc phytron::writespeed {axis} {
set val [sct target]
sct send "0${axis}P14S$val"
return rcvwspeed
}
#------------------------------------------------------------------------
proc phytron::rcvwspeed {axis} {
set data [phytron::check]
if {[string first NACK $data] >= 0} {
error "Invalid command"
}
return [phytron::readspeed $axis]
}
#-------------------------------------------------------------------------
proc phytron::halt {controller axis} {
$controller send "0${axis}SN"
return Done
}
#--------------------------------------------------------------------------
proc phytron::refrun {name controller axis lowlim} {
set path /sics/${name}/status
$controller send "0${axis}0-"
hupdate $path run
set motstat run
wait 3
while {[string compare $motstat run] == 0} {
$controller queue $path progress read
wait 1
set motstat [string trim [hval $path]]
}
$controller transact "0${axis}P20S$lowlim"
$controller transact "0${axis}P22S$lowlim"
return Done
}
#-------------------------------------------------------------------------
proc phytron::defpos {controller axis value} {
$controller transact "0${axis}P20S$value"
$controller transact "0${axis}P22S$value"
return Done
}
#--------------------------------------------------------------------------
proc phytron::make {name axis controller lowlim upperlim {enc 1}} {
MakeSecMotor $name
hdel /sics/${name}/hardupperlim
hdel /sics/${name}/hardlowerlim
hfactory /sics/${name}/hardupperlim plain internal float
hfactory /sics/${name}/hardlowerlim plain internal float
$name hardlowerlim $lowlim
$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
$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
$controller poll /sics/${name}/status 60
hfactory /sics/${name}/speed plain user float
hsetprop /sics/${name}/speed read "phytron::readspeed $axis"
hsetprop /sics/${name}/speed rcvspeed "phytron::rcvspeed"
hsetprop /sics/${name}/speed write "phytron::writespeed $axis"
hsetprop /sics/${name}/speed rcvwspeed "phytron::rcvwspeed $axis"
$controller poll /sics/${name}/speed 60
$controller write /sics/${name}/speed
$name makescriptfunc halt "phytron::halt $controller $axis" user
$name makescriptfunc refrun "phytron::refrun $name $controller $axis $lowlim" user
$name makescriptfunc sethardpos "phytron::defpos $controller $axis" user
hfactory /sics/${name}/sethardpos/value plain user float
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
# to be disabled before driving and enabled after driving. The code below adds this feature to
# a phytron motor
#-----------------------------------------------------------------------------------------------
proc phytron::openset {out} {
sct send [format "0A%dS" $out]
return openans
}
#----------------------------------------------------------------------------------------------
proc phytron::openans {axis name} {
after 100
return [phytron::setpos $axis $name]
}
#----------------------------------------------------------------------------------------------
proc phytron::outsend {axis out} {
set data [phytron::check]
if {[string first ACKE $data] >= 0} {
sct update error
clientput "Electronics error"
return idle
}
sct send [format "0A%dR" $out]
return outend
}
#----------------------------------------------------------------------------------------------
proc phytron::outend {} {
sct update idle
return idle
}
#----------------------------------------------------------------------------------------------
proc phytron::configureM2 {motor axis out} {
set path /sics/${motor}
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 outend phytron::outend
}

177
site_ansto/instrument/pelican/config/tasmad/sicscommon/pimotor.tcl
View File

@@ -1,177 +0,0 @@
#----------------------------------------------------
# This is a scriptcontext motor driver for the
# prehistoric Physik Instrumente DC-406, C-804 DC
# motor controller.
#
# copyright: see file COPYRIGHT
#
# Scriptchains:
# - read - readreply
# - write - writerepy
# - sendstatus - statusreply - statuspos
# - speedread - readreply
# - writespeed - speedreply
# - writenull - speedreply
#
# Mark Koennecke, November 2009, after the
# C original from 1998
# Made to work, Mark Koennecke, January 2011
#-----------------------------------------------------
namespace eval pimotor {}
#----------------------------------------------------
proc pimotor::read {num} {
sct send [format "%1.1dTP" $num]
return readreply
}
#----------------------------------------------------
proc pimotor::readreply {} {
set result [sct result]
if {[string first ? $result] >= 0} {
error $result
}
if {[string first ERR $result] >= 0} {
error $result
}
set val [string range $result 3 end]
sct update $val
return idle
}
#----------------------------------------------------
proc pimotor::write {num name} {
set ival [expr int([sct target])]
# After a stop, the motor is switched off. In order to fix this
# we switch the motor on for each drive command
sct send [format "%1.1dMN,%1.1dMA%10.10d{0}" $num $num $ival]
hupdate /sics/${name}/status run
return writereply
}
#----------------------------------------------------
proc pimotor::writereply {name} {
# the DC-406 does not reply on this, so we have for sure a
# timeout here which we ignore. We do nothing else, as we
# need a little wait anyway to get the motor to start
# before starting to check status.
#----------------------------------------------------
wait 1
set con [sct controller]
hset /sics/${name}/status run
$con queue /sics/${name}/status progress read
return idle
}
#-----------------------------------------------------
proc pimotor::sendstatus {num} {
sct send [format "%1.1dTV" $num]
return statusreply
}
#------------------------------------------------------
proc pimotor::statusreply {num} {
set result [sct result]
if {[string first ? $result] >= 0} {
sct update error
error $result
}
if {[string first ERR $result] >= 0} {
sct update error
error $result
}
set val [string trimleft [string range $result 3 13] "0-"]
set val [string trim $val]
if {[string length $val] > 1} {
set len [string length $val]
clientput "Value = $val, length = $len"
if {abs($val) > 0} {
sct update run
[sct controller] queue [sct] progress read
return idle
}
}
pimotor::read $num
return statuspos
}
#------------------------------------------------------
proc pimotor::statuspos {name} {
set result [sct result]
if {[string first ? $result] >= 0} {
error $result
}
if {[string first ERR $result] >= 0} {
error $result
}
set val [string range $result 3 end]
hupdate /sics/${name}/hardposition $val
sct update idle
return idle
}
#-------------------------------------------------------
proc pimotor::readspeed {num} {
sct send [format "%1.1dTY" $num]
return readreply
}
#--------------------------------------------------------
proc pimotor::writespeed {num} {
sct send [format "%1.1dSV%7.7d" $num [sct target]]
return speedreply
}
#----------------------------------------------------
proc pimotor::speedreply {num} {
pimotor::readspeed $num
return readreply
}
#-----------------------------------------------------
proc pimotor::writenull {controller num} {
$controller send [format "%1.1dDH{0}" $num]
return Done
}
#------------------------------------------------------
proc pimotor::writeon {controller num} {
$controller send [format "%1.1dMN{0}" $num]
return Done
}
#------------------------------------------------------
proc pimotor::halt {controller num} {
$controller send [format "%1.1dAB{0}" $num]
return Done
}
#------------------------------------------------------
proc pimotor::makepimotor {name num sct lowlim upperlim} {
MakeSecMotor $name
hdel /sics/${name}/hardupperlim
hdel /sics/${name}/hardlowerlim
hfactory /sics/${name}/hardupperlim plain internal float
hfactory /sics/${name}/hardlowerlim plain internal float
$name hardlowerlim $lowlim
$name softlowerlim $lowlim
$name hardupperlim $upperlim
$name softupperlim $upperlim
hsetprop /sics/${name}/hardposition read pimotor::read $num
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
$sct poll /sics/${name}/speed 120
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
}

66
site_ansto/instrument/pelican/config/tasmad/sicscommon/secsim.tcl
View File

@@ -1,66 +0,0 @@
#---------------------------------------------------------------
# This is a second generation simulation motor.
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, December 2008
#----------------------------------------------------------------
proc simhardset {motname newval} {
hset /sics/$motname/starttime [clock sec]
}
#--------------------------------------------------------------
proc simhardget {motname} {
set stat [hval /sics/$motname/status]
set val [hval /sics/$motname/targetposition]
if {[string first run $stat] >= 0 \
|| [string first error $stat] >= 0 } {
return [expr $val -.777]
} else {
return $val
}
}
#-------------------------------------------------------------
proc simhardfaultget {motname} {
set val [hval /sics/$motname/targetposition]
return [expr $val - .5]
}
#--------------------------------------------------------------
proc simstatusget {motname} {
set start [hval /sics/$motname/starttime]
if {$start < 0} {
return error
}
set delay [hval /sics/$motname/delay]
if {[clock sec] > $start + $delay} {
return idle
} else {
return run
}
}
#-------------------------------------------------------------
proc simstatusfault {motname } {
clientput "ERROR: I am feeling faulty!"
return error
}
#--------------------------------------------------------------
proc simhalt {motname} {
hset /sics/$motname/starttime -100
}
#---------------------------------------------------------------
proc MakeSecSim {name lower upper delay} {
MakeSecMotor $name
hfactory /sics/$name/delay plain user text
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
hdel /sics/$name/status
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
hupdate /sics/$name/hardlowerlim $lower
hupdate /sics/$name/softlowerlim $lower
}

91
site_ansto/instrument/pelican/config/tasmad/sicscommon/simhm.tcl
View File

@@ -1,91 +0,0 @@
#-----------------------------------------------------
# This is a simulation driver for the second
# generation histogram memory. It provides
# for a fill value which is used to initialize
# data.
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, January 2010
#-----------------------------------------------------
namespace eval simhm {}
#-----------------------------------------------------
proc simhm::getcontrol {name} {
return -9999.99
}
#----------------------------------------------------
proc simhm::setcontrol {name val} {
switch $val {
1000 {
hset /sics/${name}/internalstatus run
set pp [hval /sics/${name}/preset]
hset /sics/${name}/finishtime [expr $pp + [clock seconds]]
return idle
}
1001 {
hset /sics/${name}/internalstatus error
return idle
}
1002 {
hset /sics/${name}/internalstatus pause
return idle
}
1003 {
hset /sics/${name}/internalstatus run
return idle
}
1005 {
return idle
}
default {
clientput "ERROR: bad start target $target given to control"
return idle
}
}
}
#----------------------------------------------------
proc simhm::getstatus {name} {
set status [string trim [hval /sics/${name}/internalstatus]]
if {[string first run $status] >= 0} {
set fin [string trim [hval /sics/${name}/finishtime]]
if {[clock seconds] > $fin} {
hset /sics/${name}/internalstatus idle
set val [string trim [hval /sics/${name}/initval]]
$name set $val
set second [string trim [hval /sics/${name}/secondbank]]
if {[string compare $second NULL] != 0} {
harray /sics/${name}/${second} init $val
}
}
}
return $status
}
#-----------------------------------------------------
proc simhm::MakeSimHM {name rank {tof NULL} } {
MakeSecHM $name $rank $tof
hfactory /sics/${name}/initval plain user int
hset /sics/${name}/initval 0
hfactory /sics/${name}/finishtime plain user int
hfactory /sics/${name}/internalstatus plain user text
hupdate /sics/${name}/internalstatus idle
hdel /sics/${name}/control
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
hsetprop /sics/${name}/control priv user
hupdate /sics/${name}/status idle
hfactory /sics/${name}/secondbank plain user text
hupdate /sics/${name}/secondbank NULL
}
#------------------------------------------------------
proc simhm::makeSecond {name bankname length} {
hfactory /sics/${name}/${bankname} plain user intvarar $length
hupdate /sics/${name}/secondbank $bankname
}

152
site_ansto/instrument/pelican/config/tasmad/sicscommon/sinqhttp.tcl
View File

@@ -1,152 +0,0 @@
#--------------------------------------------------------
# This is an asynchronous scriptcontext driven driver for
# the SINQ style http based histogram memory.
#
# script chains:
# -- control
# hmhttpcontrol - hmhttpreply
# -- data
# hmhttpdata - hmhttpreply
# -- status
# hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, May 2009
#
# You will need to override hmhttpevalstatus to implement
# an update of the detector data
#
# Mark Koennecke, April 2010
#---------------------------------------------------------
proc hmhttpsend {url} {
sct send $url
return hmhttpreply
}
#--------------------------------------------------------
proc hmhttptest {data} {
if {[string first ASCERR $data] >= 0} {
error $data
}
if {[string first ERROR $data] >= 0} {
error $data
}
return $data
}
#--------------------------------------------------------
proc hmhttpreply {} {
set reply [sct result]
set status [catch {hmhttptest $reply} data]
if {$status != 0} {
sct geterror $data
clientput $data
} else {
hdelprop [sct] geterror
}
return idle
}
#---------------------------------------------------------
proc hmhttpcontrol {} {
set target [sct target]
switch $target {
1000 {
set ret [hmhttpsend "/admin/startdaq.egi"]
set path [file dirname [sct]]
[sct controller] queue $path/status progress read
return $ret
}
1001 {return [hmhttpsend "/admin/stopdaq.egi"] }
1002 {return [hmhttpsend "/admin/pausedaq.egi"] }
1003 {return [hmhttpsend "/admin/continuedaq.egi"]}
1005 {
set path [file dirname [sct]]
set script [hval $path/initscript]
set confdata [eval $script]
return [hmhttpsend "post:/admin/configure.egi:$confdata"]
}
default {
sct print "ERROR: bad start target $target given to control"
return idle
}
}
}
#---------------------------------------------------------
proc hmhttpdata {name} {
set len [hval /sics/${name}/datalength]
set path "/sics/${name}/data"
set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len]
sct send $com
return hmhttpdatareply
}
#--------------------------------------------------------
proc hmhttpdatareply {} {
set status [catch {hmhttpreply} txt]
if {$status == 0} {
set path [file dirname [sct]]
hdelprop $path/data geterror
}
return idle
}
#--------------------------------------------------------
proc hmhttpstatus {} {
sct send /admin/textstatus.egi
return hmhttpevalstatus
}
#-------------------------------------------------------
proc hmhttpstatusdata {} {
catch {hmhttpdatareply}
sct update idle
return idle
}
#---------------------------------------------------------
proc hmhttpevalstatus {name} {
set reply [sct result]
set status [catch {hmhttptest $reply} data]
if {$status != 0} {
sct geterror $data
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} {
sct update run
[sct controller] queue [sct] progress read
return idle
} else {
if {[string compare $old idle] != 0} {
hmhttpdata $name
return hmhttpstatusdata
} else {
return idle
}
}
}
#---------------------------------------------------------
proc MakeHTTPHM {name rank host initscript {tof NULL} } {
sicsdatafactory new ${name}transfer
makesctcontroller ${name}sct sinqhttp $host ${name}transfer 600 spy 007
MakeSecHM $name $rank $tof
hsetprop /sics/${name}/control write hmhttpcontrol
hsetprop /sics/${name}/control hmhttpreply hmhttpreply
${name}sct write /sics/${name}/control
hsetprop /sics/${name}/data read hmhttpdata $name
hsetprop /sics/${name}/data hmhttpdatareply hmhttpdatareply
${name}sct poll /sics/${name}/data 120
hsetprop /sics/${name}/status read hmhttpstatus
hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name
hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata
${name}sct poll /sics/${name}/status 60
hfactory /sics/${name}/initscript plain mugger text
hset /sics/${name}/initscript $initscript
}

100
site_ansto/instrument/pelican/config/tasmad/sicscommon/stddrive.tcl
View File

@@ -1,100 +0,0 @@
#------------------------------------------------------
# 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
# checking. It can serve as a basis for creating
# new drivable objects, for instance environment
# control devices. A possible user has as the
# first thing in a write script to set the target
# node to the desired value.
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, November 2009
#--------------------------------------------------------
namespace eval stddrive {}
proc stddrive::stdcheck {name} {
set val [sct target]
set upper [hval /sics/${name}/upperlimit]
set lower [hval /sics/${name}/lowerlimit]
if {$val < $lower || $val > $upper} {
error "$val is out of range $lower - $upper for $name"
}
return OK
}
#-------------------------------------------------------
proc stddrive::stdstatus {name} {
set test [catch {sct geterror} errortxt]
if {$test == 0} {
return fault
}
set stop [hval /sics/${name}/stop]
if {$stop == 1} {
return fault
}
set target [sct target]
set tol [hval /sics/${name}/tolerance]
set is [hval /sics/${name}]
if {abs($target - $is) < $tol} {
return idle
} else {
[sct controller] queue /sics/${name} progress read
return busy
}
}
#-------------------------------------------------------
proc stddrive::stop {name} {
hset /sics/${name}/stop 1
return OK
}
#-------------------------------------------------------
proc stddrive::deread {} {
sct update -9999.99
return idle
}
#--------------------------------------------------------
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]
set nodelist [split [hlist /sics/${name}] \n]
foreach node $nodelist {
if {[string length $node] < 1} {
continue
}
if {[lsearch -exact $allowed [string trim $node]] < 0} {
clientput "Deleting $node"
hdel /sics/${name}/${node}
}
}
hsetprop /sics/${name} read stddrive::deread
hsetprop /sics/${name} write stddrive::dewrite $name
}
#--------------------------------------------------------
proc stddrive::makestddrive {name sicsclass sct} {
makesctdriveobj $name float user $sicsclass $sct
hfactory /sics/${name}/tolerance plain user float
hset /sics/${name}/tolerance 2.0
hfactory /sics/${name}/upperlimit plain user float
hset /sics/${name}/upperlimit 300
hfactory /sics/${name}/lowerlimit plain user float
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
hupdate /sics/${name} -9999.99
}

8
site_ansto/instrument/pelican/config/tasmad/sicscommon/syncwrapper.pag
View File

@@ -1,8 +0,0 @@
#!/usr/bin/pagsh.openafs
dir=$1
export KRB5CCNAME=`/bin/mktemp /tmp/sinqbckXXXXXX`
/usr/kerberos/bin/kinit -k -t $dir/kt.sinqbck sinqbck@PSI.CH
/usr/bin/aklog -c psi.ch -k PSI.CH
$dir/$2
/usr/bin/unlog
/usr/kerberos/bin/kdestroy

317
site_ansto/instrument/pelican/config/tasmad/sicscommon/table.tcl
View File

@@ -1,317 +0,0 @@
#----------------------------------------------------------------------
# Support functions for table processing in SICS
#
# This includes a CSV processing module from someone else. See below.
#
# copyright: see file COPYRIGHT
#
# Mark Koennecke, November 2008
#----------------------------------------------------------------------
if { [info exists __tableheader] == 0 } {
set __tableheader NULL
Publish tableexe User
Publish loop User
}
#=====================================================================
# Csv tcl package version 2.0
# 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
# list2csv list ?separator?
# which converts line from CSV file to list and vice versa.
#
# Both functions have optional "separator argument" becouse some silly
# Windows
# program might use semicomon as delimiter in COMMA separated values
# file.
#
# Copyright (c) SoftWeyr, 1997-99
# Many thanks to Robert Seeger <rseeger1@nycap.rr.com>
# for beta-testing and fixing my misprints
# This file is distributed under GNU Library Public License. Visit
# http://www.gnu.org/copyleft/gpl.html
# for details.
#
# Convert line, read from CSV file into proper TCL list
# Commas inside quoted strings are not considered list delimiters,
# Double quotes inside quoted strings are converted to single quotes
# Double quotes are stripped out and replaced with correct Tcl quoting
#
proc csv2list {str {separator ","}} {
#build a regexp>
set regexp [subst -nocommands \
{^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}]
set regexp1 [subst -nocommands {$regexp[ \t\r\n]*$separator\(.*)$}]
set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}]
set list {}
while {[regexp $regexp1 $str junk1 unquoted quoted\
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
}
lappend list $unquoted
if {[uplevel info exist csvtail]} {
uplevel set csvtail {""}
}
} else {
if {[uplevel info exist csvtail]} {
uplevel [list set csvtail $str]
} else {
return -code error -errorcode {CSV 1 "CSV parse error"}\
"CSV parse error: unparsed tail \"$str\""
}
}
return $list
}
proc list2csv {list {separator ","}} {
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
} else {
regsub -all {"} $elem {""} selem
lappend l "\"$selem\""
}
}
return [join $l $separator]
}
proc csvfile {f {separator ","}} {
set csvtail ""
set list {}
set buffer {}
while {[gets $f line]>=0} {
if {[string length $csvtail]} {
set line "$csvtail\n$line"
} elseif {![string length $line]} {
lappend list {}
continue
}
set rec [csv2list $line $separator]
set buffer [concat $buffer $rec]
if {![ string length $csvtail]} {
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 {}
set buffer {}
foreach line [split $str "\n"] {
if {[string length $csvtail]} {
set line "$csvtail\n$line"
} elseif {![string length $line]} {
lappend list {}
continue
}
set rec [csv2list $line $separator]
set buffer [concat $buffer $rec]
if {![ string length $csvtail]} {
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
# 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
# the necessity to have the count or whatever command as the last thing in the row
#--------------------------------------------------------------------------------
proc testinterrupt {} {
set int [getint]
if {[string first continue $int] < 0} {
error "Interrupted"
}
}
#--------------------------------------------------------------------------------
proc processtablerow {line} {
global __tableheader
set parlist [csv2list $line]
for {set i 0} {$i < [llength $__tableheader]} {incr i} {
set type [lindex $__tableheader $i]
set data [lindex $parlist $i]
#--------- first process special types
switch $type {
monitor {
lappend laterExe "count monitor $data"
continue
}
timer {
lappend laterExe "count timer $data"
continue
}
compar {
append command [join [lrange $parlist $i end]]
lappend laterExe $command
break
}
command {
lappend laterExe $data
continue
}
batch {
lappend laterExe "exe $data"
continue
}
}
#----------- now look for drivables
set test [sicstype $type]
if {[string compare $test DRIV] == 0} {
set status [catch {run $type $data} msg]
if {$status != 0} {
clientput "ERROR: $msg for $type with $data"
}
continue
}
#------------- now look for special objects
set objtype [sicsdescriptor $type]
switch $objtype {
SicsVariable -
MulMot -
Macro {
set status [catch {eval $type $data} msg]
if {$status != 0} {
clientput "ERROR: $msg for $type with $data"
}
continue
}
default {
clientput "Skipping non recognized column $type with data $data"
}
}
}
set status [catch {success} msg]
if {$status != 0} {
clientput "ERROR: $msg while waiting for motors to arrive"
}
testinterrupt
foreach command $laterExe {
eval $command
testinterrupt
}
}
#------------------------------------------------------------------------
proc tableexe {tablefile} {
global __tableheader
if {[string first NULL $__tableheader] < 0} {
error "Tableexe already running, terminated"
}
set fullfile [SplitReply [exe fullpath $tablefile]]
set in [open $fullfile r]
gets $in header
set __tableheader [csv2list $header]
while {[gets $in line] > 0} {
set status [catch {processtablerow $line} msg]
if {$status != 0} {
set int [getint]
if {[string first continue $int] < 0} {
break
} else {
clientput "ERROR: $msg while processing row"
}
}
}
close $in
set __tableheader NULL
return "Done processing table"
}
#---------------------------------------------------------------------------
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"
}
set len [lindex $args 0]
set command [lrange $args 1 end]
for {set i 1} {$i <= $len} {incr i} {
clientput "Repetition $i of $len"
set status [catch {eval [join $command]} msg]
if {$status != 0} {
clientput "ERROR: $msg while processing loop command"
}
testinterrupt
}
}
#==============================================================================
# This is an old attempt
#=============================================================================
proc __tablescan__ args {
global __tableheader
set idx [lsearch $__tableheader monitor]
if {$idx >= 0} {
set preset [lindex $args $idx]
set mode monitor
}
set idx [lsearch $__tableheader timer]
if {$idx >= 0} {
set preset [lindex $args $idx]
set mode timer
}
set idx [lsearch $__tableheader scanvar]
if {$idx >= 0} {
set var [lindex $args $idx]
} else {
error "ERROR: No scan variable in table"
}
set idx [lsearch $__tableheader scanstart]
if {$idx >= 0} {
set start [lindex $args $idx]
} else {
error "ERROR: No scan start in table"
}
set idx [lsearch $__tableheader scanend]
if {$idx >= 0} {
set end [lindex $args $idx]
} else {
error "ERROR: No scan end in table"
}
set idx [lsearch $__tableheader scanstep]
if {$idx >= 0} {
set step [lindex $args $idx]
} else {
error "ERROR: No scan step in table"
}
set np [expr abs($end - $start)/$step]
xxxscan var $var $start $step
xxxscan run $np $mode $preset
}

23
site_ansto/instrument/pelican/config/tasmad/sicscommon/tecs.tcl
View File

@@ -1,23 +0,0 @@
#------------------------------------------------------------------------
# tecs: a script to turn on and off temperature
#
# M. Zolliker, Jun 00
#------------------------------------------------------------------------
#--------- some code to do proper initialization if necessary
set ret [catch {tecs} msg]
if {$ret != 0} {
Publish tecs User
}
proc tecs { { arg1 "on"} { arg2 ""} { arg3 ""} } {
if {[string compare $arg1 "off"]==0 } {
evfactory del temperature
return "removed temperature"
} elseif {[string compare $arg1 "on"]==0 } {
evfactory new temperature tecs
return "installed temperature via TECS"
} else {
temperature $arg1 $arg2 $arg3
}
}

348
site_ansto/instrument/pelican/config/tasmad/taspub_sics/nxtas.tcl
View File

@@ -1,348 +0,0 @@
#-------------------------------------------------------------------------
# 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}
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
} else {
clientput "WARNING: failed to read $motor"
}
}
#------------------------------------------------------------------
proc appendIfPresent {np obj alias} {
# sea_get is defined in ~/sea/tcl/remob.tcl
set status [catch {sea_get val $obj} msg]
if {$status != 0} {
return
}
if {$msg} {
__transfer putfloat 0 $val
nxscript putslab $alias [list $np] [list 1] __transfer
}
}
#------------------------------------------------------------------
proc appendFloat {np alias val} {
if {[string length $val] > 0} {
__transfer putfloat 0 $val
nxscript putslab $alias [list $np] [list 1] __transfer
} else {
clientput "WARNING: failed to read $alias"
}
}
#-------------------------------------------------------------------
proc appendCount {np value alias} {
__transfer putint 0 $value
nxscript putslab $alias [list $np] [list 1] __transfer
}
#--------------------------------------------------------------------
proc donothing {obj userobj} {
}
#---------------------------------------------------------------------
proc xmlprepare {obj userobj} {
global __tasdata
#------- normal prepare
tasscan prepare $obj $userobj
#--------- parse out variable
set out [tasSplit [output]]
if {[string compare [string toupper $out] "UNKNOWN"]==0} {
set out ""
}
set out [string map { "=" " " "," " "} $out]
set outlist [split $out]
foreach var $outlist {
if { [string length $var] > 1} {
set ret [catch {tasSplit [$var]} msg]
if {$ret == 0} {
lappend __tasdata(out) $var
}
}
}
#------- build Header
append head " PNT "
set scanvars [split [tasSplit [iscan getscanvars]]]
foreach var $scanvars {
if { [string length $var] > 1} {
append head [format "%9s " [string toupper $var]]
}
}
foreach var $__tasdata(out) {
append head [format "%9s " [string toupper $var]]
}
append head [format "%8s " M1]
append head [format "%8s " M2]
append head [format "%8s " TIME]
append head [format "%8s " CNTS]
append head [format "%8s " CTOT]
clientput $head
set __tasdata(starttime) [sicstime]
xmltaswrite $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
lappend storedvars $var
}
}
foreach var $__tasdata(out) {
append line [format "%9.4f " [tasSplit [eval $var]]]
appendMotor $np $var sc_$var
lappend storedvars $var
}
append line [format "%8d " [tasSplit [counter getmonitor 1]]]
append line [format "%8d " [tasSplit [counter getmonitor 2]]]
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]]
set varlist [list qh qk ql qm en ei ef a1 a2 a3 a4 a5 a6 sgu sgl]
foreach var $varlist {
if {[lsearch $storedvars $var] < 0} {
appendMotor $np $var sc_${var}
}
}
if {$np == 0} {
makeTASLinks
}
nxscript close
}
#====================== actual XML stuff ============================
proc writeUserData {} {
writeTextVar usnam user
writeTextVar usaff affiliation
writeTextVar usadd address
writeTextVar usmail email
writeTextVar lonam local
}
#-------------------------------------------------------------------
proc writeMonochromator {} {
global __tasdata
nxscript puttext mono_type "Pyrolytic Graphite"
appendMotor 0 mcv sc_mcv
nxscript putfloat mono_dd [tasSplit [tasub mono dd]]
}
#-------------------------------------------------------------------
proc writeAnalyzer {} {
global __tasdata
nxscript puttext ana_type "Pyrolytic Graphite"
nxscript putfloat ana_dd [tasSplit [tasub ana dd]]
set sa [tasSplit [tasub ss]]
if {$sa == 1} {
set az 0.
} else {
set az 180.
}
nxscript putfloat ana_az $az
}
#-------------------------------------------------------------------
proc writeDetector {} {
global __tasdata
set sa [tasSplit [tasub ana ss]]
if {$sa == 1} {
set az 0.
} else {
set az 180.
}
nxscript putfloat det_az $az
}
#-------------------------------------------------------------------
proc writeMonitor {} {
nxscript putcounter cter counter
}
#-----------------------------------------------------------------
proc writeSample {} {
global __tasdata
tasscan nxdump nxscript sa
writeTextVar sanam sample
set sa [tasSplit [tasub mono ss]]
if {$sa == 1} {
set az 0.
} else {
set az 180.
}
nxscript putfloat saaz $az
}
#-----------------------------------------------------------------
proc writePowderSample {} {
global __tasdata
tasscan nxdump nxscript sa
writeTextVar sanam sample
set sa [tasSplit [tasub mono ss]]
if {$sa == 1} {
set az 0.
} else {
set az 180.
}
nxscript putfloat saaz $az
}
#------------------------------------------------------------------
proc makeTASLinks {} {
nxscript makelink dana sc_ei
nxscript makelink dana sc_ef
nxscript makelink dana sc_qh
nxscript makelink dana sc_qk
nxscript makelink dana sc_ql
nxscript makelink dana sc_en
nxscript makelink dana counts
}
#------------------------------------------------------------------
proc makePowderLinks {} {
nxscript makelink dana sc_ei
nxscript makelink dana sc_ef
nxscript makelink dana sc_qm
nxscript makelink dana sc_en
nxscript makelink dana counts
}
#-------------------------------------------------------------------
proc makeScanLinks {} {
set alreadyLinked [list sc_ei sc_ef sc_qh sc_qf sc_qk sc_en sc_qm]
set nscan [tasSplit [iscan noscanvar]]
set axis 0
for {set i 0} {$i < $nscan} {incr i } {
set varpar [iscan getvarpar $i]
set l [split $varpar =]
set var [lindex $l 0]
set idx [string first . $var]
set var [string range $var [expr $idx + 1] end]
set alias [format "sc_%s" [string trim $var]]
set testalias [string trim [tasSplit [nxscript isalias $alias]]]
if {[lsearch $alreadyLinked $alias] < 0} {
if {$testalias == 1} {
nxscript makelink dana $alias
}
}
if {$axis == 0} {
set step [string trim [lindex $l 2]]
if {abs($step) > .001} {
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} {
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]
}
}
#--------------------------------------------------------------------
proc xmltaswrite {obj userobj} {
global home __tasdata
set fil [string trim [tasSplit [iscan getfile]]]
nxscript createxml $fil $home/tasub.dic
set __tasdata(file) $fil
writeTextVar etitle title
nxscript puttext estart $__tasdata(starttime)
nxscript puttext eend [sicstime]
nxscript puttext edef NXmonotas
nxscript putglobal file_name $fil
nxscript putglobal file_time [sicstime]
nxscript updatedictvar NP [tasSplit [iscan np]]
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
writeUserData
writeMonochromator
writeMonitor
writeSample
writeAnalyzer
writeDetector
nxscript close
}
#--------------------------------------------------------------------
proc xmlpowderwrite {obj userobj} {
global home __tasdata
set fil [string trim [tasSplit [iscan getfile]]]
nxscript createxml $fil $home/tasub.dic
set __tasData(file) $fil
writeTextVar etitle title
nxscript puttext estart $__tasdata(starttime)
nxscript puttext eend [sicstime]
nxscript puttext edef NXmonotas
nxscript putglobal file_name $fil
nxscript putglobal file_time [sicstime]
nxscript updatedictvar NP [tasSplit [iscan np]]
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
writeUserData
writeMonochromator
writeMonitor
writePowderSample
writeAnalyzer
writeDetector
makePowderLinks
nxscript close
}
#--------------------------------------------------------------------
proc xmlfinish {obj userobj} {
}
#----------------------------------------------------------------------
proc initxmlscan {} {
iscan configure script
iscan function writeheader donothing
iscan function prepare xmlprepare
iscan function drive tasscan drive
iscan function count tasscan count
iscan function collect tasscan collect
iscan function writepoint xmlwritepoint
iscan function finish xmlfinish
}

83
site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.dic
View File

@@ -1,83 +0,0 @@
##NXDICT-1.0
#-----------------------------------------------------------------------
# NeXus dictionary file for a triple axis spectrometer following
# the instrument definition as of May 2005
#
# Do not modify this file if you do not knwo what you are doing,
# you may corrupt your data files!
#
# Mark Koennecke, May 2005
#----------------------------------------------------------------------
NP=1
INSTRUMENT=TASUB
#--------- entry level
etitle=/entry1,NXentry/SDS title -type NX_CHAR -rank 1
estart=/entry1,NXentry/SDS start_time -type DFNT_CHAR -rank 1
eend=/entry1,NXentry/SDS end_time -type DFNT_CHAR -rank 1
edef=/entry1,NXentry/SDS definition -type DFNT_CHAR -rank 1 \
-attr {URL,http://www.nexus.anl.gov/instruments/xml/NXmonotas.xml} \
-attr {version,1.0}
#---------- looser
usnam=/entry1,NXentry/user,NXuser/SDS name -type NX_CHAR -rank 1
usaff=/entry1,NXentry/user,NXuser/SDS affiliation -type NX_CHAR -rank 1
usadd=/entry1,NXentry/user,NXuser/SDS address -type NX_CHAR -rank 1
usmail=/entry1,NXentry/user,NXuser/SDS email -type NX_CHAR -rank 1
#---------- local contact
lonam=/entry1,NXentry/local_contact,NXuser/SDS name -type NX_CHAR -rank 1
#------------- sample
sanam=/entry1,NXentry/sample,NXsample/SDS name -type NX_CHAR -rank 1
sa_cell=/entry1,NXentry/sample,NXsample/SDS unit_cell -rank 1 -dim {6}
sa_norm=/entry1,NXentry/sample,NXsample/SDS plane_normal -rank 1 -dim {3}
sa_vec1=/entry1,NXentry/sample,NXsample/SDS plane_vector_1 -rank 1 -dim {3}
sa_vec2=/entry1,NXentry/sample,NXsample/SDS plane_vector_2 -rank 1 -dim {3}
sa_ub=/entry1,NXentry/sample,NXsample/SDS orientation_matrix -rank 2 \
-dim {3,3}
sapol=/entry1,NXentry/sample,NXsample/SDS polar_angle \
-rank 1 -attr {units,degree}
saa3=/entry1,NXentry/sample,NXsample/SDS rotation_angle \
-rank 1 -attr {units,degree}
sasgl=/entry1,NXentry/sample,NXsample/SDS sgl \
-rank 1 -attr {units,degree}
sasgu=/entry1,NXentry/sample,NXsample/SDS sgu \
-rank 1 -attr {units,degree}
saqh=/entry1,NXentry/sample,NXsample/SDS Qh -rank 1
saqk=/entry1,NXentry/sample,NXsample/SDS Qk -rank 1
saql=/entry1,NXentry/sample,NXsample/SDS Ql -rank 1
saqm=/entry1,NXentry/sample,NXsample/SDS Qm -rank 1
saen=/entry1,NXentry/sample,NXsample/SDS energy_transfer -rank 1 \
-attr {units,mev}
saaz=/entry1,NXentry/sample,NXsample/SDS azimuthal_angle -attr {units,degree}
#----------- monochromator
mono_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS type -type NX_CHAR -rank 1
mono_e=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS energy -rank 1 -dim {$(NP)} \
-attr {units,mev}
mono_theta=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle \
-rank 1 -dim {$(NP)} -attr {units,degree}
mono_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS d_spacing -attr {units,Angstroem}
#----------- analyzer
ana_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS type -type NX_CHAR -rank 1
ana_e=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS energy -rank 1 -dim {$(NP)} \
-attr {units,mev}
ana_theta=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle \
-rank 1 -dim {$(NP)} -attr {units\,degree}
ana_pol=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle -rank 1 -dim {$(NP)} \
-attr {units,degree}
ana_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS d_spacing -attr {units,Angstroem}
ana_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS azimuthal_angle -attr {units,degree}
#--------- detector
det_pol=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle -rank 1 -dim {$(NP)} \
-attr {units,degree}
counts=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS counts -type NX_INT32 -rank 1 -dim {$(NP)} \
-attr {units,degree} -attr {signal,1}
det_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS azimuthal_angle -attr {units,degree}
#------- monitors
cter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR -rank 1 -dim {30}
cter_preset=/entry1,NXentry/control,NXmonitor/SDS preset
motime=/entry1,NXentry/control,NXmonitor/SDS time -attr {units,seconds} -rank 1 -dim {$(NP)}
mo01=/entry1,NXentry/control,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {$(NP)}
mo02=/entry1,NXentry/sample_stage,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {$(NP)}
#------- NXdata
dana=/entry1,NXentry/data,NXdata/NXVGROUP

19
site_ansto/instrument/pelican/config/tasmad/taspub_sics/tas.hdd
View File

@@ -1,19 +0,0 @@
*************************** TOPSI Data File ********************************
Title = !!VAR(Title)!!
User = !!VAR(User)!!
File Creation Stardate: !!DATE!!
****************************************************************************
Monochromator Lamda = !!DRIV(lambda)!!
Monochromator A1 = !!DRIV(A1)!!
Monochromator A2 = !!DRIV(A2)!!
----------------------------------------------------------------------------
Sample STL = !!DRIV(STL)!!
Sample STU = !!DRIV(STU)!!
Sample SGL = !!DRIV(SGL)!!
Sample SGU = !!DRIV(SGU)!!
Zero STL = !!ZERO(STL)!!
Zero STU = !!ZERO(STU)!!
Zero SGL = !!ZERO(SGL)!!
Zero SGU = !!ZERO(SGU)!!
!!SCANZERO!!
**************************** DATA ******************************************

286
site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasp.tcl
View File

@@ -1,286 +0,0 @@
# --------------------------------------------------------------------------
# Initialization script for Triple Axis Instruments using the
# Mark Lumsden UB matrix calculus
#
# Dr. Mark Koennecke, May 2005
#---------------------------------------------------------------------------
# O P T I O N S
#--------------------------------------------------------------------------
# simMode
# - 0 real instrument
# - 1 development simulation
# - 2 simserver at instrument
#--------------------------------------------------------------------------
set simMode 1
set ts psts230.psi.ch
set mupad 0
#---------- Enable this for more startup debugging
protocol set all
#--------------- define home
if {$simMode == 1} {
set home $env(HOME)/src/workspace/sics/sim/taspub_sics
set scripthome $home
set loghome $env(HOME)/src/workspace/sics/sim/tmp
set datahome $loghome
ServerOption LoggerDir $env(HOME)/src/workspace/sics/test/samenv
} else {
set home /home/taspub
set scripthome $home/taspub_sics
set loghome $home/log
set datahome $home/data/2010
ServerOption LoggerDir $home/sea/logger
}
#ServerOption RedirectFile $loghome/stdtas
ServerOption ReadTimeOut 10
ServerOption AcceptTimeOut 10
ServerOption ReadUserPasswdTimeout 500000
ServerOption LogFileBaseName $loghome/tasplog
ServerOption ServerPort 2911
ServerOption InterruptPort 2917
ServerOption LogFileDir $loghome
ServerOption QuieckPort 2108
ServerOption statusfile $datahome/taspubstat.tcl
# Telnet Options
ServerOption TelnetPort 1301
ServerOption TelWord sicslogin
#---------------------------------------------------------------------------
# U S E R S
# Here the SICS users are specified
# Syntax: SicsUser name password userRightsCode
#SicsUser Spy 007 3
#---------------------------------------------------------------------------
SicsUser Spy 007 1
SicsUser Manager Manager 1
SicsUser lnsmanager lnsSICSlns 1
SicsUser user 10lns1 2
SicsUser taspuser 10lns1 2
#---------------------------------------------------------------------------
# M O T O R S
if {$simMode == 0} {
MakeRS232Controller mota $ts 3002
mota replyterminator 0xd
mota timeout 1000
mota send "RMT 1"
mota send "ECHO 0"
mota send "RMT 1"
mota send "ECHO 0"
#mota debug 1
Motor A1 el734hp mota 1 # Monochromator Theta
a1 interruptmode 1
Motor A2 el734hp mota 9 # Monochromator Two-Theta
a2 interruptmode 1
Motor A3 el734hp mota 10 # Sample theta or omega
a3 interruptmode 1
Motor A4 el734hp mota 11 # Sample Two-Theta
a4 interruptmode 1
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
MakeRS232Controller motb $ts 3003
motb replyterminator 0xd
motb timeout 1000
motb send "RMT 1"
motb send "ECHO 0"
motb send "RMT 1"
motb send "ECHO 0"
Motor A5 el734hp motb 5 # Analyzer Theta
a5 interruptmode 1
Motor A6 el734hp motb 9 # Analyzer Two-Theta
a6 interruptmode 1
Motor ACH el734hp motb 6 # Analyzer curvature horizontal
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 CSC SIM -30. 30. -.1 2. # Collimator changer
mcv precision .1
} else {
Motor A1 sim -86.7 6.1 -.1 .1 # Monochromator Theta
Motor A2 sim -128.5 -21.65 -.1 .1 # Monochromator Two-Theta
Motor A3 sim -179 170 -.1 .1 # Sample theta or omega
Motor A4 sim -135 137.9 -.1 .1 # Sample Two-Theta
Motor A5 sim -103 103 -.1 .1 # Analyzer Theta
Motor A6 sim -138 118 -.1 .1 # Analyzer Two-Theta
Motor MCV sim -9 124 -.1 .1 # Monochromator curvature vertical
Motor SRO sim -180 351 -.1 .1 # Sample table second ring
Motor ACH sim -.5 11 -.1 .1 # Analyzer curvature horizontal
Motor MTL sim -17 17 -.1 .1 # Monochromator translation lower
Motor MTU sim -17 17 -.1 .1 # Monochromator Translation upper
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
#--------------------------------------------------------------------------
# C U R R E N T S
Motor I1 sim -2 2 -0.1 0.1
Motor I2 sim -2 2 -0.1 0.1
Motor I3 sim -2 2 -0.1 0.1
Motor I4 sim -2 2 -0.1 0.1
Motor I5 sim -2 2 -0.1 0.1
Motor I6 sim -2 2 -0.1 0.1
Motor I7 sim -2 2 -0.1 0.1
Motor I8 sim -2 2 -0.1 0.1
}
#--------- script for saving motor parameters
Publish savemotorpar Mugger
proc savemotorpar {dir} {
set mot(controllerlist) [list mota motb]
set mot(mota) [list 1 9 10 11 3 12 4 5 7]
set mot(motb) [list 5 9 6 1 2 7 8 3 4 11]
savemotorarray mot $dir
clientput "Done saving motor parameters"
}
#--------------------------------------------------------------------------
# C O U N T E R
#--------------------------------------------------------------------------
if {$simMode == 0} {
MakeCounter counter el737hp $ts 3004
} else {
MakeCounter counter sim -1.
}
#--------------------------------------------------------------------------
VarMake instrument Text Mugger
instrument TASPUB
instrument lock
VarMake title Text User
VarMake user Text User
VarMake affiliation Text User
VarMake address Text User
VarMake email Text User
VarMake lastscancommand Text User
VarMake output Text User
VarMake local Text User
VarMake sample Text User
#--------------------------------------------------------------------------
# I N S T A L L M U P A D
#-------------------------------------------------------------------------
if {$mupad == 1} {
source $scripthome/mupad.tcl
# new mupad commands by M.Z.
set mudata(sim) 0
source $scripthome/muco.tcl
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
}
}
#------------------------------------------------------------------------
# Polarisation file
VarMake polfile Text User
#-------------------------------------------------------------------------
# Datafile generation variables
VarMake SicsDataPath Text Mugger
SicsDataPath "$datahome/"
sicsdatapath lock
VarMake SicsDataPrefix Text Mugger
SicsDataPrefix taspub
SicsDataPrefix lock
VarMake SicsDataPostFix Text Mugger
SicsDataPostFix ".xml"
#SicsDataPostFix ".scn"
SicsDataPostFix lock
MakeDataNumber SicsDataNumber "$datahome/DataNumber"
#----------------------------------------------------------------------
# Collimation etc. parameters
#----------------------------------------------------------------------
VarMake alf1 Float User
VarMake alf2 Float User
VarMake alf3 Float User
VarMake alf4 Float User
VarMake bet1 Float User
VarMake bet2 Float User
VarMake bet3 Float User
VarMake bet4 Float User
VarMake ETAM Float User
VarMake ETAS Float User
VarMake ETAA Float User
#-----------------------------------------------------------------------
# A helper variable for the status display
#-----------------------------------------------------------------------
VarMake scaninfo text Internal
scaninfo "0,Unknown,1.0,.1"
#------------------------------------------------------------------------
# I N S T A L L S P E C I A L T A S C O M M A N D S
#------------------------------------------------------------------------
MakeTasUB tasub
#--------------------------- TAS scan command
MakeScanCommand iscan counter tas.hdd recover.bin
MakePeakCenter iscan
MakeTasScan iscan tasub
#-------------------------- new exe manager
definealias do exe
alias batchroot exe batchpath
#-------------------------- normal drive command
MakeDrive
#-------------------------- for NeXus
MakeNXScript
#------------------------------------------------------------------------
# I N S T A L L T A S U B S C R I P T E D C O M M A N D S
#------------------------------------------------------------------------
source $scripthome/taspubcom.tcl
#--------------------------------------------------------------------------
# stuff for sea
if {$simMode == 0} {
definealias tem temperature
source $home/sea/tcl/remob.tcl
connect_sea
#-------------------------------------------------------------------------
# SPS to look at guide field
#------------------------------------------------------------------------
MakeSPS sps $ts 3006 10
}
restore
sicscron 10 backupCron $datahome/statusHistory

47
site_ansto/instrument/pelican/config/tasmad/taspub_sics/taspubcom.tcl
View File

@@ -1,47 +0,0 @@
#---------------------------------------------------------------------------
# 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.
#
# Mark Koennecke, May 2005
#--------------------------------------------------------------------------
proc SplitReply { text } {
set l [split $text =]
return [string trim [lindex $l 1]]
}
source $scripthome/nxtas.tcl
source $scripthome/nxsupport.tcl
source $scripthome/tasscript.tcl
initxmlscan
#------------------------------------------------------------------------
proc wwwsics {} {
append result "<table BORDER=2>\n"
append result "<tr><th>User</th> <td>" [tasSplit [user]] "</td></tr>\n"
append result "<tr><th>Title</th> <td>"
append result [tasSplit [title]] "</td></tr>\n"
append result "<tr><th>Status</th> <td>"
append result [tasSplit [status]] "</td></tr>\n"
append result "<tr><th>Last Scan Command</th> <td>"
append result [tasSplit [lastcommand]] "</td></tr>\n"
append result "<tr><th>A1</td><td>"
append result [tasSplit [a1]] "</td><th>A2</th><td>"
append result [tasSplit [a2]] "</td></tr>\n"
append result "<tr><th>A3</td><td>"
append result [tasSplit [a3]] "</td><th>A4</th><td>"
append result [tasSplit [a4]] "</td></tr>\n"
append result "<tr><th>A5</td><td>"
append result [tasSplit [a5]] "</td><th>A6</th><td>"
append result [tasSplit [a6]] "</td></tr>\n"
append result "<tr><th>Ki</th><td>" [tasSplit [ki]] "</td>"
append result "<th>Kf</th><td>" [tasSplit [kf]] "</td>"
append result "<th>En</th><td>" [tasSplit [en]] "</td></tr>\n"
append result "<tr><th>Qh</th><td>" [tasSplit [qh]] "</td>"
append result "<th>Qk</th><td>" [tasSplit [qk]] "</td>"
append result "<th>Ql</th><td>" [tasSplit [ql]] "</td></tr>\n"
append result "</table>\n"
}

1517
site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasscript.tcl
View File

File diff suppressed because it is too large Load Diff

138
site_ansto/instrument/pelican/config/tasmad/taspub_sics/tasub.dic
View File

@@ -1,138 +0,0 @@
##NXDICT-1.0
#-----------------------------------------------------------------------
# NeXus dictionary file for a triple axis spectrometer following
# the instrument definition as of May 2005
#
# Do not modify this file if you do not knwo what you are doing,
# you may corrupt your data files!
#
# Mark Koennecke, May 2005
# Mark Koennecke, August 2006
# Change to new NeXus standards, Mark Koennecke, February 2007
#----------------------------------------------------------------------
NP=1
INSTRUMENT=TASPUB
#--------- entry level
etitle=/entry1,NXentry/SDS title -type NX_CHAR -rank 1
instrument=/entry1,NXentry/SDS instrument -type NX_CHAR -rank 1
escancommand=/entry1,NXentry/SDS scancommand -type NX_CHAR -rank 1
escanvars=/entry1,NXentry/SDS scanvars -type NX_CHAR -rank 1
estart=/entry1,NXentry/SDS start_time -type DFNT_CHAR -rank 1
eend=/entry1,NXentry/SDS end_time -type DFNT_CHAR -rank 1
edef=/entry1,NXentry/SDS definition -type DFNT_CHAR -rank 1 \
-attr {URL,http://www.nexus.anl.gov/instruments/xml/NXmonotas.xml} \
-attr {version,1.0}
#---------- looser
usnam=/entry1,NXentry/user,NXuser/SDS name -type NX_CHAR -rank 1
usaff=/entry1,NXentry/user,NXuser/SDS affiliation -type NX_CHAR -rank 1
usadd=/entry1,NXentry/user,NXuser/SDS address -type NX_CHAR -rank 1
usmail=/entry1,NXentry/user,NXuser/SDS email -type NX_CHAR -rank 1
#---------- local contact
lonam=/entry1,NXentry/local_contact,NXuser/SDS name -type NX_CHAR -rank 1
#------------- sample
sa_temperature=/entry1,NXentry/sample,NXsample/SDS temperature \
-attr {units,K} -rank 1 -dim {-1}
sc_tt=/entry1,NXentry/sample,NXsample/SDS temperature \
-attr {units,K} -rank 1 -dim {-1}
sa_field=/entry1,NXentry/sample,NXsample/SDS magnetic_field \
-attr {units,Tesla} -rank 1 -dim {-1}
sc_temperature=/entry1,NXentry/sample,NXsample/SDS temperature \
-attr {units,K} -rank 1 -dim {-1}
sc_te=/entry1,NXentry/sample,NXsample/SDS temperature \
-attr {units,K} -rank 1 -dim {-1}
sc_field=/entry1,NXentry/sample,NXsample/SDS magnetic_field \
-attr {units,Tesla} -rank 1 -dim {-1}
sc_mf=/entry1,NXentry/sample,NXsample/SDS magnetic_field \
-attr {units,Tesla} -rank 1 -dim {-1}
sanam=/entry1,NXentry/sample,NXsample/SDS name -type NX_CHAR -rank 1
sa_cell=/entry1,NXentry/sample,NXsample/SDS unit_cell -rank 1 -dim {6}
sa_norm=/entry1,NXentry/sample,NXsample/SDS plane_normal -rank 1 -dim {3}
sa_vec1=/entry1,NXentry/sample,NXsample/SDS plane_vector_1 -rank 1 -dim {9}
sa_vec2=/entry1,NXentry/sample,NXsample/SDS plane_vector_2 -rank 1 -dim {9}
sa_ub=/entry1,NXentry/sample,NXsample/SDS orientation_matrix -rank 2 \
-dim {3,3}
sc_a2=/entry1,NXentry/sample,NXsample/SDS polar_angle \
-rank 1 -attr {units,degree} -dim {-1}
sc_a3=/entry1,NXentry/sample,NXsample/SDS rotation_angle \
-rank 1 -attr {units,degree} -dim {-1}
sc_sgl=/entry1,NXentry/sample,NXsample/SDS sgl \
-rank 1 -attr {units,degree} -dim {-1}
sc_sgu=/entry1,NXentry/sample,NXsample/SDS sgu \
-rank 1 -attr {units,degree} -dim {-1}
2tm_zero=/entry1,NXentry/sample,NXsample/SDS polar_angle_zero \
-rank 1 -attr {units,degree}
om_zero=/entry1,NXentry/sample,NXsample/SDS rotation_angle_zero \
-rank 1 -attr {units,degree}
sgl_zero=/entry1,NXentry/sample,NXsample/SDS sgl_zero \
-rank 1 -attr {units,degree}
sgu_zero=/entry1,NXentry/sample,NXsample/SDS sgu_zero \
-rank 1 -attr {units,degree}
sc_qh=/entry1,NXentry/sample,NXsample/SDS Qh -rank 1 -dim {-1}
sc_qk=/entry1,NXentry/sample,NXsample/SDS Qk -rank 1 -dim {-1}
sc_ql=/entry1,NXentry/sample,NXsample/SDS Ql -rank 1 -dim {-1}
sc_qm=/entry1,NXentry/sample,NXsample/SDS Qm -rank 1 -dim {-1}
sc_en=/entry1,NXentry/sample,NXsample/SDS energy_transfer -rank 1 \
-attr {units,mev} -dim {-1}
saaz=/entry1,NXentry/sample,NXsample/SDS azimuthal_angle -attr {units,degree}
sc_tu=/entry1,NXentry/sample,NXsample/SDS x \
-rank 1 -attr {units,degree} -dim {-1}
sc_tl=/entry1,NXentry/sample,NXsample/SDS y \
-rank 1 -attr {units,degree} -dim {-1}
#----------- monochromator
mono_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS type -type NX_CHAR -rank 1
sc_ei=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS energy -rank 1 -dim {-1} \
-attr {units,mev} -dim {-1}
sc_a1=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle \
-rank 1 -dim {-1} -attr {units,degree} -dim {-1}
omm_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS rotation_angle_zero \
-rank 1 -dim {-1} -attr {units,degree}
mono_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS d_spacing -attr {units,Angstroem}
sc_mcv=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS curvature \
-rank 1 -dim {-1} -attr {units,degree}
sc_cum=/entry1,NXentry/$(INSTRUMENT),NXinstrument/monochromator,NXcrystal/SDS curvature \
-rank 1 -dim {-1} -attr {units,degree} -dim {-1}
#----------- analyzer
ana_type=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS type -type NX_CHAR -rank 1
sc_ef=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS energy -rank 1 -dim {-1} \
-attr {units,mev}
sc_a5=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle \
-rank 1 -dim {-1} -attr {units,degree}
a5_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS rotation_angle_zero \
-attr {units,degree}
sc_a4=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle -rank 1 -dim {-1} \
-attr {units,degree}
2t_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS polar_angle_zero -attr {units,degree}
ana_dd=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS d_spacing -attr {units,Angstroem}
ana_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS azimuthal_angle -attr {units,degree}
sdistance=/entry1,NXentry/$(INSTRUMENT),NXinstrument/analyzer,NXcrystal/SDS distance -attr {units,mm}
#--------- detector
set winno 1
sc_a6=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle -rank 1 -dim {-1} \
-attr {units,degree}
2ta_zero=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS polar_angle_zero -attr {units,degree}
counts=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS data -type NX_INT32 \
-rank 1 -dim {-1} -attr {signal,1}
det_az=/entry1,NXentry/$(INSTRUMENT),NXinstrument/detector,NXdetector/SDS azimuthal_angle -attr {units,degree}
adistance=/entry1,NXentry/$(INSTRUMENT),NXinstrument/adetector,NXcrystal/SDS distance -attr {units,mm}
#------- monitors
cter_mode=/entry1,NXentry/control,NXmonitor/SDS mode -type NX_CHAR -rank 1 -dim {30}
cter_preset=/entry1,NXentry/control,NXmonitor/SDS preset
motime=/entry1,NXentry/control,NXmonitor/SDS time -attr {units,seconds} -rank 1 -dim {-1}
cter_01=/entry1,NXentry/control,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {-1}
cter_02=/entry1,NXentry/aux_detector,NXmonitor/SDS data -type NX_INT32 -rank 1 -dim {-1}
#------- NXdata
dana=/entry1,NXentry/data,NXdata/NXVGROUP
emotor_a1=/entry1,NXentry/data,NXdata/SDS a1 \
-rank 1 -dim {-1} -attr {units,degree}
emotor_a2=/entry1,NXentry/data,NXdata/SDS a2 \
-rank 1 -dim {-1} -attr {units,degree}
emotor_a3=/entry1,NXentry/data,NXdata/SDS a3 \
-rank 1 -dim {-1} -attr {units,degree}
emotor_a4=/entry1,NXentry/data,NXdata/SDS a4 -rank 1 -dim {-1} \
-attr {units,degree}
emotor_a5=/entry1,NXentry/data,NXdata/SDS a5 -rank 1 -dim {-1} \
-attr {units,degree}
emotor_a6=/entry1,NXentry/data,NXdata/SDS a6 -rank 1 -dim {-1} \
-attr {units,degree}
danascanvar=/entry1,NXentry/data,NXdata/SDS scanvar \
-type NX_FLOAT32 -attr {axis,1} -rank 1 -dim {-1}