Remove TCL files to match with PSI cleanup
This commit is contained in:
Douglas Clowes
23
amorpar.tcl
23
amorpar.tcl
@ -1,23 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# A SICS-tcl-macro script for formatting the parameters for the
|
|
||||||
# reflectometer AMOR's status display.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, October 1999
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc amorpar {} {
|
|
||||||
lappend list "amorpar == "
|
|
||||||
lappend list [lastscancommand] ";"
|
|
||||||
catch {scan getvars} msg
|
|
||||||
lappend list $msg ";"
|
|
||||||
lappend list [xxxscan getfile] ";"
|
|
||||||
lappend list [sicstime] ";"
|
|
||||||
set ret [catch {temperature} msg]
|
|
||||||
if {$ret == 0} {
|
|
||||||
lappend list $msg
|
|
||||||
}
|
|
||||||
set ret [catch {magnet} msg]
|
|
||||||
if {$ret == 0} {
|
|
||||||
lappend list $msg
|
|
||||||
}
|
|
||||||
return [join $list]
|
|
||||||
}
|
|
||||||
358
amortest.tcl
358
amortest.tcl
@ -1,358 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for a simulated AMOR instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke September,1999 - ??, ????
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
|
|
||||||
#------------ our home
|
|
||||||
set home /data/koenneck/src/sics
|
|
||||||
|
|
||||||
#----------- first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 7000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileDir $home/tmp
|
|
||||||
#LogFileDir is the directory where the command log is going
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName $home/tmp/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption statusfile $home/tmp/sicsstatus.tcl
|
|
||||||
|
|
||||||
ServerOption ServerPort 2911
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2914
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
# Telnet options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory $home/tcl
|
|
||||||
ServerOption DefaultCommandFile topsicom.tcl
|
|
||||||
|
|
||||||
#------ a port for broadcasting UDP messages
|
|
||||||
ServerOption QuieckPort 2108
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 1
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# G E N E R A L V A R I A B L E S
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument AMOR
|
|
||||||
Instrument lock
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake sample Text User
|
|
||||||
sample "DanielSulfid"
|
|
||||||
Title "Amore mio in SINQ"
|
|
||||||
VarMake User Text User
|
|
||||||
User The reflective looser
|
|
||||||
|
|
||||||
VarMake lastscancommand Text User
|
|
||||||
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# B u i l d i n g B l o c k s
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
#
|
|
||||||
#=================== Chopper
|
|
||||||
VarMake chopperrotation Float User
|
|
||||||
chopperrotation 10000.
|
|
||||||
|
|
||||||
ClientPut "Starting motor initialization ....."
|
|
||||||
#=================== frame overlap mirror
|
|
||||||
VarMake fomname Text Mugger
|
|
||||||
fomname Super Duper Mirror
|
|
||||||
fomname lock
|
|
||||||
VarMake fomdist Float Mugger
|
|
||||||
fomdist 120
|
|
||||||
Motor FTZ SIM 0. 120. .1 2. # fom height
|
|
||||||
Motor FOM SIM -30. 30. .1 2. # fom omega
|
|
||||||
|
|
||||||
#================== first diaphragm
|
|
||||||
VarMake d1dist Float Mugger
|
|
||||||
d1dist 200.
|
|
||||||
Motor D1L SIM 0. 120. .1 2. # left
|
|
||||||
Motor D1R SIM 0. 120. .1 2. # right
|
|
||||||
Motor D1T SIM 0. 120. .1 2. # top
|
|
||||||
Motor D1B SIM 0. 1000. .1 2. # bottom
|
|
||||||
|
|
||||||
#================== polarizer
|
|
||||||
VarMake polname Text Mugger
|
|
||||||
polname Daniels Special Edition Polarizer
|
|
||||||
polname lock
|
|
||||||
VarMake poldist Float Mugger
|
|
||||||
fomdist 200
|
|
||||||
Motor MOZ SIM 0. 1000. .1 2. # pol table height
|
|
||||||
Motor MTY SIM -60. 60. .1 2. # pol y movement
|
|
||||||
Motor MOM SIM -30. 30. .1 2. # pol omega
|
|
||||||
Motor MTZ SIM -30. 30. .1 2. # pol omega height
|
|
||||||
|
|
||||||
#=================== diaphragm 2
|
|
||||||
VarMake d2dist Float Mugger
|
|
||||||
d2dist 200.
|
|
||||||
Motor D2L SIM 0. 120. .1 2. # left
|
|
||||||
Motor D2R SIM 0. 120. .1 2. # right
|
|
||||||
Motor D2T SIM 0. 120. .1 2. # top
|
|
||||||
Motor D2B SIM 0. 1000. .1 2. # bottom
|
|
||||||
|
|
||||||
#==================== diaphragm 3
|
|
||||||
VarMake d3dist Float Mugger
|
|
||||||
d3dist 200.
|
|
||||||
Motor D3L SIM 0. 120. .1 2. # left
|
|
||||||
Motor D3R SIM 0. 120. .1 2. # right
|
|
||||||
Motor D3T SIM 0. 120. .1 2. # top
|
|
||||||
Motor D3B SIM 0. 1000. .1 2. # bottom
|
|
||||||
|
|
||||||
#===================== sample table
|
|
||||||
VarMake sampledist Float Mugger
|
|
||||||
sampledist 200
|
|
||||||
Motor STZ SIM -50. 50. .1 2. # sample height
|
|
||||||
Motor SOM SIM -30. 30. .1 2. # sample omega
|
|
||||||
Motor SCH SIM -30. 30. .1 2. # sample chi
|
|
||||||
Motor SOZ SIM 0. 1000. .1 2. # table height
|
|
||||||
|
|
||||||
#====================== diaphragm 4
|
|
||||||
VarMake d4dist Float Mugger
|
|
||||||
d4dist 200.
|
|
||||||
Motor D4L SIM 0. 120. .1 2. # left
|
|
||||||
Motor D4R SIM 0. 120. .1 2. # right
|
|
||||||
Motor D4T SIM 0. 120. .1 2. # top
|
|
||||||
Motor D4B SIM 0. 1000. .1 2. # bottom
|
|
||||||
|
|
||||||
#======================= analyzer
|
|
||||||
VarMake ananame Text Mugger
|
|
||||||
ananame Daniels Special Edition Analyzer
|
|
||||||
ananame lock
|
|
||||||
VarMake anadist Float Mugger
|
|
||||||
anadist 200
|
|
||||||
Motor AOZ SIM 0. 1000. .1 2. # analyzer table height
|
|
||||||
Motor AOM SIM -30. 30. .1 2. # analyzer omega
|
|
||||||
Motor ATZ SIM -30. 30. .1 2. # analyzer omega height
|
|
||||||
|
|
||||||
#======================== diaphragm 5
|
|
||||||
VarMake d5dist Float Mugger
|
|
||||||
d5dist 200.
|
|
||||||
Motor D5L SIM 0. 120. .1 2. # left
|
|
||||||
Motor D5R SIM 0. 120. .1 2. # right
|
|
||||||
Motor D5T SIM 0. 120. .1 2. # top
|
|
||||||
Motor D5B SIM 0. 1000. .1 2. # bottom
|
|
||||||
|
|
||||||
#======================== counter
|
|
||||||
VarMake detectordist Float Mugger
|
|
||||||
detectordist 200.
|
|
||||||
MakeCounter counter SIM .0001
|
|
||||||
Motor COZ SIM 0. 1000. .1 2. # counter table height
|
|
||||||
Motor C3Z SIM 0. 300. .1 2. # counter height
|
|
||||||
Motor COM SIM -30. 30. .1 2. # counter omega
|
|
||||||
Motor COX SIM -100. 100. .1 2. # counter x
|
|
||||||
ClientPut "Motors initialized"
|
|
||||||
|
|
||||||
#======================== histogram memory
|
|
||||||
#MakeHM hm SinqHM
|
|
||||||
MakeHM hm SIM
|
|
||||||
hm configure OverFlowMode Ceil
|
|
||||||
hm configure HistMode PSD
|
|
||||||
hm configure Rank 2
|
|
||||||
hm configure dim0 128
|
|
||||||
hm configure dim1 256
|
|
||||||
hm configure xfac 10
|
|
||||||
hm configure yfac 10
|
|
||||||
hm configure xoff 64
|
|
||||||
hm configure yoff 128
|
|
||||||
hm configure BinWidth 4
|
|
||||||
hm preset 100.
|
|
||||||
hm CountMode Timer
|
|
||||||
hm configure HMComputer psds03.psi.ch
|
|
||||||
hm configure HMPort 2400
|
|
||||||
hm configure Counter counter
|
|
||||||
hm configure init 0
|
|
||||||
hm genbin 0. 33 5
|
|
||||||
hm init
|
|
||||||
|
|
||||||
ClientPut "Histogram Memory Initialized"
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D a t a S t o r a g e
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath $home/
|
|
||||||
SicsDataPath lock
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix amortest
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".hdf"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
|
|
||||||
MakeDataNumber SicsDataNumber $home/danu.dat
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C o m m a n d I n i t i a l i z a t i o n
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
#======== Drive
|
|
||||||
MakeDrive
|
|
||||||
#======== scan
|
|
||||||
source $home/object.tcl
|
|
||||||
source $home/tcl/scancom.tcl
|
|
||||||
MakeScanCommand xxxscan counter topsi.hdd recover.bin
|
|
||||||
xxxscan configure amor
|
|
||||||
#========== peak & center
|
|
||||||
MakePeakCenter xxxscan
|
|
||||||
source /data/koenneck/src/sics/countf.tcl
|
|
||||||
#========== serial port general purpose
|
|
||||||
SerialInit
|
|
||||||
Publish serialport User
|
|
||||||
Publish p1 User
|
|
||||||
#=========== the optimiser
|
|
||||||
MakeOptimise opti counter
|
|
||||||
|
|
||||||
#=========== Amor2T
|
|
||||||
set a2t(mom) mom
|
|
||||||
set a2t(som) som
|
|
||||||
set a2t(coz) coz
|
|
||||||
set a2t(cox) cox
|
|
||||||
set a2t(stz) stz
|
|
||||||
set a2t(soz) soz
|
|
||||||
set a2t(d4b) d4b
|
|
||||||
set a2t(d5b) d5b
|
|
||||||
set a2t(com) com
|
|
||||||
set a2t(aom) aom
|
|
||||||
set a2t(aoz) aoz
|
|
||||||
set a2t(c3z) c3z
|
|
||||||
MakeAmor2T a2t a2t aom2t
|
|
||||||
|
|
||||||
MakeStoreAmor hm a2t
|
|
||||||
|
|
||||||
#=========== Status Display Support
|
|
||||||
MakeAmorStatus amorstatus xxxscan hm
|
|
||||||
source amorpar.tcl
|
|
||||||
Publish amorpar Spy
|
|
||||||
ClientPut "Done Initializing"
|
|
||||||
|
|
||||||
|
|
||||||
scriptcallback connect xxxscan SCANSTART scanmode
|
|
||||||
scriptcallback connect hm COUNTSTART tofmode
|
|
||||||
sicsdatafactory new wwwdata
|
|
||||||
|
|
||||||
Publish getmode Spy
|
|
||||||
Publish wwwgetdata Spy
|
|
||||||
Publish wwwsics Spy
|
|
||||||
Publish wwwgetaxis Spy
|
|
||||||
|
|
||||||
#-----------------------------------------------------------------
|
|
||||||
set mode 0
|
|
||||||
proc tofmode {} {
|
|
||||||
global mode
|
|
||||||
set mode 1
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------
|
|
||||||
proc scanmode {} {
|
|
||||||
global mode
|
|
||||||
set mode 0
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------
|
|
||||||
proc getmode {} {
|
|
||||||
global mode
|
|
||||||
return $mode
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------
|
|
||||||
proc wwwgetdata {} {
|
|
||||||
global mode
|
|
||||||
if {$mode == 1} {
|
|
||||||
wwwtofdata
|
|
||||||
} else {
|
|
||||||
wwwscandata
|
|
||||||
}
|
|
||||||
wwwdata writeuu wwwdata
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------
|
|
||||||
proc wwwscandata {} {
|
|
||||||
wwwdata clear
|
|
||||||
set np [string trim [SplitReply [xxxscan np]]]
|
|
||||||
wwwdata putint 0 $np
|
|
||||||
if {$np > 0} {
|
|
||||||
wwwdata copyscanvar 1 xxxscan 0
|
|
||||||
wwwdata copyscancounts [expr $np + 1] xxxscan
|
|
||||||
wwwdata copyscanmon [expr $np*2 + 1] xxxscan 2
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc wwwtofdata {} {
|
|
||||||
wwwdata clear
|
|
||||||
set ntime [string trim [SplitReply [hm notimebin]]]
|
|
||||||
set dim0 [string trim [SplitReply [hm configure dim0]]]
|
|
||||||
set dim1 [string trim [SplitReply [hm configure dim1]]]
|
|
||||||
wwwdata putint 0 $ntime
|
|
||||||
wwwdata copytimebin 1 hm
|
|
||||||
set start [expr $dim0*$dim1*$ntime]
|
|
||||||
set end [expr $start + 2*$ntime]
|
|
||||||
wwwdata copyhm [expr $ntime + 1] hm $start $end
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc wwwsics {} {
|
|
||||||
global mode
|
|
||||||
append result "<table BORDER=2>\n"
|
|
||||||
append result "<tr><th>User</th> <td>" [SplitReply [user]] "</td></tr>\n"
|
|
||||||
append result "<tr><th>Title</th> <td>"
|
|
||||||
append result [SplitReply [title]] "</td></tr>\n"
|
|
||||||
append result "<tr><th>Status</th> <td>"
|
|
||||||
append result [SplitReply [status]] "</td></tr>\n"
|
|
||||||
append result "<tr><th>Mode</th><td>"
|
|
||||||
if {$mode == 1} {
|
|
||||||
append result "time-of-flight"
|
|
||||||
} else {
|
|
||||||
append result "scan mode"
|
|
||||||
}
|
|
||||||
append result "</td></tr>\n"
|
|
||||||
append result "</table>\n"
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc wwwgetaxis {} {
|
|
||||||
global mode
|
|
||||||
if {$mode == 1} {
|
|
||||||
return time-of-flight
|
|
||||||
} else {
|
|
||||||
set res [scan info]
|
|
||||||
set l [split $res ,]
|
|
||||||
return [lindex $l 2]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
7
ati.tcl
7
ati.tcl
@ -1,7 +0,0 @@
|
|||||||
drive mom 3.
|
|
||||||
scan var a2t 0. .2
|
|
||||||
scan var som 0. .1
|
|
||||||
scan preset 1
|
|
||||||
scan mode timer
|
|
||||||
scan np 20
|
|
||||||
scan run
|
|
||||||
211
autofile.tcl
211
autofile.tcl
@ -1,211 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# This is part of the WWW-interface to SICS. This interface allows to
|
|
||||||
# create batch files to be run automatically by SICS. These files are
|
|
||||||
# stored in a special directory as files with the ending .sip by the
|
|
||||||
# CGI-scripts or servlets creating them. Now, a system is needed which
|
|
||||||
# checks this directory regularly for new files and executes them in SICS.
|
|
||||||
# This is the purpose of the SICS-Tcl macros defined in this file.
|
|
||||||
#
|
|
||||||
# First edition: Mark Koennecke, December 1999
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
#----------- !!!! the path where the automatic files reside
|
|
||||||
set autofpath "/data/koenneck/tmp/auto"
|
|
||||||
|
|
||||||
#------- a variable which defines if we should operate and the current file.
|
|
||||||
set __autofile_run 0
|
|
||||||
set __auto_exe_file ""
|
|
||||||
|
|
||||||
#!!!!!!!!!!!!!! WARNING !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
|
|
||||||
# There is a name command between the Tcl internal scan command and the
|
|
||||||
# SICS scan command. The Tcl internal has to be renamed. The following
|
|
||||||
# variable defines the name of the Tcl scan command
|
|
||||||
set tclscan stscan
|
|
||||||
|
|
||||||
#---------- do initializing things when called first time
|
|
||||||
set ret [catch [catch {autofile} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
VarMake autofilepath Text Mugger
|
|
||||||
autofilepath $autofpath
|
|
||||||
autofilepath lock
|
|
||||||
Publish autofileexecute User
|
|
||||||
Publish autofile Mugger
|
|
||||||
Publish autostart User
|
|
||||||
Publish autoadd User
|
|
||||||
Publish autoend User
|
|
||||||
#------- for automatic file name creation
|
|
||||||
catch {MakeDataNumber autonumber $autofpath/autonumber.dat}
|
|
||||||
#------- check any 30 seconds
|
|
||||||
sicscron 30 autofileexecute
|
|
||||||
}
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc autofile { {action null} } {
|
|
||||||
upvar #0 __autofile_run ar
|
|
||||||
|
|
||||||
if { [string compare $action start] == 0} {
|
|
||||||
set ar 1
|
|
||||||
return OK
|
|
||||||
} elseif { [string compare $action stop] == 0 } {
|
|
||||||
set ar 0
|
|
||||||
return OK
|
|
||||||
} else {
|
|
||||||
if {$ar == 1} {
|
|
||||||
return on
|
|
||||||
} else {
|
|
||||||
return off
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc autofileexecute { } {
|
|
||||||
upvar #0 __autofile_run ar
|
|
||||||
upvar #0 __auto_exe_file aef
|
|
||||||
upvar #0 tclscan filescan
|
|
||||||
#--------- no operation if not activated
|
|
||||||
if {$ar != 1} {
|
|
||||||
return
|
|
||||||
}
|
|
||||||
#--------- aquire a list of candidate batch files
|
|
||||||
set tmp [autofilepath]
|
|
||||||
set ltmp [split $tmp =]
|
|
||||||
set tmp [lindex $ltmp 1]
|
|
||||||
set tmp2 [string trim $tmp]/*.inp
|
|
||||||
set ret [catch {set filelist [glob $tmp2]} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
return "Nothing to do"
|
|
||||||
}
|
|
||||||
if { [llength $filelist] < 1 } {
|
|
||||||
return "Nothing to do"
|
|
||||||
}
|
|
||||||
#--------- now, in each file the second line contains the order number,
|
|
||||||
# find the lowest one which is the next one to execute
|
|
||||||
set minnum 999999
|
|
||||||
set file2exe null
|
|
||||||
foreach fil $filelist {
|
|
||||||
set f [open $fil r]
|
|
||||||
gets $f
|
|
||||||
set numline [gets $f]
|
|
||||||
set ret [catch {$filescan $numline "# %d" numi} msg]
|
|
||||||
close $f
|
|
||||||
if { $ret == 0 } {
|
|
||||||
if { $numi < $minnum } {
|
|
||||||
set minnum $numi
|
|
||||||
set file2exe $fil
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
ClientPut $msg
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------------ having found an input file, execute it
|
|
||||||
if { [string compare $file2exe null] != 0 } {
|
|
||||||
set aef $file2exe
|
|
||||||
set ret [catch {interneval $file2exe} msg]
|
|
||||||
#------ after execution rename it with a different extension
|
|
||||||
set fil2 [file rootname $file2exe].old
|
|
||||||
file rename -force $file2exe $fil2
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
return $msg
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return "Invalid autobatch files"
|
|
||||||
}
|
|
||||||
|
|
||||||
#=========================================================================
|
|
||||||
# File management functions
|
|
||||||
#
|
|
||||||
# autostart creates a fresh file. The data is stored in a SICS runbuffer.
|
|
||||||
# autoadd adds a line to the runbuffer
|
|
||||||
# autoend writes the file to disk then.
|
|
||||||
#=========================================================================
|
|
||||||
|
|
||||||
proc autostart {} {
|
|
||||||
catch {buf del autobuffer}
|
|
||||||
Buf new autobuffer
|
|
||||||
}
|
|
||||||
|
|
||||||
proc autoadd args {
|
|
||||||
autobuffer append $args
|
|
||||||
}
|
|
||||||
|
|
||||||
proc autoend {} {
|
|
||||||
upvar #0 autofpath ap
|
|
||||||
autonumber incr
|
|
||||||
set txt [autonumber]
|
|
||||||
set l [split $txt =]
|
|
||||||
set txt [string trim [lindex $l 1]]
|
|
||||||
set fil [format "$ap/auto%7.7d.inp" $txt]
|
|
||||||
set filnum [format "# %d" $txt]
|
|
||||||
autobuffer ins 1 $filnum
|
|
||||||
autobuffer save $fil
|
|
||||||
Buf del autobuffer
|
|
||||||
}
|
|
||||||
|
|
||||||
#============================================================================
|
|
||||||
# file list management
|
|
||||||
#============================================================================
|
|
||||||
|
|
||||||
proc buildsortedlist {filar} {
|
|
||||||
upvar #0 autofpath ap
|
|
||||||
upvar $filar list
|
|
||||||
set i 0
|
|
||||||
#----------- build arrays of all relevant files
|
|
||||||
set ret [catch {set l1 [glob $ap/*.inp]}]
|
|
||||||
if { $ret == 0 } {
|
|
||||||
foreach fil $l1 {
|
|
||||||
set list($i)
|
|
||||||
incr i
|
|
||||||
set f [open $fil r]
|
|
||||||
set $fil(title) [gets $f]
|
|
||||||
set txt [gets $f]
|
|
||||||
close $f
|
|
||||||
set ret [catch {$filescan $txt "# %d" numi} msg]
|
|
||||||
if { $ret == 0} {
|
|
||||||
set fil(no) $numi
|
|
||||||
}else {
|
|
||||||
set fil(no) -10
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set ret [catch {set l1 [glob $ap/*.old]}]
|
|
||||||
if { $ret == 0 } {
|
|
||||||
foreach fil $l1 {
|
|
||||||
set list($i)
|
|
||||||
incr i
|
|
||||||
set f [open $fil r]
|
|
||||||
set $fil(title) [gets $f]
|
|
||||||
set txt [gets $f]
|
|
||||||
close $f
|
|
||||||
set ret [catch {$filescan $txt "# %d" numi} msg]
|
|
||||||
if { $ret == 0} {
|
|
||||||
set fil(no) $numi
|
|
||||||
}else {
|
|
||||||
set fil(no) -10
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set nfil i
|
|
||||||
#--------- now selection sort this list
|
|
||||||
for {set i 0} { i < $nfil} {incr i} {
|
|
||||||
set min $i
|
|
||||||
set ff $list($min)
|
|
||||||
for {set j [expr $i + 1]} {$j < $nfil} {incr j} {
|
|
||||||
set ff $list($j)
|
|
||||||
set fff $list($min)
|
|
||||||
if { $ff(no) < $fff(no)} {
|
|
||||||
set min $j
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set t $list($min)
|
|
||||||
set list($min) $list($min)
|
|
||||||
set list($i) $t
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc autolist {} {
|
|
||||||
|
|
||||||
}
|
|
||||||
|
|
||||||
137
backup.tcl
137
backup.tcl
@ -1,137 +0,0 @@
|
|||||||
# RuenBuffer Renate
|
|
||||||
Buf new Renate
|
|
||||||
Renate append Alle Fische sind schon da
|
|
||||||
|
|
||||||
Renate append Alle Nixen auch
|
|
||||||
|
|
||||||
Renate append Nur die dummen Neutronen kommen nicht
|
|
||||||
|
|
||||||
Renate append Und die Schluempfe kriegen es auch nicht gebacken
|
|
||||||
|
|
||||||
# RuenBuffer Kunigunde
|
|
||||||
Buf new Kunigunde
|
|
||||||
Kunigunde append Alle Fische sind schon da
|
|
||||||
|
|
||||||
Kunigunde append Alle Nixen auch
|
|
||||||
|
|
||||||
Kunigunde append Nur die dummen Neutronen kommen nicht
|
|
||||||
|
|
||||||
Kunigunde append Und die Schluempfe kriegen es auch nicht gebacken
|
|
||||||
|
|
||||||
# RuenBuffer Walter
|
|
||||||
Buf new Walter
|
|
||||||
Walter append Alle Fische sind schon da
|
|
||||||
|
|
||||||
Walter append Alle Nixen auch
|
|
||||||
|
|
||||||
Walter append Nur die dummen Neutronen kommen nicht
|
|
||||||
|
|
||||||
Walter append Und die Schluempfe kriegen es auch nicht gebacken
|
|
||||||
|
|
||||||
# RuenBuffer Willi
|
|
||||||
Buf new Willi
|
|
||||||
Willi append Alle Nixen auch
|
|
||||||
Willi append Und die Schluempfe kriegen es auch nicht gebacken
|
|
||||||
# RuenBuffer Heinz
|
|
||||||
Buf new Heinz
|
|
||||||
Heinz append GGG Fische sind schon da
|
|
||||||
Heinz append GGG Nixen auch
|
|
||||||
Heinz append Nur die dummen Neutronen kommen schon
|
|
||||||
Heinz append Und die Schluempfe kriegen es auch schon gebacken
|
|
||||||
|
|
||||||
Curve SoftLowerLim 0.000000
|
|
||||||
Curve SoftUpperLim 1000.000000
|
|
||||||
Curve SoftZero 0.000000
|
|
||||||
Curve Fixed -1.000000
|
|
||||||
Curve InterruptMode 0.000000
|
|
||||||
Curve AccessCode 2.000000
|
|
||||||
TwoTheta SoftLowerLim -140.000000
|
|
||||||
TwoTheta SoftUpperLim 140.000000
|
|
||||||
TwoTheta SoftZero 0.000000
|
|
||||||
TwoTheta Fixed -1.000000
|
|
||||||
TwoTheta InterruptMode 0.000000
|
|
||||||
TwoTheta AccessCode 2.000000
|
|
||||||
Theta SoftLowerLim -70.000000
|
|
||||||
Theta SoftUpperLim 70.000000
|
|
||||||
Theta SoftZero 0.000000
|
|
||||||
Theta Fixed -1.000000
|
|
||||||
Theta InterruptMode 0.000000
|
|
||||||
Theta AccessCode 2.000000
|
|
||||||
bsy SoftLowerLim -50.000000
|
|
||||||
bsy SoftUpperLim 50.000000
|
|
||||||
bsy SoftZero 0.000000
|
|
||||||
bsy Fixed -1.000000
|
|
||||||
bsy InterruptMode 0.000000
|
|
||||||
bsy AccessCode 2.000000
|
|
||||||
bsx SoftLowerLim -50.000000
|
|
||||||
bsx SoftUpperLim 50.000000
|
|
||||||
bsx SoftZero 0.000000
|
|
||||||
bsx Fixed -1.000000
|
|
||||||
bsx InterruptMode 0.000000
|
|
||||||
bsx AccessCode 2.000000
|
|
||||||
dphi SoftLowerLim 0.000000
|
|
||||||
dphi SoftUpperLim 360.000000
|
|
||||||
dphi SoftZero 0.000000
|
|
||||||
dphi Fixed -1.000000
|
|
||||||
dphi InterruptMode 0.000000
|
|
||||||
dphi AccessCode 2.000000
|
|
||||||
dsy SoftLowerLim -50.000000
|
|
||||||
dsy SoftUpperLim 50.000000
|
|
||||||
dsy SoftZero 0.000000
|
|
||||||
dsy Fixed -1.000000
|
|
||||||
dsy InterruptMode 0.000000
|
|
||||||
dsy AccessCode 2.000000
|
|
||||||
dsd SoftLowerLim 0.000000
|
|
||||||
dsd SoftUpperLim 18000.000000
|
|
||||||
dsd SoftZero 0.000000
|
|
||||||
dsd Fixed -1.000000
|
|
||||||
dsd InterruptMode 0.000000
|
|
||||||
dsd AccessCode 2.000000
|
|
||||||
saz SoftLowerLim 0.000000
|
|
||||||
saz SoftUpperLim 30.000000
|
|
||||||
saz SoftZero 0.000000
|
|
||||||
saz Fixed -1.000000
|
|
||||||
saz InterruptMode 0.000000
|
|
||||||
saz AccessCode 2.000000
|
|
||||||
say SoftLowerLim -22.000000
|
|
||||||
say SoftUpperLim 22.000000
|
|
||||||
say SoftZero 0.000000
|
|
||||||
say Fixed -1.000000
|
|
||||||
say InterruptMode 0.000000
|
|
||||||
say AccessCode 2.000000
|
|
||||||
sax SoftLowerLim -30.000000
|
|
||||||
sax SoftUpperLim 30.000000
|
|
||||||
sax SoftZero 0.000000
|
|
||||||
sax Fixed -1.000000
|
|
||||||
sax InterruptMode 0.000000
|
|
||||||
sax AccessCode 2.000000
|
|
||||||
som SoftLowerLim -180.000000
|
|
||||||
som SoftUpperLim 360.000000
|
|
||||||
som SoftZero 0.000000
|
|
||||||
som Fixed -1.000000
|
|
||||||
som InterruptMode 0.000000
|
|
||||||
som AccessCode 2.000000
|
|
||||||
sphi SoftLowerLim -22.000000
|
|
||||||
sphi SoftUpperLim 22.000000
|
|
||||||
sphi SoftZero 0.000000
|
|
||||||
sphi Fixed -1.000000
|
|
||||||
sphi InterruptMode 0.000000
|
|
||||||
sphi AccessCode 2.000000
|
|
||||||
schi SoftLowerLim -22.000000
|
|
||||||
schi SoftUpperLim 22.000000
|
|
||||||
schi SoftZero 0.000000
|
|
||||||
schi Fixed -1.000000
|
|
||||||
schi InterruptMode 0.000000
|
|
||||||
schi AccessCode 2.000000
|
|
||||||
comment (null)
|
|
||||||
comment setAccess 2
|
|
||||||
environment (null)
|
|
||||||
environment setAccess 2
|
|
||||||
SubTitle (null)
|
|
||||||
SubTitle setAccess 2
|
|
||||||
User set
|
|
||||||
User setAccess 2
|
|
||||||
Title Alle meine Entchen sind schon da
|
|
||||||
Title setAccess 2
|
|
||||||
Instrument set
|
|
||||||
Instrument setAccess 0
|
|
||||||
20
beam.tcl
20
beam.tcl
@ -1,20 +0,0 @@
|
|||||||
#------------------------------------------------------------------------
|
|
||||||
# install a SPS-Controller
|
|
||||||
MakeSPS sps1 lnsp25.psi.ch 4000 7
|
|
||||||
|
|
||||||
#----------------- the beam command
|
|
||||||
proc beam {} {
|
|
||||||
#---------- read the SPS
|
|
||||||
set ret [catch {SPS1 adc 3} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
ClientPut $msg
|
|
||||||
ClientPut "ERROR: SPS reading failed"
|
|
||||||
return
|
|
||||||
}
|
|
||||||
#--------- convert the data
|
|
||||||
set l [split $msg "="]
|
|
||||||
set raw [lindex $l 1]
|
|
||||||
set val [expr $raw/13.96]
|
|
||||||
return [format "beam = %f" $val]
|
|
||||||
}
|
|
||||||
Publish beam Spy
|
|
||||||
20
beamdt.tcl
20
beamdt.tcl
@ -1,20 +0,0 @@
|
|||||||
#------------------------------------------------------------------------
|
|
||||||
# install a SPS-Controller
|
|
||||||
MakeSPS sps1 lnsp23.psi.ch 4000 6
|
|
||||||
|
|
||||||
#----------------- the beam command
|
|
||||||
proc beam {} {
|
|
||||||
#---------- read the SPS
|
|
||||||
set ret [catch {SPS1 adc 7} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
ClientPut $msg
|
|
||||||
ClientPut "ERROR: SPS reading failed"
|
|
||||||
return
|
|
||||||
}
|
|
||||||
#--------- convert the data
|
|
||||||
set l [split $msg "="]
|
|
||||||
set raw [lindex $l 1]
|
|
||||||
set val [expr $raw/13.96]
|
|
||||||
return [format "beam = %f" $val]
|
|
||||||
}
|
|
||||||
Publish beam Spy
|
|
||||||
229
coll.tcl
229
coll.tcl
@ -1,229 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# This file implements the collimator commands for SANS. It requires an
|
|
||||||
# SPS named sps2 within SICS.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, March 1999
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc coll args {
|
|
||||||
#-------- set case
|
|
||||||
if { [llength $args] > 0 ] } {
|
|
||||||
set length [lindex $args 0]
|
|
||||||
switch $length {
|
|
||||||
18 {
|
|
||||||
set command "sps2 push 200 0"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
15 {
|
|
||||||
set command "sps2 push 200 1"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
11 {
|
|
||||||
set command "sps2 push 200 2"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
8 {
|
|
||||||
set command "sps2 push 200 3"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
6 {
|
|
||||||
set command "sps2 push 200 4"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
4.5 {
|
|
||||||
set command "sps2 push 200 5"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
3 {
|
|
||||||
set command "sps2 push 200 6"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
2 {
|
|
||||||
set command "sps2 push 200 7"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
1.4 {
|
|
||||||
set command "sps2 push 201 0"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
1 {
|
|
||||||
set command "sps2 push 201 1"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
append text \
|
|
||||||
[format "ERROR: collimation length %s invalid\n" $length]
|
|
||||||
append text "Possible length are: 18,15,11,8,6,4.5,3,2,1.4,1\n"
|
|
||||||
append text \
|
|
||||||
"Extraneous . or other characters will yield this error too\n"
|
|
||||||
append text "SPS programming courtesy Enzo Manfrin\n"
|
|
||||||
return $text
|
|
||||||
}
|
|
||||||
#------- command has been built, execute it!
|
|
||||||
set ret [catch {$command} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
setstatus Driving
|
|
||||||
#------- wait till finish, check for interrupts on the way
|
|
||||||
set exe 1
|
|
||||||
while {$exe} {
|
|
||||||
set ret [catch {sps2 colli} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
setstatus Eager
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
set cval [lindex $l 1]
|
|
||||||
if { [expr $cval - $length] < 0.2 } {
|
|
||||||
set exe 0
|
|
||||||
}
|
|
||||||
set rupt [getint]
|
|
||||||
if {[string compare $rupt continue] != 0 } {
|
|
||||||
setstatus Eager
|
|
||||||
error "ERROR: driving collimator interrupted"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
setstatus Eager
|
|
||||||
return OK
|
|
||||||
} else {
|
|
||||||
#-------- get case
|
|
||||||
set ret [catch {sps2 colli} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
return $msg
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Another procedure for handling the attenuator.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, March 1999
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc findatt { } {
|
|
||||||
#----------- find the current attenuator
|
|
||||||
set ret [catch {sps2 stat2 9 5} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
if { [lindex $l 1] == 1} {
|
|
||||||
return 0
|
|
||||||
}
|
|
||||||
set ret [catch {sps2 stat2 9 6} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
if { [lindex $l 1] == 1} {
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
set ret [catch {sps2 stat2 9 7} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
if { [lindex $l 1] == 1} {
|
|
||||||
return 2
|
|
||||||
}
|
|
||||||
set ret [catch {sps2 stat2 10 0} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
if { [lindex $l 1] == 1} {
|
|
||||||
return 3
|
|
||||||
}
|
|
||||||
set ret [catch {sps2 stat2 10 1} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
if { [lindex $l 1] == 1} {
|
|
||||||
return 4
|
|
||||||
}
|
|
||||||
set ret [catch {sps2 stat2 10 2} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set l [split $msg =]
|
|
||||||
if { [lindex $l 1] == 1} {
|
|
||||||
return 5
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc att args {
|
|
||||||
if [ llength $args] > 0} {
|
|
||||||
#------- set case
|
|
||||||
set aat [lindex $args 0]
|
|
||||||
switch $aat {
|
|
||||||
0 {
|
|
||||||
set command "sps2 push 210 7"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
1 {
|
|
||||||
set command "sps2 push 220 0"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
2 {
|
|
||||||
set command "sps2 push 220 1"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
3 {
|
|
||||||
set command "sps2 push 230 0"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
4 {
|
|
||||||
set command "sps2 push 230 1"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
5 {
|
|
||||||
set command "sps2 push 230 2"
|
|
||||||
break
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
error [format "ERROR: attenuator %s unknown" $aat]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#-----send command
|
|
||||||
set ret [catch {$command} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
#------ wait till done
|
|
||||||
setstatus Driving
|
|
||||||
set exe 1
|
|
||||||
while {$exe} {
|
|
||||||
set ret [catch {findatt} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
setstatus Eager
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
if { [expr $msg - $aat] < 0.2 } {
|
|
||||||
set exe 0
|
|
||||||
}
|
|
||||||
set rupt [getint]
|
|
||||||
if {[string compare $rupt continue] != 0 } {
|
|
||||||
setstatus Eager
|
|
||||||
error "ERROR: driving attenuator interrupted"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
setstatus Eager
|
|
||||||
return OK
|
|
||||||
} else {
|
|
||||||
#----------- get case
|
|
||||||
set ret [catch {findatt} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
return [format "att = %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
@ -1,79 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# test and example script for the anticollider
|
|
||||||
#
|
|
||||||
# Mark Koennecke, August 2002
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
|
|
||||||
proc testlimits tg {
|
|
||||||
upvar $tg targets
|
|
||||||
if { abs( $targets(om) - $targets(stt)) < 30 } {
|
|
||||||
error "!!!!! two theta - omega CRASH!!!!!!!"
|
|
||||||
}
|
|
||||||
if {$targets(chi) > 190.} {
|
|
||||||
error "chi upperlimit crashed"
|
|
||||||
}
|
|
||||||
if { $targets(om) > -90 && $targets(om) <= -81.5 && $targets(chi) < 152} {
|
|
||||||
error "!!!!!! chi - omega CRASH aborted !!!!!"
|
|
||||||
}
|
|
||||||
if { $targets(om) > -81.5 && $targets(om) <= -55 && $targets(chi) < 137} {
|
|
||||||
error "!!!!!! chi - omega CRASH aborted !!!!!"
|
|
||||||
}
|
|
||||||
if { $targets(om) > -55 && $targets(om) <= -52 && $targets(chi) < 132} {
|
|
||||||
error "!!!!!! chi - omega CRASH aborted !!!!!"
|
|
||||||
}
|
|
||||||
if { $targets(om) > -52 && $targets(om) <= -30 && $targets(chi) < 75} {
|
|
||||||
error "!!!!!! chi - omega CRASH aborted !!!!!"
|
|
||||||
}
|
|
||||||
return
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc chiFirst? tg {
|
|
||||||
upvar $tg targets
|
|
||||||
set om [SplitReply [om]]
|
|
||||||
set chi [SplitReply [chi]]
|
|
||||||
if {$chi < $targets(chi) } {
|
|
||||||
return 1
|
|
||||||
} else {
|
|
||||||
return 0
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc collidertest args {
|
|
||||||
#----------- read command line targets
|
|
||||||
set entries [expr [llength $args] / 2]
|
|
||||||
for {set i 0} {$i < $entries} {incr i} {
|
|
||||||
set ind [expr $i * 2]
|
|
||||||
set targets([lindex $args $ind]) [lindex $args [expr $ind +1]]
|
|
||||||
}
|
|
||||||
#--------- check if all motors are there. If not get targets from
|
|
||||||
# current position
|
|
||||||
if { [info exists targets(om)] == 0} {
|
|
||||||
set targets(om) [SplitReply [om]]
|
|
||||||
}
|
|
||||||
if { [info exists targets(stt)] == 0} {
|
|
||||||
set targets(stt) [SplitReply [stt]]
|
|
||||||
}
|
|
||||||
if { [info exists targets(chi)] == 0} {
|
|
||||||
set targets(chi) [SplitReply [chi]]
|
|
||||||
}
|
|
||||||
if { [info exists targets(phi)] == 0} {
|
|
||||||
set targets(phi) [SplitReply [phi]]
|
|
||||||
}
|
|
||||||
#---------- proceed to real collision detection hydraulics
|
|
||||||
# first: test complex limits
|
|
||||||
set ret [catch {testlimits targets} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
clientput [format "ERROR %s" $msg]
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
anticollision add 1 stt $targets(stt)
|
|
||||||
|
|
||||||
if { [chiFirst? targets] == 1} {
|
|
||||||
anticollision add 2 chi $targets(chi)
|
|
||||||
anticollision add 3 om $targets(om)
|
|
||||||
} else {
|
|
||||||
anticollision add 2 om $targets(om)
|
|
||||||
anticollision add 3 chi $targets(chi)
|
|
||||||
}
|
|
||||||
anticollision add 3 phi $targets(phi)
|
|
||||||
}
|
|
||||||
37
cotop.tcl
37
cotop.tcl
@ -1,37 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# A MAD lookalike co command for TOPSI
|
|
||||||
# All arguments are optional. The current values will be used if not
|
|
||||||
# specified
|
|
||||||
# Dr. Mark Koennecke, November 1999
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc SplitReply { text } {
|
|
||||||
set l [split $text =]
|
|
||||||
return [lindex $l 1]
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc co { {mode NULL } { preset NULL } } {
|
|
||||||
starttime [sicstime]
|
|
||||||
#----- deal with mode
|
|
||||||
set mode2 [string toupper $mode]
|
|
||||||
set mode3 [string trim $mode2]
|
|
||||||
set mc [string index $mode2 0]
|
|
||||||
if { [string compare $mc T] == 0 } {
|
|
||||||
counter setMode Timer
|
|
||||||
} elseif { [string compare $mc M] == 0 } {
|
|
||||||
counter setMode Monitor
|
|
||||||
}
|
|
||||||
#------ deal with preset
|
|
||||||
if { [string compare $preset NULL] != 0 } {
|
|
||||||
set pre $preset
|
|
||||||
} else {
|
|
||||||
set pre [SplitReply [counter getpreset]]
|
|
||||||
}
|
|
||||||
#------ count
|
|
||||||
set ret [catch {counter count $pre} msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error [format "Counting ended with error: %s" $msg]
|
|
||||||
} else {
|
|
||||||
set cts [SplitReply [counter getcounts]]
|
|
||||||
}
|
|
||||||
return $cts
|
|
||||||
}
|
|
||||||
50
countf.tcl
50
countf.tcl
@ -1,50 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# A count command for FOCUS
|
|
||||||
# All arguments are optional. The current values will be used if not
|
|
||||||
# specified
|
|
||||||
# Dr. Mark Koennecke, Juli 1997
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc SplitReply { text } {
|
|
||||||
set l [split $text =]
|
|
||||||
return [lindex $l 1]
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc count { {mode NULL } { preset NULL } } {
|
|
||||||
starttime [sicstime]
|
|
||||||
#----- deal with mode
|
|
||||||
set mode2 [string toupper $mode]
|
|
||||||
set mode3 [string trim $mode2]
|
|
||||||
set mc [string index $mode2 0]
|
|
||||||
if { [string compare $mc T] == 0 } {
|
|
||||||
hm CountMode Timer
|
|
||||||
} elseif { [string compare $mc M] == 0 } {
|
|
||||||
hm CountMode Monitor
|
|
||||||
}
|
|
||||||
#------ deal with preset
|
|
||||||
if { [string compare $preset NULL] != 0 } {
|
|
||||||
hm preset $preset
|
|
||||||
}
|
|
||||||
#------ prepare a count message
|
|
||||||
set a [hm preset]
|
|
||||||
set aa [SplitReply $a]
|
|
||||||
set b [hm CountMode]
|
|
||||||
set bb [SplitReply $b]
|
|
||||||
ClientPut [format " Starting counting in %s mode with a preset of %s" \
|
|
||||||
$bb $aa]
|
|
||||||
#------- count
|
|
||||||
# hm InitVal 0
|
|
||||||
wait 1
|
|
||||||
set ret [catch {hm countblock} msg]
|
|
||||||
#------- StoreData
|
|
||||||
storefocus update
|
|
||||||
# wait 5
|
|
||||||
if { $ret != 0 } {
|
|
||||||
error [format "Counting ended with error: %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#---------------- Repeat -----------------------------------------------
|
|
||||||
proc repeat { num {mode NULL} {preset NULL} } {
|
|
||||||
for { set i 0 } { $i < $num } { incr i } {
|
|
||||||
count $mode $preset
|
|
||||||
}
|
|
||||||
}
|
|
||||||
187
dmc.tcl
187
dmc.tcl
@ -1,187 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for DMC at SINQ, SICS server.
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke Juli 1997
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
set auto_path "/home/DMC/bin"
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName "/home/DMC/log/dmclog"
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 3006
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption StatusFile /home/DMC/log/status.tcl
|
|
||||||
|
|
||||||
ServerOption InterruptPort 3007
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
# Telnet Options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
#The UDP port for sending quieck messages, telling the world of new data
|
|
||||||
ServerOption QuieckPort 2108
|
|
||||||
|
|
||||||
#the token system + the token force grab password
|
|
||||||
TokenInit connan
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Manager Lucas 1
|
|
||||||
SicsUser lnsmanager lnsSICSlns 1
|
|
||||||
SicsUser User DMC 2
|
|
||||||
SicsUser lnsuser 98lns2 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
#Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
|
|
||||||
# Motor nam SIM -20. 20. 5. 1.0
|
|
||||||
# Simulated motor with name nam, lower limit -20, upper limit +20,
|
|
||||||
# error ratio 5% and speed 1.0. Speed may be omitted
|
|
||||||
|
|
||||||
# Monochromator motors
|
|
||||||
ClientPut "Installing Motors"
|
|
||||||
Motor OmegaM EL734 lnsp19.psi.ch 4000 2 1
|
|
||||||
Motor TwoThetaM EL734 lnsp19.psi.ch 4000 2 2
|
|
||||||
Motor MonoX EL734 lnsp19.psi.ch 4000 2 5
|
|
||||||
Motor MonoY EL734 lnsp19.psi.ch 4000 2 6
|
|
||||||
Motor CurveM EL734 lnsp19.psi.ch 4000 2 9
|
|
||||||
Motor MonoPhi EL734 lnsp19.psi.ch 4000 2 7
|
|
||||||
Motor MonoChi EL734 lnsp19.psi.ch 4000 2 8
|
|
||||||
|
|
||||||
# sample Table
|
|
||||||
Motor Table EL734 lnsp19.psi.ch 4000 2 3
|
|
||||||
Motor TwoThetaD EL734 lnsp19.psi.ch 4000 2 4
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Configure Detector
|
|
||||||
# needs a EL737 or simualation for count control
|
|
||||||
ClientPut "Installing counter"
|
|
||||||
MakeCounter counter EL737 lnsp19.psi.ch 4000 4
|
|
||||||
counter SetExponent 6
|
|
||||||
|
|
||||||
MakeHM banana SINQHM
|
|
||||||
banana configure HistMode Normal
|
|
||||||
banana configure OverFlowMode Ceil
|
|
||||||
banana configure Rank 1
|
|
||||||
banana configure Length 400
|
|
||||||
banana configure BinWidth 4
|
|
||||||
banana preset 100.
|
|
||||||
banana CountMode Timer
|
|
||||||
banana configure HMComputer lnse01.psi.ch
|
|
||||||
banana configure HMPort 2400
|
|
||||||
banana configure Counter counter
|
|
||||||
banana init
|
|
||||||
banana exponent 6
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, User, Spy
|
|
||||||
|
|
||||||
|
|
||||||
VarMake SicsDataPath Text Internal
|
|
||||||
SicsDataPath "/home/DMC/data/"
|
|
||||||
VarMake DetStepWidth Float Internal
|
|
||||||
DetStepWidth 0.2
|
|
||||||
DetStepWidth lock
|
|
||||||
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "DMC"
|
|
||||||
Instrument lock
|
|
||||||
#initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake User Text User
|
|
||||||
VarMake Collimation Text User
|
|
||||||
VarMake Sample Text User
|
|
||||||
Sample Kellerit
|
|
||||||
VarMake comment1 Text User
|
|
||||||
VarMake comment2 Text User
|
|
||||||
VarMake comment3 Text User
|
|
||||||
|
|
||||||
VarMake SicsDataPrefix Text Internal
|
|
||||||
SicsDataPrefix dmc
|
|
||||||
#--------- make data number
|
|
||||||
MakeDataNumber SicsDataNumber /home/DMC/data/DataNumber
|
|
||||||
|
|
||||||
VarMake SicsDataPostFix Text Internal
|
|
||||||
SicsDataPostFix ".hdf"
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# Monochromator variables
|
|
||||||
# Syntax MakeMono name type OmegaMotor 2ThetaMotor CurveMotor1 CurveMotor2
|
|
||||||
MakeMono Mono "Ge-111" OmegaM TwoThetaM
|
|
||||||
Mono DD 3.3537
|
|
||||||
# Syntax MakeWaveLength name MonochromatorToUse
|
|
||||||
MakeWaveLength lambda Mono
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
# create the drive command
|
|
||||||
MakeDrive
|
|
||||||
#start RuenBuffer system
|
|
||||||
MakeRuenBuffer
|
|
||||||
|
|
||||||
# aliases
|
|
||||||
SicsAlias OmegaM A1
|
|
||||||
SicsAlias TwoThetaM A2
|
|
||||||
SicsAlias Table A3
|
|
||||||
SicsAlias TwoThetaD A4
|
|
||||||
SicsAlias MonoX A5
|
|
||||||
SicsAlias MonoY A6
|
|
||||||
SicsAlias MonoPhi A7
|
|
||||||
SicsAlias MonoChi A8
|
|
||||||
SicsAlias CurveM A9
|
|
||||||
InitDMC
|
|
||||||
|
|
||||||
#----- The Logbook stuff
|
|
||||||
source "/home/DMC/bin/log.tcl"
|
|
||||||
Publish LogBook Spy
|
|
||||||
#------ The count command
|
|
||||||
source "/home/DMC/bin/count.tcl"
|
|
||||||
Publish count User
|
|
||||||
Publish Repeat User
|
|
||||||
#------ The scan command for Managers
|
|
||||||
source "/home/DMC/bin/scan.tcl"
|
|
||||||
Publish scan Mugger
|
|
||||||
|
|
||||||
#---------install beam command
|
|
||||||
source beamdt.tcl
|
|
||||||
174
dmca.tcl
174
dmca.tcl
@ -1,174 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for DMC at SINQ, SICS server.
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke March 1997
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
set auto_path "/data/koenneck/src/sics/tcl"
|
|
||||||
source $auto_path/dmccom.tcl
|
|
||||||
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption ServerLogBaseName /data/koenneck/src/sics/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2910
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2913
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
ServerOption DefaultCommandFile dmccom.tcl
|
|
||||||
# The path to the file containing common Tcl-commands and procedures.
|
|
||||||
# Every connection is initialized with this
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
#Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
|
|
||||||
# Motor nam SIM -20. 20. 5. 1.0
|
|
||||||
# Simulated motor with name nam, lower limit -20, upper limit +20,
|
|
||||||
# error ratio 5% and speed 1.0. Speed may be omitted
|
|
||||||
|
|
||||||
# Monochromator motors
|
|
||||||
Motor OmegaM SIM 20. 120. 5. 2.0
|
|
||||||
Motor TwoThetaM SIM 20. 120. 5. 0.5
|
|
||||||
Motor MonoX SIM -20. 20. 5. 5.0
|
|
||||||
Motor MonoY SIM -20. 20. 5. 5.0
|
|
||||||
Motor CurveM SIM 0. 1000. 10. 5.0
|
|
||||||
Motor MonoPhi SIM -20. 20. 5. 5.0
|
|
||||||
Motor MonoChi SIM -20. 20. 5. 5.0
|
|
||||||
|
|
||||||
# sample Table
|
|
||||||
Motor Table SIM -180. 180. 5. 7.0
|
|
||||||
Motor TwoThetaD SIM 10. 330. 5. 1.0
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Configure Detector
|
|
||||||
# needs a EL737 or simualation for count control
|
|
||||||
MakeCounter xxxNo SIM
|
|
||||||
|
|
||||||
#MakeHM banana SINQHM
|
|
||||||
MakeHM banana SIM
|
|
||||||
banana configure HistMode Normal
|
|
||||||
banana configure OverFlowMode Ceil
|
|
||||||
banana configure Rank 1
|
|
||||||
banana configure Length 400
|
|
||||||
banana configure BinWidth 4
|
|
||||||
banana configure Time 10. 12. 14 16. 17.
|
|
||||||
banana preset 100.
|
|
||||||
banana CountMode Timer
|
|
||||||
#banana configure HMComputer psds02.psi.ch
|
|
||||||
#banana configure HMport 2400
|
|
||||||
#banana configure Counter xxxNo
|
|
||||||
banana init
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O N F I G U R E D E V I C E S T O H A L T I N
|
|
||||||
# I N T E R R U P T
|
|
||||||
AddHalt OmegaM TwoThetaM MonoX MonoY MonoChi MonoPhi CurveM Table TwoThetaD
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, User, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "DMC at SINQ,PSI"
|
|
||||||
#initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake User Text User
|
|
||||||
VarMake Collimation Text User
|
|
||||||
VarMake Sample Text User
|
|
||||||
VarMake comment1 Text User
|
|
||||||
VarMake comment2 Text User
|
|
||||||
VarMake Comment3 Text User
|
|
||||||
|
|
||||||
VarMake SicsDataPath Text Internal
|
|
||||||
SicsDataPath "/data/koenneck/src/sics/"
|
|
||||||
VarMake SicsDataPrefix Text Internal
|
|
||||||
SicsDataPrefix DMC
|
|
||||||
VarMake SicsDataNumber Int Internal
|
|
||||||
SicsDataNumber 0
|
|
||||||
VarMake SicsDataPostFix Text Internal
|
|
||||||
SicsDataPostFix ".hdf"
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
VarMake DetStepWidth Float Internal
|
|
||||||
DetStepWidth 0.02
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# Monochromator variables
|
|
||||||
# Syntax MakeMono name type OmegaMotor 2ThetaMotor CurveMotor1 CurveMotor2
|
|
||||||
MakeMono Mono "Ge-111" OmegaM TwoThetaM CurveM
|
|
||||||
# Syntax MakeWaveLength name MonochromatorToUse
|
|
||||||
MakeWaveLength lambda Mono
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
# create the drive command
|
|
||||||
MakeDrive
|
|
||||||
#start RuenBuffer system
|
|
||||||
MakeRuenBuffer
|
|
||||||
|
|
||||||
if { 0 } {
|
|
||||||
|
|
||||||
DMCInit 5 2.0 1
|
|
||||||
# end -------- of ------------- file -------------------------------------
|
|
||||||
# test code for powder diagrams, merging etc.
|
|
||||||
|
|
||||||
set id1 [DMCShot set 1 2 2 2 2 2 2]
|
|
||||||
set id2 [DMCShot set 2 3 3 3 3 3 3]
|
|
||||||
set id3 [DMCShot set 6 1 1 1 1 1 1]
|
|
||||||
set id4 [DMCShot set 7 5 5 5 5 5 5]
|
|
||||||
set p1 [DMCPowder merge $id1 $id2 $id3 $id4]
|
|
||||||
ClientPut [DMCPowder info $p1]
|
|
||||||
ClientPut [DMCPowder list $p1 0 17]
|
|
||||||
ClientPut [DMCPowder Start $p1]
|
|
||||||
ClientPut [DMCPowder Step $p1]
|
|
||||||
ClientPut [DMCPowder Stop $p1]
|
|
||||||
DMCReset
|
|
||||||
}
|
|
||||||
# test of alias
|
|
||||||
SicsAlias OmegaM A1
|
|
||||||
SicsAlias TwoThetaM A2
|
|
||||||
SicsAlias Table A3
|
|
||||||
SicsAlias TwoThetaD A4
|
|
||||||
InitDMC
|
|
||||||
13
dmccom.tcl
13
dmccom.tcl
@ -1,13 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# Common Tcl-command procedures for DMC
|
|
||||||
# Mark Koennecke February 1997
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc Milch { n } {
|
|
||||||
for {set i 0 } { $i < $n } { incr i} {
|
|
||||||
ClientPut "Milch ist gesund"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc Kaba { text } {
|
|
||||||
return $text
|
|
||||||
}
|
|
||||||
@ -1,8 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# Common Tcl-command procedures for DMC
|
|
||||||
# Mark Koennecke February 1997
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
source "/data/koenneck/src/sics/obtcl.tcl
|
|
||||||
# define DMC scan class
|
|
||||||
class DMCScanClass
|
|
||||||
|
|
||||||
167
dmcsim.tcl
167
dmcsim.tcl
@ -1,167 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for DMC at SINQ, SICS server.
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke Juli 1997
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
set auto_path "/home/DMC/bin"
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName "/home/DMC/log/dmclog"
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 3009
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption StatusFile /home/DMC/log/simstatus.tcl
|
|
||||||
|
|
||||||
ServerOption InterruptPort 3010
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Manager Lucas 1
|
|
||||||
SicsUser User DMC 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
#Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
|
|
||||||
# Motor nam SIM -20. 20. 5. 1.0
|
|
||||||
# Simulated motor with name nam, lower limit -20, upper limit +20,
|
|
||||||
# error ratio 5% and speed 1.0. Speed may be omitted
|
|
||||||
|
|
||||||
# Monochromator motors
|
|
||||||
Motor OmegaM SIM 0 120 1 2.0
|
|
||||||
Motor TwoThetaM SIM 30 100 1 1.0
|
|
||||||
Motor MonoX SIM -30 30 1 3.0
|
|
||||||
Motor MonoY SIM -30 30 1 3.0
|
|
||||||
Motor CurveM SIM 0 20 1 3.0
|
|
||||||
Motor MonoPhi SIM -30 30 1 3.0
|
|
||||||
Motor MonoChi SIM -30 30 1 3.0
|
|
||||||
|
|
||||||
# sample Table
|
|
||||||
Motor Table SIM -180 360 1 2.
|
|
||||||
Motor TwoThetaD SIM -10 120 1 1.
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Configure Detector
|
|
||||||
# needs a EL737 or simualation for count control
|
|
||||||
MakeCounter counter SIM
|
|
||||||
|
|
||||||
MakeHM banana SIM
|
|
||||||
banana configure HistMode Normal
|
|
||||||
banana configure OverFlowMode Ceil
|
|
||||||
banana configure Rank 1
|
|
||||||
banana configure Length 400
|
|
||||||
banana configure BinWidth 4
|
|
||||||
banana preset 100.
|
|
||||||
banana CountMode Timer
|
|
||||||
#banana configure HMComputer psds04.psi.ch
|
|
||||||
#banana configure HMPort 2400
|
|
||||||
#banana configure Counter counter
|
|
||||||
banana init
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O N F I G U R E D E V I C E S T O H A L T I N
|
|
||||||
# I N T E R R U P T
|
|
||||||
AddHalt OmegaM TwoThetaM MonoX MonoY MonoChi MonoPhi CurveM Table TwoThetaD
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, User, Spy
|
|
||||||
|
|
||||||
|
|
||||||
VarMake SicsDataPath Text Internal
|
|
||||||
SicsDataPath "/home/DMC/sim/"
|
|
||||||
VarMake DetStepWidth Float Internal
|
|
||||||
DetStepWidth 0.02
|
|
||||||
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "DMC at SINQ,PSI"
|
|
||||||
#initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake User Text User
|
|
||||||
VarMake Collimation Text User
|
|
||||||
VarMake Sample Text User
|
|
||||||
Sample Kellerit
|
|
||||||
VarMake Temperature Float User
|
|
||||||
Temperature 21.3897
|
|
||||||
VarMake comment1 Text User
|
|
||||||
VarMake comment2 Text User
|
|
||||||
VarMake comment3 Text User
|
|
||||||
|
|
||||||
VarMake SicsDataPrefix Text Internal
|
|
||||||
SicsDataPrefix dmc
|
|
||||||
VarMake SicsDataNumber Int Mugger
|
|
||||||
SicsDataNumber 0
|
|
||||||
VarMake SicsDataPostFix Text Internal
|
|
||||||
SicsDataPostFix "97.hdf"
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# Monochromator variables
|
|
||||||
# Syntax MakeMono name type OmegaMotor 2ThetaMotor CurveMotor1 CurveMotor2
|
|
||||||
MakeMono Mono "Ge-111" OmegaM TwoThetaM
|
|
||||||
Mono DD 3.3537
|
|
||||||
# Syntax MakeWaveLength name MonochromatorToUse
|
|
||||||
MakeWaveLength lambda Mono
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
# create the drive command
|
|
||||||
MakeDrive
|
|
||||||
#start RuenBuffer system
|
|
||||||
MakeRuenBuffer
|
|
||||||
|
|
||||||
# aliases
|
|
||||||
SicsAlias OmegaM A1
|
|
||||||
SicsAlias TwoThetaM A2
|
|
||||||
SicsAlias Table A3
|
|
||||||
SicsAlias TwoThetaD A4
|
|
||||||
InitDMC
|
|
||||||
|
|
||||||
#----- The Logbook stuff
|
|
||||||
source "/home/DMC/bin/log.tcl"
|
|
||||||
Publish LogBook User
|
|
||||||
#------ The count command
|
|
||||||
source "/home/DMC/bin/count.tcl"
|
|
||||||
Publish count User
|
|
||||||
Publish Repeat User
|
|
||||||
#------ The scan command for Managers
|
|
||||||
source "/home/DMC/bin/scan.tcl"
|
|
||||||
Publish scan Mugger
|
|
||||||
|
|
||||||
355
fcircle.tcl
355
fcircle.tcl
@ -1,355 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# fcircle is a collection of SICS-Tcl macro scripts which help with
|
|
||||||
# the running of a four circle diffractometer. The central idea is
|
|
||||||
# a data base file which can be manipulated both from SICS and from
|
|
||||||
# external programs. The name of this database file is expected to live in
|
|
||||||
# the SICS variable dbfile.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, November 1999
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
|
|
||||||
|
|
||||||
#----------- fcircleinit
|
|
||||||
# fcircleinit must be called from the SICS initialization script and will
|
|
||||||
# then install all necessary variables and the commands defined by this
|
|
||||||
# script into SICS.
|
|
||||||
|
|
||||||
proc fcircleinit {} {
|
|
||||||
VarMake dbfile Text User
|
|
||||||
Publish writepos User
|
|
||||||
Publish writerefl User
|
|
||||||
Publish clearrefl User
|
|
||||||
Publish listrefl User
|
|
||||||
Publish updateub User
|
|
||||||
Publish setlambda User
|
|
||||||
Publish fcentre User
|
|
||||||
}
|
|
||||||
|
|
||||||
#------------fsplit
|
|
||||||
# returns the answer part of a SICS reply of the form something = something
|
|
||||||
proc fsplit {text} {
|
|
||||||
set l [split $text =]
|
|
||||||
set t [lindex $l 1]
|
|
||||||
return [string trim $t]
|
|
||||||
}
|
|
||||||
|
|
||||||
#----------- locate
|
|
||||||
# This is an internal routine and tries to locate a section in the database
|
|
||||||
# file. The database file is plain ASCII. There are sections in the file
|
|
||||||
# separated by lines starting with ####. The #### is followed by the title
|
|
||||||
# name of the section. Then follow lines of section specific data in variable
|
|
||||||
# syntax. Another complication is that we need to be able to update the data
|
|
||||||
# in the file. In order to do that the whole file is first read into an array
|
|
||||||
# before the search is started. This is feasible as we have at max a hundred
|
|
||||||
# lines. The array receives a member nl which is the number of lines read.
|
|
||||||
# The parameters are:
|
|
||||||
# ar the array of lines.
|
|
||||||
# fd a file descriptor as created by open
|
|
||||||
# keyword the keyword to search for
|
|
||||||
# The function returns the line number where the keyword was found on success,
|
|
||||||
# else -1 is returned.
|
|
||||||
|
|
||||||
#proc dbfile {} {
|
|
||||||
# return "dbfile = test.db"
|
|
||||||
#}
|
|
||||||
|
|
||||||
proc locate { data keyword} {
|
|
||||||
upvar $data ar
|
|
||||||
#--------- read file
|
|
||||||
set ret [catch {open [fsplit [dbfile]] r} fd]
|
|
||||||
if {$ret == 1} {
|
|
||||||
set ar(nl) 0
|
|
||||||
return -1
|
|
||||||
}
|
|
||||||
#----- read whole file
|
|
||||||
set i 0
|
|
||||||
while {[gets $fd line] > 0 } {
|
|
||||||
set ar($i) $line
|
|
||||||
incr i
|
|
||||||
}
|
|
||||||
set ar(nl) $i
|
|
||||||
close $fd
|
|
||||||
#----- start search
|
|
||||||
for {set i 0} {$i < $ar(nl)} { incr i} {
|
|
||||||
#------ look for delimiter
|
|
||||||
set delim [string range $ar($i) 0 3]
|
|
||||||
if {[string compare $delim ####] == 0} {
|
|
||||||
#----------- check keyword
|
|
||||||
if {[string first $keyword $ar($i) ] > 0} {
|
|
||||||
return $i
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return -1;
|
|
||||||
}
|
|
||||||
#--------------- writerange
|
|
||||||
# writerange writes a range of lines from an array created by locate
|
|
||||||
# to the file specicified by fd. Ranges are automaticcaly adjusted to
|
|
||||||
# data limits
|
|
||||||
|
|
||||||
proc writerange { data fd start end } {
|
|
||||||
upvar $data ar
|
|
||||||
#----- adjust ranges
|
|
||||||
if {$start < 0} {
|
|
||||||
set start 0
|
|
||||||
}
|
|
||||||
if {$start > $ar(nl) } {
|
|
||||||
set start $ar(nl)
|
|
||||||
}
|
|
||||||
if { $end > $ar(nl) } {
|
|
||||||
set end $ar(nl)
|
|
||||||
}
|
|
||||||
#---- write!
|
|
||||||
for {set i $start} {$i < $end} {incr i} {
|
|
||||||
puts $fd $ar($i)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
#----------- writepos
|
|
||||||
# writepos writes the current positions of stt, om, ch, ph motors as a A type
|
|
||||||
# line into the reflection section of the data base file. This is used after
|
|
||||||
# centering an unindexed reflection.
|
|
||||||
|
|
||||||
proc writepos { } {
|
|
||||||
#----- get positions
|
|
||||||
set ret [catch {fsplit [stt]} mystt]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
set ret [catch {fsplit [om]} myom]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
set ret [catch {fsplit [ch]} mych]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
set ret [catch {fsplit [ph]} myph]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
#----- find position in file
|
|
||||||
set ret [catch {locate data reflections} ind]
|
|
||||||
#----- write
|
|
||||||
set ret [catch {open [fsplit [dbfile]] w} fd]
|
|
||||||
if { $ret == 1} {
|
|
||||||
error $fd
|
|
||||||
}
|
|
||||||
if { $ind < 0 } {
|
|
||||||
writerange data $fd 0 $data(nl)
|
|
||||||
puts $fd "#### reflections"
|
|
||||||
puts $fd [format "A %8.2f %8.2f %8.2f %8.2f" \
|
|
||||||
$mystt $myom $mych $myph]
|
|
||||||
} else {
|
|
||||||
incr ind
|
|
||||||
writerange data $fd 0 $ind
|
|
||||||
puts $fd [format "A %8.2f %8.2f %8.2f %8.2f" \
|
|
||||||
$mystt $myom $mych $myph]
|
|
||||||
writerange data $fd $ind $data(nl)
|
|
||||||
}
|
|
||||||
close $fd
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
|
|
||||||
#------------ writerefl
|
|
||||||
# writerefl writes a reflection with indexes. This makes an I record in
|
|
||||||
# the reflections list of the database file. This is meant to be used
|
|
||||||
# after centering a reflection after the UB-matrix is known
|
|
||||||
|
|
||||||
proc writerefl { } {
|
|
||||||
#----- get positions
|
|
||||||
set ret [catch {fsplit [stt]} mystt]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
set ret [catch {fsplit [om]} myom]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
set ret [catch {fsplit [ch]} mych]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
set ret [catch {fsplit [ph]} myph]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $myom
|
|
||||||
}
|
|
||||||
#------ get hkl
|
|
||||||
set ret [catch {hkl current} txt]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $txt
|
|
||||||
}
|
|
||||||
set l [split $txt]
|
|
||||||
set H [lindex $txt 2]
|
|
||||||
set K [lindex $txt 3]
|
|
||||||
set L [lindex $txt 4]
|
|
||||||
#----- find position in file
|
|
||||||
set ret [catch {locate data reflections} ind]
|
|
||||||
#----- write
|
|
||||||
set ret [catch {open [fsplit [dbfile]] w} fd]
|
|
||||||
if { $ret == 1} {
|
|
||||||
error $fd
|
|
||||||
}
|
|
||||||
if { $ind < 0 } {
|
|
||||||
writerange data $fd 0 $data(nl)
|
|
||||||
puts $fd "#### reflections"
|
|
||||||
puts $fd [format "I %5.2f %5.2f %5.2f %8.2f %8.2f %8.2f %8.2f" \
|
|
||||||
$H $K $L $mystt $myom $mych $myph]
|
|
||||||
} else {
|
|
||||||
incr ind
|
|
||||||
writerange data $fd 0 $ind
|
|
||||||
puts $fd [format "I %5.2f %5.2f %5.2f %8.2f %8.2f %8.2f %8.2f" \
|
|
||||||
$H $K $L $mystt $myom $mych $myph]
|
|
||||||
writerange data $fd $ind $data(nl)
|
|
||||||
}
|
|
||||||
close $fd
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
|
|
||||||
#----------- clearrefl
|
|
||||||
# clearrefl clears the list of reflections as stored in the database file
|
|
||||||
|
|
||||||
proc clearrefl {} {
|
|
||||||
#----- find position in file
|
|
||||||
set ret [catch {locate data reflections} ind]
|
|
||||||
#---- nothing to do if no entry
|
|
||||||
if {$ind < 0} {
|
|
||||||
return "Nothing to do"
|
|
||||||
}
|
|
||||||
#----- write
|
|
||||||
set ret [catch {open [fsplit [dbfile]] w} fd]
|
|
||||||
if { $ret == 1} {
|
|
||||||
error $fd
|
|
||||||
}
|
|
||||||
incr ind
|
|
||||||
writerange data $fd 0 $ind
|
|
||||||
for {set i $ind} {$i < $data(nl)} {incr i} {
|
|
||||||
set delim [string range $data($i) 0 3]
|
|
||||||
if {[string compare $delim ####] == 0} {
|
|
||||||
break
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set ind [expr $ind + $i - 1]
|
|
||||||
writerange data $fd $ind $data(nl)
|
|
||||||
close $fd
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
|
|
||||||
#-------- listrefl
|
|
||||||
# listrefl lists all the entries in the reflection list
|
|
||||||
|
|
||||||
proc listrefl {} {
|
|
||||||
#----- find position in file
|
|
||||||
set ret [catch {locate data reflections} ind]
|
|
||||||
#---- nothing to do if no entry
|
|
||||||
if {$ind < 0} {
|
|
||||||
return "Nothing to do"
|
|
||||||
}
|
|
||||||
#------ list
|
|
||||||
incr ind
|
|
||||||
for {set i $ind} {$i < $data(nl)} {incr i} {
|
|
||||||
set delim [string range $data($i) 0 3]
|
|
||||||
if {[string compare $delim ####] == 0} {
|
|
||||||
break
|
|
||||||
} else {
|
|
||||||
ClientPut $data($i)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
|
|
||||||
#---------- updateub
|
|
||||||
# updateub reads a UB matrix from the file and replaces the current SICS
|
|
||||||
# UB matrix with the one from the file. To be used after another program
|
|
||||||
# created a UB matrix in the first place or after refining the UB matrix
|
|
||||||
# following a centering operation.
|
|
||||||
# WARNING: this requires that the Tcl internal scan command has been r
|
|
||||||
# renamed BEFORE loading the scan command to stscan. Otherwise there is
|
|
||||||
# as conflict with the scan routine!
|
|
||||||
|
|
||||||
proc updateub {} {
|
|
||||||
#----- find position in file
|
|
||||||
set ret [catch {locate data UB} ind]
|
|
||||||
if { $ind < 0} {
|
|
||||||
error "ERROR: No UB matrix in database"
|
|
||||||
}
|
|
||||||
incr ind
|
|
||||||
#------ read three lines of UB
|
|
||||||
stscan $data($ind) "%f%f%f" ub11 ub12 ub13
|
|
||||||
ClientPut $ub11 $ub12 $ub13
|
|
||||||
incr ind
|
|
||||||
stscan $data($ind) "%f%f%f" ub21 ub22 ub23
|
|
||||||
incr ind
|
|
||||||
stscan $data($ind) "%f%f%f" ub31 ub32 ub33
|
|
||||||
hkl setub $ub11 $ub12 $ub13 $ub21 $ub22 $ub23 $ub31 $ub32 $ub33
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
|
|
||||||
#--------- setlambda
|
|
||||||
# setlambda sets the wavelength
|
|
||||||
|
|
||||||
proc setlambda {newval} {
|
|
||||||
set ret [catch {hkl lambda $newval} msg]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
#----- find position in file
|
|
||||||
set ret [catch {locate data lambda} ind]
|
|
||||||
#----- write
|
|
||||||
set ret [catch {open [fsplit [dbfile]] w} fd]
|
|
||||||
if { $ret == 1} {
|
|
||||||
error $fd
|
|
||||||
}
|
|
||||||
if { $ind < 0 } {
|
|
||||||
writerange data $fd 0 $data(nl)
|
|
||||||
puts $fd "#### lambda"
|
|
||||||
puts $fd [format " %12.6f" $newval]
|
|
||||||
} else {
|
|
||||||
incr ind
|
|
||||||
writerange data $fd 0 $ind
|
|
||||||
puts $fd [format " %12.6f" $newval]
|
|
||||||
incr ind
|
|
||||||
writerange data $fd $ind $data(nl)
|
|
||||||
}
|
|
||||||
close $fd
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
|
|
||||||
#------- fcentre
|
|
||||||
# fcentre centers a reflection
|
|
||||||
proc fcentre {} {
|
|
||||||
#----- rough centering
|
|
||||||
opti clear
|
|
||||||
opti countmode monitor
|
|
||||||
opti preset 1000
|
|
||||||
opti threshold 30
|
|
||||||
opti addvar om .1 25 .10
|
|
||||||
opti addvar stt .20 25 .25
|
|
||||||
opti addvar ch 1.0 20 1.
|
|
||||||
set ret [catch {opti run} msg]
|
|
||||||
if {$ret == 1} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
#----- fine centering
|
|
||||||
opti preset 5000
|
|
||||||
opti threshold 50
|
|
||||||
set ret [catch {opti run} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set txt [om]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tom [lindex $l 1]
|
|
||||||
set txt [stt]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tstt [lindex $l 1]
|
|
||||||
set txt [ch]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tch [lindex $l 1]
|
|
||||||
set txt [ph]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tph [lindex $l 1]
|
|
||||||
ClientPut "Two-Theta Omega Chi Phi"
|
|
||||||
ClientPut [format "%-10.2f%-10.2f%-10.2f%-10.2f" $tstt $tom $tch $tph]
|
|
||||||
storepos
|
|
||||||
}
|
|
||||||
@ -1,4 +0,0 @@
|
|||||||
cscan a4 0. .2 10 2
|
|
||||||
for {set i 0} { $i < 5} { incr i} {
|
|
||||||
count timer 200
|
|
||||||
}
|
|
||||||
178
ftest.tcl
178
ftest.tcl
@ -1,178 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for a simulated FOCUS instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke November 1998
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 7000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileDir /data/koenneck/src/sics/tmp
|
|
||||||
#LogFileDir is the directory where the command log is going
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName /data/koenneck/src/sics/tmp/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
|
|
||||||
ServerOption ServerPort 2911
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2914
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
# Telnet options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory /data/koenneck/src/sics/tcl
|
|
||||||
|
|
||||||
#------ a port for broadcasting UDP messages
|
|
||||||
#ServerOption QuieckPort 2108
|
|
||||||
|
|
||||||
TokenInit connan
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 1
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "FOCUS" #initialisation
|
|
||||||
Instrument lock
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake sample Text User
|
|
||||||
sample "Altorferit"
|
|
||||||
VarMake Temperature Float User
|
|
||||||
Temperature 21.5
|
|
||||||
Title "Hochdestillierter Schrott"
|
|
||||||
VarMake User Text User
|
|
||||||
User "Stefan & Felix & Lothar"
|
|
||||||
|
|
||||||
#--------- FOCUS special variables
|
|
||||||
VarMake BeStatus Int User
|
|
||||||
BeStatus 0
|
|
||||||
VarMake flightpath Text Mugger
|
|
||||||
flightpath "Standard"
|
|
||||||
VarMake flightpathlength Float Mugger
|
|
||||||
flightpathlength 3000
|
|
||||||
VarMake ferminame Text Mugger
|
|
||||||
ferminame "Dornier Fermi Chopper"
|
|
||||||
ferminame lock
|
|
||||||
VarMake fermidist Float Mugger
|
|
||||||
fermidist 3000
|
|
||||||
VarMake detectordist Float Mugger
|
|
||||||
detectordist 2500
|
|
||||||
VarMake sampledist Float Mugger
|
|
||||||
sampledist 499.7
|
|
||||||
sampledist lock
|
|
||||||
VarMake chopperrot Float User
|
|
||||||
chopperrot 10000
|
|
||||||
VarMake fermirot Float User
|
|
||||||
fermirot 12000
|
|
||||||
VarMake fermiphase Float User
|
|
||||||
fermiphase 22.23
|
|
||||||
VarMake environment Text User
|
|
||||||
environment Void
|
|
||||||
VarMake delay Float User
|
|
||||||
delay 155.8
|
|
||||||
VarMake sampleangle Float User
|
|
||||||
sampleangle 0.0
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
#Motor D1V EL734 lnsp22.psi.ch 4000 3 3
|
|
||||||
Motor A1 SIM 30.0 120. .1 2. # Monochromator Theta
|
|
||||||
Motor A2 SIM 30. 120. .1 1. # Monochromator 2Theta
|
|
||||||
Motor MTL SIM -30. 30. .1 3. # mono lower translation
|
|
||||||
Motor MTU SIM -30. 30. .1 3. # mono upper translation
|
|
||||||
Motor MGU SIM -50. 50. .1 3. # mono upper goniometer
|
|
||||||
Motor MGL SIM -50. 50. .1 3. # mono lower goniometer
|
|
||||||
|
|
||||||
ClientPut "Motors done"
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R S
|
|
||||||
MakeCounter counter SIM
|
|
||||||
#MakeCounter counter EL737 lnsp19.psi.ch 4000 4
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# M U L T I D E V I C E V A R I A B L E S
|
|
||||||
MakeMono Mono "Ge-111" A1 A2
|
|
||||||
MakeWaveLength lambda Mono
|
|
||||||
MakeEnergy qi Mono
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
MakeDrive
|
|
||||||
MakeRuenBuffer
|
|
||||||
#---------------- TestVariables for Storage
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath "/data/koenneck/src/sics/"
|
|
||||||
SicsDataPath lock
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix test
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".hdf"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
|
|
||||||
MakeDataNumber SicsDataNumber "/data/koenneck/src/sics/danu.dat"
|
|
||||||
|
|
||||||
SerialInit
|
|
||||||
Publish serialport User
|
|
||||||
Publish p1 User
|
|
||||||
Publish HakleGet User
|
|
||||||
#------------------ Focus tests
|
|
||||||
proc chopper {text } {
|
|
||||||
ClientPut "chopper.speed = 17050"
|
|
||||||
ClientPut "chopper.phase = 13.33"
|
|
||||||
}
|
|
||||||
Publish chopper Spy
|
|
||||||
#--------- create a time array for histogramming
|
|
||||||
MakeHM banana SIM
|
|
||||||
banana configure HistMode TOF
|
|
||||||
banana configure OverFlowMode Ceil
|
|
||||||
banana configure Rank 1
|
|
||||||
banana configure Length 76800
|
|
||||||
banana configure BinWidth 4
|
|
||||||
banana preset 100.
|
|
||||||
banana CountMode Timer
|
|
||||||
banana genbin 120. 35. 512
|
|
||||||
banana init
|
|
||||||
MakeFocusAverager average banana
|
|
||||||
|
|
||||||
FocusInstall banana focus.dic
|
|
||||||
273
hakle.tcl
273
hakle.tcl
@ -1,273 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# H A K L E
|
|
||||||
#
|
|
||||||
# Driver for the Haake water bath thermostat in the SINQ setup. This driver
|
|
||||||
# is realised in Tcl and uses the tclev interface for talking to SICS.
|
|
||||||
#
|
|
||||||
# copyright: see copyright.h
|
|
||||||
#
|
|
||||||
# Mark Koennecke, February 1998
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
set HakleNUM 0
|
|
||||||
|
|
||||||
proc HakleSend args {
|
|
||||||
upvar #0 [lindex $args 0] ar
|
|
||||||
set command [lrange $args 1 end]
|
|
||||||
set ret [catch {$ar(socket) $command} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
ClientPut $msg
|
|
||||||
error -701
|
|
||||||
}
|
|
||||||
return $msg
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# HakleCheck tests a answer from the Hake for validity. Valid answers
|
|
||||||
# contain a $. Errors no $ and and F as first character.
|
|
||||||
proc HakleCheck {text } {
|
|
||||||
if { [string match *\$ $text]} {
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
if { [string match F* $text] } {
|
|
||||||
error -703
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc HakleCommand args {
|
|
||||||
upvar #0 [lindex $args 0] ar
|
|
||||||
set ret [catch {eval HakleSend $args} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set ret [catch {HakleCheck $msg} msg2]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg2
|
|
||||||
}
|
|
||||||
return $msg
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc HakleInit {Hakle} {
|
|
||||||
upvar $Hakle ar
|
|
||||||
global HakleNUM
|
|
||||||
#------ open a connection
|
|
||||||
set nam hakle$HakleNUM
|
|
||||||
set ret [catch {serialport $nam $ar(computer) $ar(port) \
|
|
||||||
$ar(channel) 1} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
ClientPut $msg
|
|
||||||
error -700
|
|
||||||
}
|
|
||||||
set ar(socket) $nam
|
|
||||||
incr HakleNUM
|
|
||||||
set ar(intern) 1
|
|
||||||
set ar(pending) 0
|
|
||||||
set ar(lastread) 20.00
|
|
||||||
#----- configure
|
|
||||||
$nam -replyterm "1\r"
|
|
||||||
$nam -tmo 1800
|
|
||||||
#----- block local
|
|
||||||
set ret [catch {HakleCommand $Hakle OUT MODE 3 0} msg ]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error -$msg
|
|
||||||
}
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc HakleClose {Hakle} {
|
|
||||||
upvar #0 $Hakle ar
|
|
||||||
set ret [catch {HakleCommand $Hakle OUT MODE 3 1} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
ClientPut "Error resettting Haake Thermostat"
|
|
||||||
}
|
|
||||||
rename $ar(socket) ""
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc HakleWrapper args {
|
|
||||||
upvar #0 [lindex $args 0] ar
|
|
||||||
if { [llength $args] < 2 } {
|
|
||||||
error "Insufficient number of commands"
|
|
||||||
}
|
|
||||||
set key [lindex $args 1]
|
|
||||||
switch -exact $key {
|
|
||||||
sensor {
|
|
||||||
if { [llength $args] > 2 } {
|
|
||||||
set val [lindex $args 2]
|
|
||||||
#------- switch to intern
|
|
||||||
if { [string compare $val intern] == 0 } {
|
|
||||||
set ret [catch {HakleCommand [lindex $args 0] OUT MODE 2 0} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
set ar(intern) 1
|
|
||||||
}
|
|
||||||
#-------- switch to extern
|
|
||||||
} elseif { [string compare $val extern] == 0 } {
|
|
||||||
set ret [catch {HakleCommand [lindex $args 0] OUT MODE 2 1} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
set ar(intern) 0
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
error -705
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
if { $ar(intern) == 1 } {
|
|
||||||
ClientPut [format "%s.sensor intern" $ar(MyName)]
|
|
||||||
return 1
|
|
||||||
} else {
|
|
||||||
ClientPut [format "%s.sensor extern" $ar(MyName)]
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
list {
|
|
||||||
if { $ar(intern) == 1 } {
|
|
||||||
ClientPut [format "%s.sensor intern" $ar(MyName)]
|
|
||||||
error -700
|
|
||||||
} else {
|
|
||||||
ClientPut [format "%s.sensor extern" $ar(MyName)]
|
|
||||||
error -700
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
error -700
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc HakleSet {Hakle val} {
|
|
||||||
upvar #0 $Hakle ar
|
|
||||||
# ClientPut "HakleSet"
|
|
||||||
set ret [catch {$ar(socket) [format "OUT SP 1 %f" $val]} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
ClientPut $msg
|
|
||||||
error -701
|
|
||||||
}
|
|
||||||
set ret [catch {HakleCheck $msg} msg2]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg2
|
|
||||||
}
|
|
||||||
set ar(pending) 0
|
|
||||||
return $msg
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc HakleGet {Hakle} {
|
|
||||||
upvar #0 $Hakle ar
|
|
||||||
if {$ar(intern) == 1} {
|
|
||||||
set ret [catch {eval HakleCommand $Hakle IN PV 1} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
set ret [catch {HakleCommand IN PV 2} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set ans [string trim $msg \$]
|
|
||||||
set ans2 [string trim $ans]
|
|
||||||
set ans3 [string trim $ans2 C]
|
|
||||||
#------ fix some pecularities of the Haake, sometimes it gives empty
|
|
||||||
# messages or double +
|
|
||||||
if { [string length $ans3] < 3 } {
|
|
||||||
return $ar(lastread)
|
|
||||||
}
|
|
||||||
if { [string first "++" $ans3] >= 0 } {
|
|
||||||
set ans3 [string range $ans3 1 end]
|
|
||||||
}
|
|
||||||
set ar(lastread) $ans3
|
|
||||||
return $ans3
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc HakleGet2 {Hakle} {
|
|
||||||
upvar #0 $Hakle ar
|
|
||||||
# ClientPut "HakleGet"
|
|
||||||
if {$ar(pending) == 0} {
|
|
||||||
if {$ar(intern) == 1} {
|
|
||||||
set ret [catch {$ar(socket) -put IN PV 1} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
ClientPut $msg
|
|
||||||
error -701
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
set ret [catch {$ar(socket) -put IN PV 2} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
ClientPut $msg
|
|
||||||
error -701
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set ar(pending) 1
|
|
||||||
return $ar(lastread)
|
|
||||||
} else {
|
|
||||||
if {[$ar(socket) -readable] == 1 } {
|
|
||||||
set ar(pending) 0
|
|
||||||
set ret [catch {$ar(socket) -get} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
ClientPut $msg
|
|
||||||
error -701
|
|
||||||
}
|
|
||||||
set ans [string trim $msg \$]
|
|
||||||
set ans2 [string trim $ans]
|
|
||||||
set ans3 [string trim $ans2 C]
|
|
||||||
set ar(lastread) $ans3
|
|
||||||
return $ans3
|
|
||||||
} else {
|
|
||||||
return $ar(lastread)
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
proc HakleError {Hakle val} {
|
|
||||||
upvar #0 $Hakle ar
|
|
||||||
switch -exact -- $val {
|
|
||||||
-700 {
|
|
||||||
return "Cannot open socket"
|
|
||||||
}
|
|
||||||
-701 {
|
|
||||||
return "Error sending command"
|
|
||||||
}
|
|
||||||
-703 {
|
|
||||||
return "Invalid command sent"
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
return "Unknown error code"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
proc HakleFix {Hakle val} {
|
|
||||||
upvar #0 $Hakle ar
|
|
||||||
switch -exact -- $val {
|
|
||||||
-700 {
|
|
||||||
return DEVFAIL
|
|
||||||
}
|
|
||||||
-701 {
|
|
||||||
return DEVREDO
|
|
||||||
}
|
|
||||||
-703 {
|
|
||||||
return DEVREDO
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
return DEVFAIL
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc inihaakearray {ar comp port chan} {
|
|
||||||
upvar #0 $ar Hakle
|
|
||||||
set Hakle(Init) HakleInit
|
|
||||||
set Hakle(Close) HakleClose
|
|
||||||
set Hakle(Send) HakleSend
|
|
||||||
set Hakle(SetValue) HakleSet
|
|
||||||
set Hakle(GetValue) HakleGet
|
|
||||||
set Hakle(GetError) HakleError
|
|
||||||
set Hakle(TryFixIt) HakleFix
|
|
||||||
set Hakle(Wrapper) HakleWrapper
|
|
||||||
set Hakle(computer) $comp
|
|
||||||
set Hakle(port) $port
|
|
||||||
set Hakle(channel) $chan
|
|
||||||
set Hakle(num) 0
|
|
||||||
set Hakle(lastread) 20.00
|
|
||||||
}
|
|
||||||
34
helium.tcl
34
helium.tcl
@ -1,34 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# helium: a script for reading the helium level from an AMI-135 Helium Level
|
|
||||||
# Monitor.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, December 1999
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
|
|
||||||
#--------- some code to do proper initialization if necessary
|
|
||||||
set ret [catch {helium} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
Publish heliumport Spy
|
|
||||||
Publish helium Spy
|
|
||||||
Publish heliuminit Mugger
|
|
||||||
}
|
|
||||||
|
|
||||||
#--------------- initialize things
|
|
||||||
proc heliuminit {mac chan} {
|
|
||||||
serialport heliumport $mac 4000 $chan
|
|
||||||
heliumport -tmo 2000
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
#--------------- real work
|
|
||||||
proc helium {} {
|
|
||||||
set ret [catch {heliumport cm} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set ret [catch {heliumport level} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
return [format "helium = %6.2f cm" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
22
inc.tcl
22
inc.tcl
@ -1,22 +0,0 @@
|
|||||||
#---------------------------------------------------------------------------
|
|
||||||
# This script reads a file specified on the command line line by line.
|
|
||||||
# Each line is than enclosed with puts " line " . You obtain a tcl file
|
|
||||||
# which prints the text in the file
|
|
||||||
#
|
|
||||||
# Mark Koennecke October 1996
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
|
|
||||||
if {$argc < 1} {
|
|
||||||
puts "Usage: tclsh inc.tcl file_to_Convert"
|
|
||||||
exit
|
|
||||||
}
|
|
||||||
|
|
||||||
set file [lindex $argv 0]
|
|
||||||
|
|
||||||
set f [open $file r ]
|
|
||||||
|
|
||||||
while { ! [eof $f] } {
|
|
||||||
gets $f line
|
|
||||||
set line [string trimleft $line]
|
|
||||||
puts [format "puts \" %s \" " $line]
|
|
||||||
}
|
|
||||||
@ -1,4 +0,0 @@
|
|||||||
#dillution initialisation
|
|
||||||
evfactory new temp dillu lnsp19.psi.ch 4000 1 dilu.tem
|
|
||||||
temp lowerlimit 0
|
|
||||||
temp upperlimit 5.
|
|
||||||
7
itc4.tcl
7
itc4.tcl
@ -1,7 +0,0 @@
|
|||||||
evfactory new temp ITC4 lnsp19 4000 7
|
|
||||||
temp lowerlimit 0
|
|
||||||
temp upperlimit 300
|
|
||||||
temp control 2
|
|
||||||
temp sensor 3
|
|
||||||
temp divisor 100
|
|
||||||
temp multiplicator 10
|
|
||||||
@ -1,96 +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 adress
|
|
||||||
}
|
|
||||||
305
object.tcl
305
object.tcl
@ -1,305 +0,0 @@
|
|||||||
#
|
|
||||||
# $Id$
|
|
||||||
#
|
|
||||||
# This software is copyright (C) 1995 by the Lawrence Berkeley Laboratory.
|
|
||||||
#
|
|
||||||
# Redistribution and use in source and binary forms, with or without
|
|
||||||
# modification, are permitted provided that: (1) source code distributions
|
|
||||||
# retain the above copyright notice and this paragraph in its entirety, (2)
|
|
||||||
# distributions including binary code include the above copyright notice and
|
|
||||||
# this paragraph in its entirety in the documentation or other materials
|
|
||||||
# provided with the distribution, and (3) all advertising materials mentioning
|
|
||||||
# features or use of this software display the following acknowledgement:
|
|
||||||
# ``This product includes software developed by the University of California,
|
|
||||||
# Lawrence Berkeley Laboratory and its contributors.'' Neither the name of
|
|
||||||
# the University nor the names of its contributors may be used to endorse
|
|
||||||
# or promote products derived from this software without specific prior
|
|
||||||
# written permission.
|
|
||||||
#
|
|
||||||
# THIS SOFTWARE IS PROVIDED ``AS IS'' AND WITHOUT ANY EXPRESS OR IMPLIED
|
|
||||||
# WARRANTIES, INCLUDING, WITHOUT LIMITATION, THE IMPLIED WARRANTIES OF
|
|
||||||
# MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.
|
|
||||||
#
|
|
||||||
|
|
||||||
set object_priv(currentClass) {}
|
|
||||||
set object_priv(objectCounter) 0
|
|
||||||
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc object_class {name spec} {
|
|
||||||
global object_priv
|
|
||||||
set object_priv(currentClass) $name
|
|
||||||
lappend object_priv(objects) $name
|
|
||||||
upvar #0 ${name}_priv class
|
|
||||||
set class(__members) {}
|
|
||||||
set class(__methods) {}
|
|
||||||
set class(__params) {}
|
|
||||||
set class(__class_vars) {}
|
|
||||||
set class(__class_methods) {}
|
|
||||||
uplevel $spec
|
|
||||||
proc $name:config args "uplevel \[concat object_config \$args]"
|
|
||||||
proc $name:configure args "uplevel \[concat object_config \$args]"
|
|
||||||
proc $name:cget {self option} "uplevel \[list object_cget \$self \$option]"
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------
|
|
||||||
proc method {name args body} {
|
|
||||||
global object_priv
|
|
||||||
set className $object_priv(currentClass)
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
if {[lsearch $class(__methods) $name] < 0} {
|
|
||||||
lappend class(__methods) $name
|
|
||||||
}
|
|
||||||
set methodArgs self
|
|
||||||
append methodArgs " " $args
|
|
||||||
proc $className:$name $methodArgs "upvar #0 \$self slot ${className}_priv class_var\n$body"
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------
|
|
||||||
proc object_method {name {defaultValue {}}} [info body method]
|
|
||||||
#------------------------------------------------------------------
|
|
||||||
proc member {name {defaultValue {}}} {
|
|
||||||
global object_priv
|
|
||||||
set className $object_priv(currentClass)
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
lappend class(__members) [list $name $defaultValue]
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc object_member {name {defaultValue {}}} [info body member]
|
|
||||||
#---------------------------------------------------------------------
|
|
||||||
proc param {name {defaultValue {}} {resourceClass {}} {configCode {}}} {
|
|
||||||
global object_priv
|
|
||||||
set className $object_priv(currentClass)
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
if {$resourceClass == ""} {
|
|
||||||
set resourceClass \
|
|
||||||
[string toupper [string index $name 0]][string range $name 1 end]
|
|
||||||
}
|
|
||||||
if ![info exists class(__param_info/$name)] {
|
|
||||||
lappend class(__params) $name
|
|
||||||
}
|
|
||||||
set class(__param_info/$name) [list $defaultValue $resourceClass]
|
|
||||||
if {$configCode != {}} {
|
|
||||||
proc $className:config:$name self $configCode
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc object_param {name {defaultValue {}} {resourceClass {}} {configCode {}}} \
|
|
||||||
[info body param]
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc object_class_var {name {initialValue ""}} {
|
|
||||||
global object_priv
|
|
||||||
set className $object_priv(currentClass)
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
set class($name) $initialValue
|
|
||||||
set class(__initial_value.$name) $initialValue
|
|
||||||
lappend class(__class_vars) $name
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc object_class_method {name args body} {
|
|
||||||
global object_priv
|
|
||||||
set className $object_priv(currentClass)
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
if {[lsearch $class(__class_methods) $name] < 0} {
|
|
||||||
lappend class(__class_methods) $name
|
|
||||||
}
|
|
||||||
proc $className:$name $args "upvar #0 ${className}_priv class_var\n$body"
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc object_include {super_class_name} {
|
|
||||||
global object_priv
|
|
||||||
set className $object_priv(currentClass)
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
upvar #0 ${super_class_name}_priv super_class
|
|
||||||
foreach p $super_class(__params) {
|
|
||||||
lappend class(__params) $p
|
|
||||||
set class(__param_info/$p) $super_class(__param_info/$p)
|
|
||||||
}
|
|
||||||
set class(__members) [concat $super_class(__members) $class(__members)]
|
|
||||||
set class(__class_vars) \
|
|
||||||
[concat $super_class(__class_vars) $class(__class_vars)]
|
|
||||||
foreach v $super_class(__class_vars) {
|
|
||||||
set class($v) \
|
|
||||||
[set class(__initial_value.$v) $super_class(__initial_value.$v)]
|
|
||||||
}
|
|
||||||
set class(__class_methods) \
|
|
||||||
[concat $super_class(__class_methods) $class(__class_methods)]
|
|
||||||
set class(__methods) \
|
|
||||||
[concat $super_class(__methods) $class(__methods)]
|
|
||||||
foreach m $super_class(__methods) {
|
|
||||||
set proc $super_class_name:$m
|
|
||||||
proc $className:$m [object_get_formals $proc] [info body $proc]
|
|
||||||
}
|
|
||||||
foreach m $super_class(__class_methods) {
|
|
||||||
set proc $super_class_name:$m
|
|
||||||
regexp "^\[^\n\]+\n(.*)" [info body $proc] dummy body
|
|
||||||
proc $className:$m [object_get_formals $proc] \
|
|
||||||
"upvar #0 ${className}_priv class_var\n$body"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc object_new {className {name {}}} {
|
|
||||||
if {$name == {}} {
|
|
||||||
global object_priv
|
|
||||||
set name O_[incr object_priv(objectCounter)]
|
|
||||||
}
|
|
||||||
upvar #0 $name object
|
|
||||||
upvar #0 ${className}_priv class
|
|
||||||
set object(__class) $className
|
|
||||||
foreach var $class(__params) {
|
|
||||||
set info $class(__param_info/$var)
|
|
||||||
set resourceClass [lindex $info 1]
|
|
||||||
if ![catch {set val [option get $name $var $resourceClass]}] {
|
|
||||||
if {$val == ""} {
|
|
||||||
set val [lindex $info 0]
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
set val [lindex $info 0]
|
|
||||||
}
|
|
||||||
set object($var) $val
|
|
||||||
}
|
|
||||||
foreach var $class(__members) {
|
|
||||||
set object([lindex $var 0]) [lindex $var 1]
|
|
||||||
}
|
|
||||||
proc $name {method args} [format {
|
|
||||||
upvar #0 %s object
|
|
||||||
uplevel [concat $object(__class):$method %s $args]
|
|
||||||
} $name $name]
|
|
||||||
return $name
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------
|
|
||||||
proc object_define_creator {windowType name spec} {
|
|
||||||
object_class $name $spec
|
|
||||||
if {[info procs $name:create] == {}} {
|
|
||||||
error "widget \"$name\" must define a create method"
|
|
||||||
}
|
|
||||||
if {[info procs $name:reconfig] == {}} {
|
|
||||||
error "widget \"$name\" must define a reconfig method"
|
|
||||||
}
|
|
||||||
proc $name {window args} [format {
|
|
||||||
%s $window -class %s
|
|
||||||
rename $window object_window_of$window
|
|
||||||
upvar #0 $window object
|
|
||||||
set object(__window) $window
|
|
||||||
object_new %s $window
|
|
||||||
proc %s:frame {self args} \
|
|
||||||
"uplevel \[concat object_window_of$window \$args]"
|
|
||||||
uplevel [concat $window config $args]
|
|
||||||
$window create
|
|
||||||
set object(__created) 1
|
|
||||||
bind $window <Destroy> \
|
|
||||||
"if !\[string compare %%W $window\] { object_delete $window }"
|
|
||||||
$window reconfig
|
|
||||||
return $window
|
|
||||||
} $windowType \
|
|
||||||
[string toupper [string index $name 0]][string range $name 1 end] \
|
|
||||||
$name $name]
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------
|
|
||||||
proc object_config {self args} {
|
|
||||||
upvar #0 $self object
|
|
||||||
set len [llength $args]
|
|
||||||
if {$len == 0} {
|
|
||||||
upvar #0 $object(__class)_priv class
|
|
||||||
set result {}
|
|
||||||
foreach param $class(__params) {
|
|
||||||
set info $class(__param_info/$param)
|
|
||||||
lappend result \
|
|
||||||
[list -$param $param [lindex $info 1] [lindex $info 0] \
|
|
||||||
$object($param)]
|
|
||||||
}
|
|
||||||
if [info exists object(__window)] {
|
|
||||||
set result [concat $result [object_window_of$object(__window) config]]
|
|
||||||
}
|
|
||||||
return $result
|
|
||||||
}
|
|
||||||
if {$len == 1} {
|
|
||||||
upvar #0 $object(__class)_priv class
|
|
||||||
if {[string index $args 0] != "-"} {
|
|
||||||
error "param '$args' didn't start with dash"
|
|
||||||
}
|
|
||||||
set param [string range $args 1 end]
|
|
||||||
if {[set ndx [lsearch -exact $class(__params) $param]] == -1} {
|
|
||||||
if [info exists object(__window)] {
|
|
||||||
return [object_window_of$object(__window) config -$param]
|
|
||||||
}
|
|
||||||
error "no param '$args'"
|
|
||||||
}
|
|
||||||
set info $class(__param_info/$param)
|
|
||||||
return [list -$param $param [lindex $info 1] [lindex $info 0] \
|
|
||||||
$object($param)]
|
|
||||||
}
|
|
||||||
# accumulate commands and eval them later so that no changes will take
|
|
||||||
# place if we find an error
|
|
||||||
set cmds ""
|
|
||||||
while {$args != ""} {
|
|
||||||
set fieldId [lindex $args 0]
|
|
||||||
if {[string index $fieldId 0] != "-"} {
|
|
||||||
error "param '$fieldId' didn't start with dash"
|
|
||||||
}
|
|
||||||
set fieldId [string range $fieldId 1 end]
|
|
||||||
if ![info exists object($fieldId)] {
|
|
||||||
if {[info exists object(__window)]} {
|
|
||||||
if [catch [list object_window_of$object(__window) config -$fieldId]] {
|
|
||||||
error "tried to set param '$fieldId' which did not exist."
|
|
||||||
} else {
|
|
||||||
lappend cmds \
|
|
||||||
[list object_window_of$object(__window) config -$fieldId [lindex $args 1]]
|
|
||||||
set args [lrange $args 2 end]
|
|
||||||
continue
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
}
|
|
||||||
if {[llength $args] == 1} {
|
|
||||||
return $object($fieldId)
|
|
||||||
} else {
|
|
||||||
lappend cmds [list set object($fieldId) [lindex $args 1]]
|
|
||||||
if {[info procs $object(__class):config:$fieldId] != {}} {
|
|
||||||
lappend cmds [list $self config:$fieldId]
|
|
||||||
}
|
|
||||||
set args [lrange $args 2 end]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
foreach cmd $cmds {
|
|
||||||
eval $cmd
|
|
||||||
}
|
|
||||||
if {[info exists object(__created)] && [info procs $object(__class):reconfig] != {}} {
|
|
||||||
$self reconfig
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc object_cget {self var} {
|
|
||||||
upvar #0 $self object
|
|
||||||
return [lindex [object_config $self $var] 4]
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc object_delete self {
|
|
||||||
upvar #0 $self object
|
|
||||||
if {[info exists object(__class)] && [info commands $object(__class):destroy] != ""} {
|
|
||||||
$object(__class):destroy $self
|
|
||||||
}
|
|
||||||
if [info exists object(__window)] {
|
|
||||||
if [string length [info commands object_window_of$self]] {
|
|
||||||
catch {rename $self {}}
|
|
||||||
rename object_window_of$self $self
|
|
||||||
}
|
|
||||||
destroy $self
|
|
||||||
}
|
|
||||||
catch {unset object}
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc object_slotname slot {
|
|
||||||
upvar self self
|
|
||||||
return [set self]($slot)
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc object_get_formals {proc} {
|
|
||||||
set formals {}
|
|
||||||
foreach arg [info args $proc] {
|
|
||||||
if [info default $proc $arg def] {
|
|
||||||
lappend formals [list $arg $def]
|
|
||||||
} else {
|
|
||||||
lappend formals $arg
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return $formals
|
|
||||||
}
|
|
||||||
37
optfn.tcl
37
optfn.tcl
@ -1,37 +0,0 @@
|
|||||||
fileeval /data/jschefer/sbn/sbn.ub
|
|
||||||
opti clear
|
|
||||||
opti countmode monitor
|
|
||||||
opti preset 5000
|
|
||||||
opti threshold 50
|
|
||||||
opti addvar om .1 30 .2
|
|
||||||
opti preset 5000
|
|
||||||
opti addvar stt .15 29 .3
|
|
||||||
opti addvar ch 0.9 17 .9
|
|
||||||
opti addvar om .05 25 .1
|
|
||||||
set ret [catch {opti run} msg]
|
|
||||||
if {$ret != 0 } {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set txt [om]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tom [lindex $l 1]
|
|
||||||
set txt [stt]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tstt [lindex $l 1]
|
|
||||||
set txt [ch]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tch [lindex $l 1]
|
|
||||||
set txt [ph]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tph [lindex $l 1]
|
|
||||||
ClientPut "Two-Theta Omega Chi Phi"
|
|
||||||
ClientPut [format "%-10.2f%-10.2f%-10.2f%-10.2f" $tstt $tom $tch $tph]
|
|
||||||
rliste store
|
|
||||||
liste write q.q
|
|
||||||
set ttom [string trim $tom]
|
|
||||||
scan mode monitor
|
|
||||||
clientput " *** centering ------final omega scan ------------------"
|
|
||||||
cscan om $ttom 0.04 20 5678
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
22
optn.tcl
22
optn.tcl
@ -1,22 +0,0 @@
|
|||||||
opti clear
|
|
||||||
opti countmode monitor
|
|
||||||
opti preset 1000
|
|
||||||
opti threshold 30
|
|
||||||
opti addvar om .1 25 .10
|
|
||||||
opti addvar stt .20 25 .25
|
|
||||||
opti addvar ch 1.0 20 1.
|
|
||||||
opti run
|
|
||||||
set txt [om]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tom [lindex $l 1]
|
|
||||||
set txt [stt]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tstt [lindex $l 1]
|
|
||||||
set txt [ch]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tch [lindex $l 1]
|
|
||||||
set txt [ph]
|
|
||||||
set l [split $txt =]
|
|
||||||
set tph [lindex $l 1]
|
|
||||||
ClientPut "Two-Theta Omega Chi Phi"
|
|
||||||
ClientPut [format "%-10.2f%-10.2f%-10.2f%-10.2f" $tstt $tom $tch $tph]
|
|
||||||
499
peaksearch.tcl
499
peaksearch.tcl
@ -1,499 +0,0 @@
|
|||||||
#---------------------------------------------------------------------------
|
|
||||||
# peaksearch a peak search utility for TRICS using the PSD detectors.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, November 2001
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
|
|
||||||
proc initPeakSearch {} {
|
|
||||||
|
|
||||||
#------- phi Range
|
|
||||||
VarMake ps.phiStart Float User
|
|
||||||
ps.phiStart 0
|
|
||||||
VarMake ps.phiEnd Float User
|
|
||||||
ps.phiEnd 180
|
|
||||||
VarMake ps.phiStep Float User
|
|
||||||
ps.phiStep 3.
|
|
||||||
|
|
||||||
#-------- chi range
|
|
||||||
VarMake ps.chiStart Float User
|
|
||||||
ps.chiStart 0
|
|
||||||
VarMake ps.chiEnd Float User
|
|
||||||
ps.chiEnd 180
|
|
||||||
VarMake ps.chiStep Float User
|
|
||||||
ps.chiStep 12.
|
|
||||||
|
|
||||||
#-------- omega range
|
|
||||||
VarMake ps.omStart Float User
|
|
||||||
ps.omStart 0
|
|
||||||
VarMake ps.omEnd Float User
|
|
||||||
ps.omEnd 30
|
|
||||||
VarMake ps.omStep Float User
|
|
||||||
ps.omStep 3.
|
|
||||||
|
|
||||||
#------- two theta range
|
|
||||||
VarMake ps.sttStart Float User
|
|
||||||
ps.sttStart 5
|
|
||||||
VarMake ps.sttEnd Float User
|
|
||||||
ps.sttEnd 70
|
|
||||||
VarMake ps.sttStep Float User
|
|
||||||
ps.sttStep 3.
|
|
||||||
|
|
||||||
#------- maximum finding parameters
|
|
||||||
VarMake ps.threshold Int User
|
|
||||||
ps.threshold 30
|
|
||||||
VarMake ps.steepness Int User
|
|
||||||
ps.steepness 3
|
|
||||||
VarMake ps.window Int User
|
|
||||||
ps.window 7
|
|
||||||
VarMake ps.cogwindow Int User
|
|
||||||
ps.cogwindow 60
|
|
||||||
VarMake ps.cogcontour Float User
|
|
||||||
ps.cogcontour .2
|
|
||||||
|
|
||||||
#-------- counting parameters
|
|
||||||
VarMake ps.countmode Text User
|
|
||||||
ps.countmode monitor
|
|
||||||
VarMake ps.preset Float User
|
|
||||||
ps.preset 1000
|
|
||||||
|
|
||||||
#-------- final scan counting parameters
|
|
||||||
VarMake ps.scanpreset Float User
|
|
||||||
ps.scanpreset 1000000
|
|
||||||
VarMake ps.scansteps Int User
|
|
||||||
ps.scansteps 24
|
|
||||||
|
|
||||||
#--------- file to which to write the results
|
|
||||||
VarMake ps.listfile Text User
|
|
||||||
ps.listfile peaksearch.dat
|
|
||||||
|
|
||||||
#--------- conversion factors from Pixel to mm
|
|
||||||
VarMake xfactor Float Mugger
|
|
||||||
xfactor 0.715
|
|
||||||
VarMake yfactor Float Mugger
|
|
||||||
yfactor 1.42
|
|
||||||
|
|
||||||
#--------- published functions
|
|
||||||
Publish ps.phirange User
|
|
||||||
Publish ps.chirange User
|
|
||||||
Publish ps.omrange User
|
|
||||||
Publish ps.sttrange User
|
|
||||||
Publish ps.countpar User
|
|
||||||
Publish ps.scanpar User
|
|
||||||
Publish ps.maxpar User
|
|
||||||
Publish ps.list User
|
|
||||||
Publish ps.listpeaks User
|
|
||||||
Publish ps.run User
|
|
||||||
Publish ps.continue User
|
|
||||||
Publish ps.scanlist User
|
|
||||||
#------- these are for debugging only!
|
|
||||||
Publish checkomega User
|
|
||||||
Publish optimizedetector User
|
|
||||||
Publish optimizepeak User
|
|
||||||
Publish printpeak User
|
|
||||||
Publish initsearch User
|
|
||||||
Publish catchdrive User
|
|
||||||
Publish catchdriveval User
|
|
||||||
Publish scandetectorsD User
|
|
||||||
Publish scandetectors User
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc ps.phirange args {
|
|
||||||
if { [llength $args] >= 3 } {
|
|
||||||
ps.phiStart [lindex $args 0]
|
|
||||||
ps.phiEnd [lindex $args 1]
|
|
||||||
ps.phiStep [lindex $args 2]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Phi Range:"
|
|
||||||
return [format " Start = %6.2f, End = %6.2f, Step = %6.2f" \
|
|
||||||
[SplitReply [ps.phiStart]] [SplitReply [ps.phiEnd]] \
|
|
||||||
[SplitReply [ps.phiStep]]]
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc ps.chirange args {
|
|
||||||
if { [llength $args] >= 3 } {
|
|
||||||
ps.chiStart [lindex $args 0]
|
|
||||||
ps.chiEnd [lindex $args 1]
|
|
||||||
ps.chiStep [lindex $args 2]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Chi Range:"
|
|
||||||
return [format " Start = %6.2f, End = %6.2f, Step = %6.2f" \
|
|
||||||
[SplitReply [ps.chiStart]] [SplitReply [ps.chiEnd]] \
|
|
||||||
[SplitReply [ps.chiStep]]]
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc ps.omrange args {
|
|
||||||
if { [llength $args] >= 3 } {
|
|
||||||
ps.omStart [lindex $args 0]
|
|
||||||
ps.omEnd [lindex $args 1]
|
|
||||||
ps.omStep [lindex $args 2]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Omega Range:"
|
|
||||||
return [format " Start = %6.2f, End = %6.2f, Step = %6.2f" \
|
|
||||||
[SplitReply [ps.omStart]] [SplitReply [ps.omEnd]] \
|
|
||||||
[SplitReply [ps.omStep]]]
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc ps.sttrange args {
|
|
||||||
if { [llength $args] >= 3 } {
|
|
||||||
ps.sttStart [lindex $args 0]
|
|
||||||
ps.sttEnd [lindex $args 1]
|
|
||||||
ps.sttStep [lindex $args 2]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Two Theta Range:"
|
|
||||||
return [format " Start = %6.2f, End = %6.2f, Step = %6.2f" \
|
|
||||||
[SplitReply [ps.sttStart]] [SplitReply [ps.sttEnd]] \
|
|
||||||
[SplitReply [ps.sttStep]]]
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc ps.countpar args {
|
|
||||||
if { [llength $args] >= 2 } {
|
|
||||||
if { [catch {counter setmode [lindex $args 0]} msg] != 0} {
|
|
||||||
error "ERROR: Invalid countmode specified"
|
|
||||||
}
|
|
||||||
ps.countmode [lindex $args 0]
|
|
||||||
ps.preset [lindex $args 1]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Count Parameters:"
|
|
||||||
return [format " Mode = %s, Preset = %12.2f" \
|
|
||||||
[SplitReply [ps.countmode]] [SplitReply [ps.preset]]]
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc ps.scanpar args {
|
|
||||||
if { [llength $args] >= 2 } {
|
|
||||||
ps.scanpreset [lindex $args 0]
|
|
||||||
ps.scansteps [lindex $args 1]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Scan Parameters:"
|
|
||||||
return [format " Count Preset = %12.2f, No. Steps %4d" \
|
|
||||||
[SplitReply [ps.scanpreset]] [SplitReply [ps.scansteps]]]
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc ps.maxpar args {
|
|
||||||
if { [llength $args] >= 5 } {
|
|
||||||
ps.window [lindex $args 0]
|
|
||||||
ps.threshold [lindex $args 1]
|
|
||||||
ps.steepness [lindex $args 2]
|
|
||||||
ps.cogwindow [lindex $args 3]
|
|
||||||
ps.cogcontour [lindex $args 4]
|
|
||||||
}
|
|
||||||
clientput "Peak Search Maximum Detection Parameters:"
|
|
||||||
set t1 [format " Window = %d, Threshold = %d * average, Steepness = %d" \
|
|
||||||
[SplitReply [ps.window]] [SplitReply [ps.threshold]] \
|
|
||||||
[SplitReply [ps.steepness] ]]
|
|
||||||
set t2 [format " COGWindow = %d, COGcontour = %f " \
|
|
||||||
[SplitReply [ps.cogwindow]] [SplitReply [ps.cogcontour]]]
|
|
||||||
return [format "%s\n%s" $t1 $t2]
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc ps.list {} {
|
|
||||||
clientput [ps.sttrange]
|
|
||||||
clientput [ps.omrange]
|
|
||||||
clientput [ps.chirange]
|
|
||||||
clientput [ps.phirange]
|
|
||||||
clientput [ps.countpar]
|
|
||||||
clientput [ps.scanpar]
|
|
||||||
clientput [ps.maxpar]
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
proc string2list {txt} {
|
|
||||||
return [split [string trim $txt \{\}]]
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
proc checknewomega {hm x y omega maxIntensity} {
|
|
||||||
if {[catch {drive om $omega} msg] != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
if {[catch {hmc start [SplitReply [ps.preset]] [string trim [SplitReply \
|
|
||||||
[ps.countmode]]]} msg] != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
if {[catch {Success} msg] != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
if { [catch {lomax cog $hm $x $y} result] != 0} {
|
|
||||||
error "Failed to calculate COG: $result"
|
|
||||||
}
|
|
||||||
set result [split $result " "]
|
|
||||||
if {[lindex $result 2] > $maxIntensity } {
|
|
||||||
return $result
|
|
||||||
} else {
|
|
||||||
return 0
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
proc optimizedetector {hm} {
|
|
||||||
if { [catch {lomax stat $hm} result] != 0} {
|
|
||||||
#--- This can be due to the fact that the detector is missing. Sigh ....
|
|
||||||
return
|
|
||||||
}
|
|
||||||
set l2 [split [string trim $result]]
|
|
||||||
lomax threshold [expr [lindex $l2 0] * [SplitReply [ps.threshold]]]
|
|
||||||
set result [lomax search $hm]
|
|
||||||
set oldom [SplitReply [om]]
|
|
||||||
set result [split $result @]
|
|
||||||
for {set i 0} { $i < [llength $result]} {incr i} {
|
|
||||||
if { [catch {drive om $oldom} msg] != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
set piecks [split [lindex $result $i] " "]
|
|
||||||
set x [lindex $piecks 0]
|
|
||||||
set y [lindex $piecks 1]
|
|
||||||
if { [catch {optimizepeak $hm $x $y} msg] != 0} {
|
|
||||||
clientput [format "Aborted peak at %d %d with %s" $x $y $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
proc optimizepeak {hm x y} {
|
|
||||||
if { [catch {lomax cog $hm $x $y} result] != 0} {
|
|
||||||
error "Failed to calculate COG: $result"
|
|
||||||
}
|
|
||||||
set result [split $result " "]
|
|
||||||
set xMax [lindex $result 0]
|
|
||||||
set yMax [lindex $result 1]
|
|
||||||
set maxIntensity [lindex $result 2]
|
|
||||||
set maxOmega [SplitReply [om]]
|
|
||||||
set startOmega $maxOmega
|
|
||||||
set omSearchStep .1
|
|
||||||
#--------- move to positive omega until maximum found
|
|
||||||
while {1} {
|
|
||||||
set newOm [expr [SplitReply [om]] + $omSearchStep]
|
|
||||||
if {[catch {checknewomega $hm $xMax $yMax $newOm $maxIntensity} \
|
|
||||||
result] != 0} {
|
|
||||||
error $result
|
|
||||||
}
|
|
||||||
if {$result != 0} {
|
|
||||||
set xMax [lindex $result 0]
|
|
||||||
set yMax [lindex $result 1]
|
|
||||||
set maxIntensity [lindex $result 2]
|
|
||||||
set maxOmega [SplitReply [om]]
|
|
||||||
} else {
|
|
||||||
break
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#--------- if maxOmega is still startOmega then we were on the right
|
|
||||||
# side of the peak. In this case try to find the maximum in
|
|
||||||
# negative direction
|
|
||||||
if {$maxOmega == $startOmega} {
|
|
||||||
while {1} {
|
|
||||||
set newOm [expr [SplitReply [om]] - $omSearchStep]
|
|
||||||
if {[catch {checknewomega $hm $xMax $yMax $newOm $maxIntensity} \
|
|
||||||
result] != 0} {
|
|
||||||
error $result
|
|
||||||
}
|
|
||||||
if {$result != 0} {
|
|
||||||
set xMax [lindex $result 0]
|
|
||||||
set yMax [lindex $result 1]
|
|
||||||
set maxIntensity [lindex $result 2]
|
|
||||||
set maxOmega [SplitReply [om]]
|
|
||||||
} else {
|
|
||||||
break
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#----------- print the results we have found
|
|
||||||
printpeak $hm $xMax $yMax $maxOmega $maxIntensity
|
|
||||||
#------------ scan the peak for Oksana
|
|
||||||
# set scanStart [expr $maxOmega - 0.1*([SplitReply [ps.scansteps]]/2)]
|
|
||||||
# if { [catch {tricsscan $scanStart .1 [SplitReply [ps.scansteps]] \
|
|
||||||
# [SplitReply [ps.countmode]] [SplitReply [ps.scanpreset]]} msg] } {
|
|
||||||
# error $msg
|
|
||||||
# }
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc printpeak {hm x y om intensity} {
|
|
||||||
set phval [SplitReply [phi]]
|
|
||||||
set chval [SplitReply [chi]]
|
|
||||||
set gamOffset .0
|
|
||||||
switch $hm {
|
|
||||||
hm1 {
|
|
||||||
set tilt [SplitReply [dg1]]
|
|
||||||
set gamOffset .0
|
|
||||||
}
|
|
||||||
hm2 {
|
|
||||||
set tilt [SplitReply [dg2]]
|
|
||||||
set gamOffset 0.
|
|
||||||
}
|
|
||||||
hm3 {
|
|
||||||
set tilt [SplitReply [dg3]]
|
|
||||||
set gamOffset 45.
|
|
||||||
}
|
|
||||||
default {error "Invalid hm requested in printpeak"}
|
|
||||||
}
|
|
||||||
set sttval [expr [SplitReply [stt]] + $gamOffset]
|
|
||||||
set zero [SplitReply [$hm configure dim0]]
|
|
||||||
set xval [expr $x * [SplitReply [xfactor]]]
|
|
||||||
set zero [SplitReply [$hm configure dim1]]
|
|
||||||
set yval [expr $y * [SplitReply [yfactor]]]
|
|
||||||
set line [format "%7.2f%7.2f%7.2f%7.2f%7.2f%7.2f%7.2f%10d" \
|
|
||||||
$xval $yval $sttval $om $chval $phval $tilt $intensity]
|
|
||||||
clientput "Found Peak at:"
|
|
||||||
clientput $line
|
|
||||||
set f [open [string trim [SplitReply [ps.listfile]]] a+]
|
|
||||||
puts $f $line
|
|
||||||
close $f
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc ps.listpeaks {} {
|
|
||||||
clientput "Peakse found so far: "
|
|
||||||
clientput " X Y STT OM CHI PHI TILT INTENSITY"
|
|
||||||
set f [open [string trim [SplitReply [ps.listfile]]] r]
|
|
||||||
while {[gets $f line] > 0} {
|
|
||||||
clientput [format "%s" $line]
|
|
||||||
}
|
|
||||||
close $f
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc initsearch {filename} {
|
|
||||||
#----- stow away filename and empty it
|
|
||||||
ps.listfile $filename
|
|
||||||
set f [open $filename w]
|
|
||||||
close $f
|
|
||||||
#----- tell lomax its parameters
|
|
||||||
lomax threshold [SplitReply [ps.threshold]]
|
|
||||||
lomax steepness [SplitReply [ps.steepness]]
|
|
||||||
lomax window [SplitReply [ps.window]]
|
|
||||||
lomax cogwindow [SplitReply [ps.cogwindow]]
|
|
||||||
lomax cogcontour [SplitReply [ps.cogcontour]]
|
|
||||||
#----- drive to start
|
|
||||||
if { [catch {drive stt [SplitReply [ps.sttStart]] \
|
|
||||||
om [SplitReply [ps.omStart]] \
|
|
||||||
chi [SplitReply [ps.chiStart]] \
|
|
||||||
phi [SplitReply [ps.phiStart]] } msg] != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# This code means: ignore any errors except interrupts when searching
|
|
||||||
|
|
||||||
proc scandetectors {} {
|
|
||||||
# set names [list hm1 hm2 hm3]
|
|
||||||
set names [list hm2 hm3]
|
|
||||||
if {[catch {hmc start [SplitReply [ps.preset]] [string trim [SplitReply \
|
|
||||||
[ps.countmode]]]} msg] != 0} {
|
|
||||||
if{[string compare [getint] continue] != 0} {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
clientput [format "Ignoring: %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
if {[catch {Success} msg] != 0} {
|
|
||||||
if{[string compare [getint] continue] != 0} {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
clientput [format "Ignoring: %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
for {set i 0} { $i < [llength $names]} {incr i} {
|
|
||||||
set ret [catch {optimizedetector [lindex $names $i]} msg]
|
|
||||||
if { $ret != 0} {
|
|
||||||
if {[string compare [getint] continue] != 0} {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
clientput [format "Ignoring problem: %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# loop debugging
|
|
||||||
|
|
||||||
proc scandetectorsD {} {
|
|
||||||
clientput [format "stt = %6.2f, om = %6.2f, chi = %6.2f, phi = %6.2f" \
|
|
||||||
[SplitReply [stt]] [SplitReply [om]] \
|
|
||||||
[SplitReply [chi]] [SplitReply [phi]]]
|
|
||||||
wait 1
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc catchdrive { mot step} {
|
|
||||||
set ret [catch {drive $mot [expr [SplitReply [$mot]] + $step]} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
if {[string compare [getint] continue] != 0} {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
clientput [format "Ignoring: %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc catchdriveval { mot val} {
|
|
||||||
set ret [catch {drive $mot $val} msg]
|
|
||||||
if {$ret != 0} {
|
|
||||||
if {[string compare [getint] continue] != 0} {
|
|
||||||
error $msg
|
|
||||||
} else {
|
|
||||||
clientput [format "Ignoring: %s" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# The actual loop. It is written in a way which allows for the continuation
|
|
||||||
# of a search
|
|
||||||
|
|
||||||
proc searchloop { } {
|
|
||||||
set sttStep [SplitReply [ps.sttStep]]
|
|
||||||
set sttEnd [SplitReply [ps.sttEnd]]
|
|
||||||
set chiStep [SplitReply [ps.chiStep]]
|
|
||||||
set chiEnd [SplitReply [ps.chiEnd]]
|
|
||||||
set phiStep [SplitReply [ps.phiStep]]
|
|
||||||
set phiEnd [SplitReply [ps.phiEnd]]
|
|
||||||
set omStep [SplitReply [ps.omStep]]
|
|
||||||
set omEnd [SplitReply [ps.omEnd]]
|
|
||||||
while {[SplitReply [stt]] + $sttStep <= $sttEnd} {
|
|
||||||
while {[SplitReply [chi]] + $chiStep <= $chiEnd} {
|
|
||||||
while {[SplitReply [om]] + $omStep <= $omEnd} {
|
|
||||||
while {[SplitReply [phi]] + $phiStep <= $phiEnd} {
|
|
||||||
scandetectors
|
|
||||||
catchdrive phi $phiStep
|
|
||||||
}
|
|
||||||
catchdrive om $omStep
|
|
||||||
catchdriveval phi [SplitReply [ps.phiStart]]
|
|
||||||
}
|
|
||||||
catchdrive chi $chiStep
|
|
||||||
catchdriveval om [SplitReply [ps.omStart]]
|
|
||||||
}
|
|
||||||
catchdrive stt $sttStep
|
|
||||||
catchdriveval chi [SplitReply [ps.chiStart]]
|
|
||||||
}
|
|
||||||
return "Peak Search finished normally"
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc ps.run {filename} {
|
|
||||||
initsearch $filename
|
|
||||||
searchloop
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc ps.continue {} {
|
|
||||||
searchloop
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
proc ps.scanlist {} {
|
|
||||||
if { [catch {set f [open [string trim [SplitReply [ps.listfile]]] "r"]} \
|
|
||||||
msg ] != 0} {
|
|
||||||
error $msg
|
|
||||||
}
|
|
||||||
while { [gets $f line] > 0} {
|
|
||||||
set n [stscan $line "%f %f %f %f %f %f" x y stt om chi phi]
|
|
||||||
if {$n < 6} {
|
|
||||||
clientput [format "Skipping invalid line: %s" line]
|
|
||||||
continue
|
|
||||||
}
|
|
||||||
if { [catch {drive stt $stt om $om chi $chi phi $phi} msg] != 0 } {
|
|
||||||
clientput $msg
|
|
||||||
if {[string compare [getint] continue] != 0} {
|
|
||||||
error "ps.scanlist interupted"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
set scanStart [expr $om - 0.1*([SplitReply [ps.scansteps]]/2)]
|
|
||||||
if { [catch {tricsscan $scanStart .1 [SplitReply [ps.scansteps]] \
|
|
||||||
[SplitReply [ps.countmode]] [SplitReply [ps.scanpreset]]} msg] \
|
|
||||||
!= 0 } {
|
|
||||||
clientput $msg
|
|
||||||
if {[string compare [getint] continue] != 0} {
|
|
||||||
error "ps.scanlist interupted"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
close $f
|
|
||||||
return "Scanning list finished"
|
|
||||||
}
|
|
||||||
@ -1,9 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# some tcl for testing Tcl language environment device drivers in psish
|
|
||||||
# Mark Koennecke, February 1998
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
rename Controller serialport
|
|
||||||
|
|
||||||
proc ClientPut {text} {
|
|
||||||
puts stdout $text
|
|
||||||
}
|
|
||||||
665
sans2.tcl
665
sans2.tcl
@ -1,665 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for the instrument SANSII at SINQ
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke, January - March 2003
|
|
||||||
#
|
|
||||||
# Changes:
|
|
||||||
# Pavel Strunz, 15.04.2003: - changed backlash dz (0.15 --> 0.005)
|
|
||||||
# Pavel Strunz, 16.04.2003: - changed NVS forbiden gaps according to the actual NVS037
|
|
||||||
# Pavel Strunz, 23.04.2003: - changed backlash for all ecb motors
|
|
||||||
# Pavel Strunz, 29.04.2003: - hakle.tcl sourced
|
|
||||||
# Pavel Strunz, 20.11.2003: - source sans2geometry, sans2measurement
|
|
||||||
# Pavel Strunz, 03.12.2003: - source scan_a, sans2wavelength, nvs interrupt changed from 3 to 0
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
set root "/home/SANS2"
|
|
||||||
|
|
||||||
set scriptroot $root/sans2_sics
|
|
||||||
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption statusfile $root/data/2003/sans2stat.tcl
|
|
||||||
# File to save the status of the instrument too
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 5
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 5
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wait for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName $root/log/sans2log
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption LogFileDir $root/log
|
|
||||||
# This is where log files from command log go
|
|
||||||
|
|
||||||
ServerOption ServerPort 2911
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2917
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
# Telnet Options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
# The token system
|
|
||||||
TokenInit connan
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Manager Manager 1
|
|
||||||
SicsUser lnsmanager lnsSICSlns 1
|
|
||||||
SicsUser User Looser 2
|
|
||||||
SicsUser sans2user 04lns1 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "SANS-II at SINQ,PSI"
|
|
||||||
#initialisation
|
|
||||||
Instrument lock
|
|
||||||
|
|
||||||
VarMake title Text User
|
|
||||||
VarMake User Text User
|
|
||||||
VarMake SubTitle Text User
|
|
||||||
VarMake environment Text User
|
|
||||||
VarMake comment Text User
|
|
||||||
#VarMake samplename Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake adress Text User
|
|
||||||
VarMake sample Text User
|
|
||||||
VarMake BatchRoot Text User
|
|
||||||
VarMake starttime Text User
|
|
||||||
BatchRoot $root
|
|
||||||
#BatchRoot $root/command
|
|
||||||
|
|
||||||
VarMake sampletable Text User
|
|
||||||
|
|
||||||
#----------- Initialize data storage stuff
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath $root/data/2004/
|
|
||||||
SicsDataPath lock
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix sans2
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".hdf"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
MakeDataNumber SicsDataNumber $root/data/2004/DataNumber
|
|
||||||
|
|
||||||
#=========================================================================
|
|
||||||
# Initialize ECB system
|
|
||||||
#========================================================================
|
|
||||||
|
|
||||||
#--------- GPIB Controller with National Instruments driver
|
|
||||||
MakeGPIB gpib ni
|
|
||||||
|
|
||||||
#-------- MakeECB name gpib-controller board-number gpib-address
|
|
||||||
MakeECB ecb1 gpib 0 5
|
|
||||||
|
|
||||||
#--------- Function to switch ecb to automatic control
|
|
||||||
proc ecbauto {} {
|
|
||||||
ecb1 func 162 1 0 0 0
|
|
||||||
}
|
|
||||||
Publish ecbauto User
|
|
||||||
|
|
||||||
ecbauto
|
|
||||||
|
|
||||||
#-------------- ECB Motors
|
|
||||||
# Motor name ecb ecb-controller ecb-motor-index hardlowerlimit hardupperlimit
|
|
||||||
|
|
||||||
Motor sr ecb ecb1 1 -17500. 17500.
|
|
||||||
sr encoder 0
|
|
||||||
sr control 0
|
|
||||||
sr range 1
|
|
||||||
sr multi 0
|
|
||||||
sr multchan 0
|
|
||||||
sr acceleration 1000
|
|
||||||
sr rotation_dir -1
|
|
||||||
sr startspeed 330
|
|
||||||
sr maxspeed 1000
|
|
||||||
sr auto 330
|
|
||||||
sr manuell 50
|
|
||||||
sr delay 50
|
|
||||||
sr offset 0
|
|
||||||
sr dtolerance .01
|
|
||||||
sr step2deg 1
|
|
||||||
sr step2dig 0
|
|
||||||
sr backlash 500
|
|
||||||
|
|
||||||
Motor stx ecb ecb1 2 -16000. 16000.
|
|
||||||
stx encoder 0
|
|
||||||
stx control 0
|
|
||||||
stx range 1
|
|
||||||
stx multi 0
|
|
||||||
stx multchan 0
|
|
||||||
stx acceleration 500
|
|
||||||
stx rotation_dir -1
|
|
||||||
stx startspeed 330
|
|
||||||
stx maxspeed 1000
|
|
||||||
stx auto 500
|
|
||||||
stx manuell 50
|
|
||||||
stx delay 50
|
|
||||||
stx offset 0
|
|
||||||
stx dtolerance .01
|
|
||||||
stx step2deg 1
|
|
||||||
stx step2dig 0
|
|
||||||
stx backlash 500
|
|
||||||
|
|
||||||
Motor stz ecb ecb1 3 6500. 20000.
|
|
||||||
stz encoder 0
|
|
||||||
stz control 0
|
|
||||||
stz range 1
|
|
||||||
stz multi 0
|
|
||||||
stz multchan 0
|
|
||||||
stz acceleration 500
|
|
||||||
stz rotation_dir -1
|
|
||||||
stz startspeed 330
|
|
||||||
stz maxspeed 1000
|
|
||||||
stz auto 500
|
|
||||||
stz manuell 50
|
|
||||||
stz delay 50
|
|
||||||
stz offset 0
|
|
||||||
stz dtolerance .01
|
|
||||||
stz step2deg 1
|
|
||||||
stz step2dig 0
|
|
||||||
stz backlash 500
|
|
||||||
|
|
||||||
Motor sc ecb ecb1 4 -2000. 70000.
|
|
||||||
sc encoder 0
|
|
||||||
sc control 0
|
|
||||||
sc range 1
|
|
||||||
sc multi 0
|
|
||||||
sc multchan 0
|
|
||||||
sc acceleration 500
|
|
||||||
sc rotation_dir -1
|
|
||||||
sc startspeed 330
|
|
||||||
sc maxspeed 1000
|
|
||||||
sc auto 500
|
|
||||||
sc manuell 50
|
|
||||||
sc delay 50
|
|
||||||
sc offset 0
|
|
||||||
sc dtolerance .01
|
|
||||||
sc step2deg 1
|
|
||||||
sc step2dig 0
|
|
||||||
sc backlash 1000
|
|
||||||
|
|
||||||
Motor gu ecb ecb1 5 -10000. 10000.
|
|
||||||
gu encoder 0
|
|
||||||
gu control 0
|
|
||||||
gu range 1
|
|
||||||
gu multi 0
|
|
||||||
gu multchan 0
|
|
||||||
gu acceleration 500
|
|
||||||
gu rotation_dir -1
|
|
||||||
gu startspeed 330
|
|
||||||
gu maxspeed 1000
|
|
||||||
gu auto 500
|
|
||||||
gu manuell 40
|
|
||||||
gu delay 50
|
|
||||||
gu offset 0
|
|
||||||
gu dtolerance .02
|
|
||||||
gu step2deg 1
|
|
||||||
gu step2dig 0
|
|
||||||
gu backlash 100
|
|
||||||
|
|
||||||
Motor gl ecb ecb1 6 -10000. 10000.
|
|
||||||
gl encoder 0
|
|
||||||
gl control 0
|
|
||||||
gl range 1
|
|
||||||
gl multi 0
|
|
||||||
gl multchan 0
|
|
||||||
gl acceleration 500
|
|
||||||
gl rotation_dir -1
|
|
||||||
gl startspeed 330
|
|
||||||
gl maxspeed 1000
|
|
||||||
gl auto 500
|
|
||||||
gl manuell 40
|
|
||||||
gl delay 50
|
|
||||||
gl offset 0
|
|
||||||
gl dtolerance .02
|
|
||||||
gl step2deg 1
|
|
||||||
gl step2dig 0
|
|
||||||
gl backlash 100
|
|
||||||
|
|
||||||
|
|
||||||
Motor tu ecb ecb1 7 -10000. 10000.
|
|
||||||
tu encoder 0
|
|
||||||
tu control 0
|
|
||||||
tu range 1
|
|
||||||
tu multi 0
|
|
||||||
tu multchan 0
|
|
||||||
tu acceleration 500
|
|
||||||
tu rotation_dir 1
|
|
||||||
tu startspeed 330
|
|
||||||
tu maxspeed 1000
|
|
||||||
tu auto 330
|
|
||||||
tu manuell 40
|
|
||||||
tu delay 50
|
|
||||||
tu offset 0
|
|
||||||
tu dtolerance .01
|
|
||||||
tu step2deg 1
|
|
||||||
tu step2dig 0
|
|
||||||
tu backlash 100
|
|
||||||
|
|
||||||
|
|
||||||
Motor tl ecb ecb1 8 -10000. 10000.
|
|
||||||
tl encoder 0
|
|
||||||
tl control 0
|
|
||||||
tl range 1
|
|
||||||
tl multi 0
|
|
||||||
tl multchan 0
|
|
||||||
tl acceleration 500
|
|
||||||
tl rotation_dir 1
|
|
||||||
tl startspeed 330
|
|
||||||
tl maxspeed 1000
|
|
||||||
tl auto 330
|
|
||||||
tl manuell 40
|
|
||||||
tl delay 50
|
|
||||||
tl offset 0
|
|
||||||
tl dtolerance .01
|
|
||||||
tl step2deg 1
|
|
||||||
tl step2dig 0
|
|
||||||
tl backlash 100
|
|
||||||
|
|
||||||
Motor om ecb ecb1 9 -10000. 10000.
|
|
||||||
om encoder 1
|
|
||||||
om control 1
|
|
||||||
om range 1
|
|
||||||
om multi 0
|
|
||||||
om multchan 0
|
|
||||||
om acceleration 500
|
|
||||||
om rotation_dir 1
|
|
||||||
om startspeed 330
|
|
||||||
om maxspeed 1000
|
|
||||||
om auto 100
|
|
||||||
om manuell 40
|
|
||||||
om delay 50
|
|
||||||
om offset 0
|
|
||||||
om dtolerance .01
|
|
||||||
om step2deg 1
|
|
||||||
om step2dig 10
|
|
||||||
om backlash 100
|
|
||||||
|
|
||||||
Motor sz ecb ecb1 10 -10000. 10000.
|
|
||||||
sz encoder 0
|
|
||||||
sz control 0
|
|
||||||
sz range 1
|
|
||||||
sz multi 0
|
|
||||||
sz multchan 0
|
|
||||||
sz acceleration 500
|
|
||||||
sz rotation_dir 1
|
|
||||||
sz startspeed 330
|
|
||||||
sz maxspeed 1000
|
|
||||||
sz auto 500
|
|
||||||
sz manuell 40
|
|
||||||
sz delay 50
|
|
||||||
sz offset 0
|
|
||||||
sz dtolerance .001
|
|
||||||
sz step2deg 1
|
|
||||||
sz step2dig 0
|
|
||||||
sz backlash 100
|
|
||||||
|
|
||||||
Motor sx ecb ecb1 11 -10000. 10000.
|
|
||||||
sx encoder 0
|
|
||||||
sx control 0
|
|
||||||
sx range 1
|
|
||||||
sx multi 0
|
|
||||||
sx multchan 0
|
|
||||||
sx acceleration 500
|
|
||||||
sx rotation_dir 1
|
|
||||||
sx startspeed 330
|
|
||||||
sx maxspeed 1000
|
|
||||||
sx auto 500
|
|
||||||
sx manuell 40
|
|
||||||
sx delay 50
|
|
||||||
sx offset 0
|
|
||||||
sx dtolerance .01
|
|
||||||
sx step2deg 1
|
|
||||||
sx step2dig 0
|
|
||||||
sx backlash 100
|
|
||||||
|
|
||||||
Motor sy ecb ecb1 12 -10000. 10000.
|
|
||||||
sy encoder 0
|
|
||||||
sy control 0
|
|
||||||
sy range 1
|
|
||||||
sy multi 0
|
|
||||||
sy multchan 0
|
|
||||||
sy acceleration 500
|
|
||||||
sy rotation_dir 1
|
|
||||||
sy startspeed 330
|
|
||||||
sy maxspeed 1000
|
|
||||||
sy auto 500
|
|
||||||
sy manuell 50
|
|
||||||
sy delay 50
|
|
||||||
sy offset 0
|
|
||||||
sy dtolerance .001
|
|
||||||
sy step2deg 1
|
|
||||||
sy step2dig 0
|
|
||||||
sy backlash 100
|
|
||||||
|
|
||||||
Motor dz ecb ecb1 13 0.905 6.015
|
|
||||||
dz encoder 0
|
|
||||||
dz control 0
|
|
||||||
dz range 1
|
|
||||||
dz multi 0
|
|
||||||
dz multchan 0
|
|
||||||
dz acceleration 2000
|
|
||||||
dz rotation_dir -1
|
|
||||||
dz startspeed 330
|
|
||||||
dz maxspeed 1000
|
|
||||||
dz auto 500
|
|
||||||
dz manuell 40
|
|
||||||
dz delay 1000
|
|
||||||
dz offset 0
|
|
||||||
dz dtolerance .001
|
|
||||||
dz step2deg 53076
|
|
||||||
dz step2dig 0
|
|
||||||
dz backlash .005
|
|
||||||
|
|
||||||
Motor dh ecb ecb1 14 -10100. 16400.
|
|
||||||
dh encoder 0
|
|
||||||
dh control 0
|
|
||||||
dh range 1
|
|
||||||
dh multi 0
|
|
||||||
dh multchan 0
|
|
||||||
dh acceleration 1000
|
|
||||||
dh rotation_dir -1
|
|
||||||
dh startspeed 330
|
|
||||||
dh maxspeed 1000
|
|
||||||
dh auto 500
|
|
||||||
dh manuell 40
|
|
||||||
dh delay 50
|
|
||||||
dh offset 0
|
|
||||||
dh dtolerance .001
|
|
||||||
dh step2deg 1
|
|
||||||
dh step2dig 0
|
|
||||||
dh backlash 100
|
|
||||||
|
|
||||||
Motor dv ecb ecb1 15 -14600. 25400.
|
|
||||||
dv encoder 0
|
|
||||||
dv control 0
|
|
||||||
dv range 1
|
|
||||||
dv multi 0
|
|
||||||
dv multchan 0
|
|
||||||
dv acceleration 2000
|
|
||||||
dv rotation_dir -1
|
|
||||||
dv startspeed 330
|
|
||||||
dv maxspeed 1000
|
|
||||||
dv auto 500
|
|
||||||
dv manuell 40
|
|
||||||
dv delay 50
|
|
||||||
dv offset 0
|
|
||||||
dv dtolerance .001
|
|
||||||
dv step2deg 1
|
|
||||||
dv step2dig 0
|
|
||||||
dv backlash 100
|
|
||||||
|
|
||||||
Motor az1 ecb ecb1 16 -3900. 0.
|
|
||||||
az1 encoder 0
|
|
||||||
az1 control 0
|
|
||||||
az1 range 1
|
|
||||||
az1 multi 0
|
|
||||||
az1 multchan 0
|
|
||||||
az1 acceleration 1000
|
|
||||||
az1 rotation_dir -1
|
|
||||||
az1 startspeed 330
|
|
||||||
az1 maxspeed 1000
|
|
||||||
az1 auto 330
|
|
||||||
az1 manuell 40
|
|
||||||
az1 delay 50
|
|
||||||
az1 offset 0
|
|
||||||
az1 dtolerance .001
|
|
||||||
az1 step2deg 1
|
|
||||||
az1 step2dig 0
|
|
||||||
az1 backlash 200
|
|
||||||
|
|
||||||
Motor atz ecb ecb1 17 -3900. 0.
|
|
||||||
atz encoder 0
|
|
||||||
atz control 0
|
|
||||||
atz range 1
|
|
||||||
atz multi 0
|
|
||||||
atz multchan 0
|
|
||||||
atz acceleration 1000
|
|
||||||
atz rotation_dir -1
|
|
||||||
atz startspeed 330
|
|
||||||
atz maxspeed 1000
|
|
||||||
atz auto 330
|
|
||||||
atz manuell 40
|
|
||||||
atz delay 50
|
|
||||||
atz offset 0
|
|
||||||
atz dtolerance .001
|
|
||||||
atz step2deg 1
|
|
||||||
atz step2dig 0
|
|
||||||
atz backlash 200
|
|
||||||
|
|
||||||
#===========================================================================
|
|
||||||
# The ECB system has the drawback that only one out of 8 motors in a rack
|
|
||||||
# can run at any given time. Access to such motors has to be serialized.
|
|
||||||
# This is done through the anticollision system originally developed for
|
|
||||||
# TRICS. This system registers requests from motors to run and then calls
|
|
||||||
# a script which serializes the running of motors. This system is used at
|
|
||||||
# SANS to deal with the rack logic. This section installs the necessary
|
|
||||||
# scripts and configures the system.
|
|
||||||
#===========================================================================
|
|
||||||
AntiCollisionInstall
|
|
||||||
anticollision register sr
|
|
||||||
anticollision register stx
|
|
||||||
anticollision register stz
|
|
||||||
anticollision register sc
|
|
||||||
anticollision register gu
|
|
||||||
anticollision register gl
|
|
||||||
anticollision register tu
|
|
||||||
anticollision register tl
|
|
||||||
anticollision register om
|
|
||||||
anticollision register sz
|
|
||||||
anticollision register sx
|
|
||||||
anticollision register sy
|
|
||||||
anticollision register dz
|
|
||||||
anticollision register dh
|
|
||||||
anticollision register dv
|
|
||||||
anticollision register az1
|
|
||||||
anticollision register atz
|
|
||||||
|
|
||||||
#------------ assignment which motors belong into which rack
|
|
||||||
set rack1 [list sr stx sty sc gu gl tu tl]
|
|
||||||
set rack2 [list om sz sx dz dh dv az1 atz]
|
|
||||||
set rack3 [list sy]
|
|
||||||
|
|
||||||
proc sans2rack args {
|
|
||||||
global rack1 rack2 rack3
|
|
||||||
set length [ expr [llength $args]/2.]
|
|
||||||
#-------- make list which motors have to be run in each rack
|
|
||||||
for { set i 0} { $i < $length} {incr i} {
|
|
||||||
set mot [lindex $args [expr $i * 2]]
|
|
||||||
set target [lindex $args [expr ($i *2) + 1]]
|
|
||||||
if { [lsearch $rack1 $mot] >= 0} {
|
|
||||||
lappend rack1mot $mot
|
|
||||||
lappend rack1target $target
|
|
||||||
}
|
|
||||||
if { [lsearch $rack2 $mot] >= 0} {
|
|
||||||
lappend rack2mot $mot
|
|
||||||
lappend rack2target $target
|
|
||||||
}
|
|
||||||
if { [lsearch $rack3 $mot] >= 0} {
|
|
||||||
lappend rack3mot $mot
|
|
||||||
lappend rack3target $target
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#------- append a dummy to each in order to ensure existence
|
|
||||||
lappend rack1mot dummy
|
|
||||||
lappend rack1target 0.0
|
|
||||||
lappend rack2mot dummy
|
|
||||||
lappend rack2target 0.0
|
|
||||||
lappend rack3mot dummy
|
|
||||||
lappend rack3target 0.0
|
|
||||||
#-------- how many levels do we have?
|
|
||||||
set level -1
|
|
||||||
if { [llength $rack1mot] > $level} {
|
|
||||||
set level [llength $rack1mot]
|
|
||||||
}
|
|
||||||
if { [llength $rack2mot] > $level} {
|
|
||||||
set level [llength $rack2mot]
|
|
||||||
}
|
|
||||||
if { [llength $rack3mot] > $level} {
|
|
||||||
set level [llength $rack3mot]
|
|
||||||
}
|
|
||||||
if { $level <= 1} {
|
|
||||||
error "Nothing to do"
|
|
||||||
}
|
|
||||||
#------------ we are set to serialize
|
|
||||||
anticollision clear
|
|
||||||
for {set i 0} {$i < $level} {incr i} {
|
|
||||||
set tst [expr $i + 1]
|
|
||||||
if { [llength $rack1mot] > $tst} {
|
|
||||||
anticollision add $i [lindex $rack1mot $i] \
|
|
||||||
[lindex $rack1target $i]
|
|
||||||
}
|
|
||||||
if { [llength $rack2mot] > $tst } {
|
|
||||||
anticollision add $i [lindex $rack2mot $i] \
|
|
||||||
[lindex $rack2target $i]
|
|
||||||
}
|
|
||||||
if { [llength $rack3mot] > $tst } {
|
|
||||||
anticollision add $i [lindex $rack3mot $i] \
|
|
||||||
[lindex $rack3target $i]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return
|
|
||||||
}
|
|
||||||
Publish sans2rack User
|
|
||||||
anticollision script sans2rack
|
|
||||||
#====================== PSI Motoren ===================================
|
|
||||||
Motor ome EL734 sans2 4000 3 1
|
|
||||||
Motor chi EL734 sans2 4000 3 2
|
|
||||||
Motor phi EL734 sans2 4000 3 3
|
|
||||||
Motor tilt EL734 sans2 4000 2 1
|
|
||||||
|
|
||||||
SicsAlias ome traz "These motors are used to drive SANS I translation table"
|
|
||||||
SicsAlias chi trax "while ome is sample z and chi is sample x (TG070704)"
|
|
||||||
#====================== Multi Motor Setup ==============================
|
|
||||||
MakeMulti detector
|
|
||||||
detector alias dz x
|
|
||||||
detector endconfig
|
|
||||||
SicsAlias detector dt
|
|
||||||
|
|
||||||
MakeMulti bs
|
|
||||||
bs alias dh x
|
|
||||||
bs alias dv y
|
|
||||||
bs endconfig
|
|
||||||
|
|
||||||
MakeMulti chamber
|
|
||||||
chamber alias sr omega
|
|
||||||
chamber alias stx x
|
|
||||||
chamber alias sty y
|
|
||||||
chamber alias sc c
|
|
||||||
chamber endconfig
|
|
||||||
|
|
||||||
MakeMulti gonio
|
|
||||||
gonio alias gu chi
|
|
||||||
gonio alias gl phi
|
|
||||||
gonio alias tu xu
|
|
||||||
gonio alias tl yu
|
|
||||||
gonio endconfig
|
|
||||||
|
|
||||||
MakeMulti table
|
|
||||||
table alias om om
|
|
||||||
table alias sz z
|
|
||||||
table alias sx x
|
|
||||||
table alias sy y
|
|
||||||
table endconfig#
|
|
||||||
#====================== HISTOGRAM MEMORY ================================
|
|
||||||
MakeCounter counter ecb ecb1
|
|
||||||
MakeECB tdc gpib 0 7
|
|
||||||
MakeHM banana tdc
|
|
||||||
banana configure dim0 128
|
|
||||||
banana configure dim1 128
|
|
||||||
banana configure rank 2
|
|
||||||
banana configure Counter counter
|
|
||||||
banana configure bank 0
|
|
||||||
banana configure map 9
|
|
||||||
banana configure range 0
|
|
||||||
banana configure n 0
|
|
||||||
banana configure ecb tdc
|
|
||||||
banana configure fill 0
|
|
||||||
banana configure mode HMXY
|
|
||||||
banana init
|
|
||||||
banana exponent 6
|
|
||||||
banana CountMode timer
|
|
||||||
banana preset 100
|
|
||||||
=========================== velocity selector ========================
|
|
||||||
set dorn(Host) psts233
|
|
||||||
set dorn(Port) 3004
|
|
||||||
set dorn(Channel) 4
|
|
||||||
set dorn(Timeout) 20000
|
|
||||||
set dorn(MinControl) 6500
|
|
||||||
VelocitySelector nvs tilt dornier2003 dorn
|
|
||||||
#VelocitySelector nvs tilt SIM
|
|
||||||
nvs add -20 28800
|
|
||||||
nvs add 3600 4500
|
|
||||||
nvs add 7800 10500
|
|
||||||
nvs add 21500 23500
|
|
||||||
nvs status
|
|
||||||
nvs interrupt 0
|
|
||||||
MakeSANSWave lambda nvs
|
|
||||||
emon unregister nvswatch
|
|
||||||
#===================================== auxiliary hardware ==============
|
|
||||||
set distoCON [gpib attach 0 14 0 13 0 1]
|
|
||||||
|
|
||||||
#--------- for the Hakle Feucht
|
|
||||||
MakeRS232Controller h50 psts233 3005
|
|
||||||
#===================================== data file writing ================
|
|
||||||
MakeNXScript
|
|
||||||
#===================================== install commands ==================
|
|
||||||
MakeDrive
|
|
||||||
MakeRuenBuffer
|
|
||||||
commandlog auto
|
|
||||||
MakePSDFrame
|
|
||||||
SerialInit
|
|
||||||
#--------- drive command
|
|
||||||
MakeDrive
|
|
||||||
SicsAlias drive dr
|
|
||||||
#----------- for adding scripted content to the status file
|
|
||||||
MakeTclInt bckintern
|
|
||||||
#----- alias for temperature
|
|
||||||
DefineAlias tt temperature
|
|
||||||
#=================================== load specific command files ===========
|
|
||||||
source $scriptroot/sans2com.tcl
|
|
||||||
source $scriptroot/hakle.tcl
|
|
||||||
source $scriptroot/hakle50.tcl
|
|
||||||
source $scriptroot/HaakeSetup.tcl
|
|
||||||
source $scriptroot/A1931Setup.tcl
|
|
||||||
source $scriptroot/sans2geometry.tcl
|
|
||||||
source $scriptroot/sans2measurement.tcl
|
|
||||||
source $scriptroot/sans2wavelength.tcl
|
|
||||||
source $scriptroot/scan_a.tcl
|
|
||||||
# initialisation for IPS-120 superconducting magnet power supply
|
|
||||||
# this definition does not harm other devices used through the same channel
|
|
||||||
ips init localhost 4000 7
|
|
||||||
#=================================== load display definition =============
|
|
||||||
#source $scriptroot/sans2dis.tcl
|
|
||||||
|
|
||||||
#=======================================================================
|
|
||||||
disto
|
|
||||||
334
sans2com.tcl
334
sans2com.tcl
@ -1,334 +0,0 @@
|
|||||||
#-----------------------------------------------------------------------
|
|
||||||
# Scripts for the SANS-II Risoe instrument as installed at PSI.
|
|
||||||
#
|
|
||||||
# Initial version: Mark Koennecke, Febrary 2003
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
#source $root/log.tcl
|
|
||||||
#source $root/batch.tcl
|
|
||||||
source $root/nxsupport.tcl
|
|
||||||
|
|
||||||
if { [info exists sansinit] == 0 } {
|
|
||||||
set sansinit 1
|
|
||||||
Publish beamstop Spy
|
|
||||||
Publish stopmot User
|
|
||||||
# Publish collRead Spy #-----for debugging
|
|
||||||
# Publish collSet Spy #-----for debugging
|
|
||||||
Publish collimator Spy
|
|
||||||
Publish coll Spy
|
|
||||||
# Publis att Spy
|
|
||||||
Publish batchrun User
|
|
||||||
Publish LogBook User
|
|
||||||
Publish count User
|
|
||||||
Publish Repeat User
|
|
||||||
Publish storedata User
|
|
||||||
Publish disto Spy
|
|
||||||
Publish statusinfo Spy
|
|
||||||
Publish displaycontrol User
|
|
||||||
Publish displayunits User
|
|
||||||
Publish setdispar User
|
|
||||||
}
|
|
||||||
#======================== general useful stuff ======================
|
|
||||||
proc SplitReply { text } {
|
|
||||||
set l [split $text =]
|
|
||||||
return [lindex $l 1]
|
|
||||||
}
|
|
||||||
#======================== Collimator stuff ===========================
|
|
||||||
proc collRead args {
|
|
||||||
set res [ecb1 func 164 0 0 0 0]
|
|
||||||
set l [split $res]
|
|
||||||
return [expr ([lindex $l 1] << 8) + [lindex $l 0]]
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------
|
|
||||||
proc collSet {val} {
|
|
||||||
switch $val {
|
|
||||||
1 { set d 0}
|
|
||||||
2 { set d 01}
|
|
||||||
3 { set d 03}
|
|
||||||
4 { set d 07}
|
|
||||||
5 { set d 017}
|
|
||||||
6 { set d 037}
|
|
||||||
default {
|
|
||||||
error "Invalid collimation length requested"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
ecb1 func 148 $d 0 0 0
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------
|
|
||||||
proc collimator args {
|
|
||||||
if { [llength $args ] < 1} {
|
|
||||||
#------------- read case
|
|
||||||
set res [collRead]
|
|
||||||
set res [expr $res & 255]
|
|
||||||
set length -1
|
|
||||||
switch $res {
|
|
||||||
0 { set length 1}
|
|
||||||
1 { set length 2}
|
|
||||||
3 { set length 3}
|
|
||||||
7 { set length 4}
|
|
||||||
15 { set length 5}
|
|
||||||
31 { set length 6}
|
|
||||||
default {
|
|
||||||
error "Unknown reply $res from colRead"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return [format "collimator = %f" $length]
|
|
||||||
} else {
|
|
||||||
#------------- set case
|
|
||||||
set rights [SplitReply [config myrights]]
|
|
||||||
if {$rights > 2} {
|
|
||||||
error "Insufficient rights to drive collimator"
|
|
||||||
}
|
|
||||||
return [collSet [lindex $args 0]]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc coll args {
|
|
||||||
return collimator $args
|
|
||||||
}
|
|
||||||
#======================== Beamstop stuff ==============================
|
|
||||||
proc beamstop args {
|
|
||||||
#----- without arguments: request
|
|
||||||
if { [llength $args] < 1} {
|
|
||||||
set res [collRead 0]
|
|
||||||
if { ($res & 256) > 0 } {
|
|
||||||
return "0 in"
|
|
||||||
} else {
|
|
||||||
return "1 out"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#---- with arguments: change, but only with at least user privilege
|
|
||||||
set rights [SplitReply [config myrights]]
|
|
||||||
if {$rights > 2} {
|
|
||||||
error "Insufficient rights to drive beamstop"
|
|
||||||
}
|
|
||||||
switch [lindex $args 0] {
|
|
||||||
0 { set d 1}
|
|
||||||
in {set d 1}
|
|
||||||
1 {set d 0}
|
|
||||||
out {set d 0}
|
|
||||||
default{
|
|
||||||
error "Invalid beamstop requested"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
ecb1 func 160 $d 0 0 0
|
|
||||||
return OK
|
|
||||||
}
|
|
||||||
#================================ stopmot ================================
|
|
||||||
proc stopmot args {
|
|
||||||
ecb1 func 132 0 0 0 0
|
|
||||||
}
|
|
||||||
#=============================== counting ===============================
|
|
||||||
proc count { {mode NULL } { preset NULL } } {
|
|
||||||
#----- deal with mode
|
|
||||||
set mode2 [string toupper $mode]
|
|
||||||
set mode3 [string trim $mode2]
|
|
||||||
set mc [string index $mode2 0]
|
|
||||||
if { [string compare $mc T] == 0 } {
|
|
||||||
banana CountMode Timer
|
|
||||||
} elseif { [string compare $mc M] == 0 } {
|
|
||||||
banana CountMode Monitor
|
|
||||||
}
|
|
||||||
#------ deal with preset
|
|
||||||
if { [string compare $preset NULL] != 0 } {
|
|
||||||
banana preset $preset
|
|
||||||
}
|
|
||||||
#------ prepare a count message
|
|
||||||
set ret [catch {Success} msg]
|
|
||||||
set a [banana preset]
|
|
||||||
set aa [SplitReply $a]
|
|
||||||
set b [banana CountMode]
|
|
||||||
set bb [SplitReply $b]
|
|
||||||
set tt [sicstime]
|
|
||||||
set sn [SplitReply [sample]]
|
|
||||||
starttime [sicstime]
|
|
||||||
ClientPut [format " Starting counting in %s mode with a preset of %s" \
|
|
||||||
$bb $aa ]
|
|
||||||
ClientPut [format "Count started at %s" $tt]
|
|
||||||
ClientPut [format " sample name: %s" $sn]
|
|
||||||
#------- count
|
|
||||||
banana count
|
|
||||||
set ret [catch {Success} msg]
|
|
||||||
#------- StoreData
|
|
||||||
storedata
|
|
||||||
set ttt [sicstime]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
ClientPut [format "Counting ended at %s" $ttt]
|
|
||||||
error [format "Counting ended with error: %s" $msg]
|
|
||||||
}
|
|
||||||
ClientPut [format "Counting ended at %s" $ttt]
|
|
||||||
ClientPut "Total Counts: [SplitReply [banana sum 0 128 0 128]]"
|
|
||||||
}
|
|
||||||
#---------------- Repeat -----------------------------------------------
|
|
||||||
proc repeat { num {mode NULL} {preset NULL} } {
|
|
||||||
for { set i 0 } { $i < $num } { incr i } {
|
|
||||||
count $mode $preset
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#=================== Data File Writing =================================
|
|
||||||
proc writeBeforeSample args {
|
|
||||||
writeTextVar etitle title
|
|
||||||
writeTextVar etime starttime
|
|
||||||
nxscript puttext endtime [sicstime]
|
|
||||||
writeTextVar iname instrument
|
|
||||||
nxscript puttext sname SINQ, Paul Scherrer Institut
|
|
||||||
nxscript puttext stype Continuous flux spallation source
|
|
||||||
nxscript puttext vname Dornier velocity selector
|
|
||||||
set res [nvs list]
|
|
||||||
set l [split $res "\n"]
|
|
||||||
nxscript putfloat vrot [SplitReply [lindex $l 0]]
|
|
||||||
writeFloatVar vtilt tilt
|
|
||||||
writeFloatvar vlambda lambda
|
|
||||||
writeFloatVar colli collimator
|
|
||||||
# writeFloatVar atti attenuator
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------
|
|
||||||
proc writeSample args {
|
|
||||||
writeTextVar san sample
|
|
||||||
writeTextVar stable sampletable
|
|
||||||
#------------- sample chamber
|
|
||||||
nxscript putmot charo sr
|
|
||||||
nxscript putmot chax stx
|
|
||||||
nxscript putmot chaz stz
|
|
||||||
nxscript putmot chac sc
|
|
||||||
#------------- goniometer
|
|
||||||
nxscript putmot goniox tu
|
|
||||||
nxscript putmot gonioy tl
|
|
||||||
nxscript putmot goniochi gu
|
|
||||||
nxscript putmot goniophi gl
|
|
||||||
#------------- xyz-table
|
|
||||||
nxscript putmot tablex sx
|
|
||||||
nxscript putmot tabley sy
|
|
||||||
nxscript putmot tablez sz
|
|
||||||
nxscript putmot tableom om
|
|
||||||
#------------ sans1table
|
|
||||||
nxscript putmot sans1chi chi
|
|
||||||
nxscript putmot sans1om ome
|
|
||||||
#---------- environment
|
|
||||||
if { [catch {set tmp [SplitReply [temperature]]} tmp] == 0} {
|
|
||||||
nxscript putfloat satemp $tmp
|
|
||||||
}
|
|
||||||
if { [catch {set tmp [SplitReply [magnet]]} tmp] == 0} {
|
|
||||||
nxscript putfloat samag $tmp
|
|
||||||
}
|
|
||||||
writeTextVar saenv environment
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc writeAfterSample args {
|
|
||||||
#-------- beamstop
|
|
||||||
nxscript putmot vsx dh
|
|
||||||
nxscript putmot vsy dv
|
|
||||||
set tst [beamstop]
|
|
||||||
if { [string first in $tst] >= 0} {
|
|
||||||
nxscript putfloat bspos 0
|
|
||||||
} else {
|
|
||||||
nxscript putfloat bspos 1.
|
|
||||||
}
|
|
||||||
#------- counter
|
|
||||||
nxscript putcounter cter counter
|
|
||||||
#------- detector
|
|
||||||
nxscript putmot ddx dz
|
|
||||||
nxscript puthm ddcounts banana
|
|
||||||
for { set i 0} { $i < 128} {incr i} {
|
|
||||||
set detar($i) [expr -64. + $i]
|
|
||||||
}
|
|
||||||
nxscript putarray ddcx detar 128
|
|
||||||
nxscript putarray ddcy detar 128
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc makeLinks args {
|
|
||||||
nxscript makelink dan ddcounts
|
|
||||||
nxscript makelink dan ddcx
|
|
||||||
nxscript makelink dan ddcy
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc storedata args {
|
|
||||||
global root
|
|
||||||
set filnam [makeFileName]
|
|
||||||
clientput [format "Writing %s" $filnam]
|
|
||||||
nxscript create5 $filnam $root/sans2.dic
|
|
||||||
writeStandardAttributes $filnam
|
|
||||||
|
|
||||||
writeBeforeSample
|
|
||||||
|
|
||||||
writeSample
|
|
||||||
|
|
||||||
writeAfterSample
|
|
||||||
|
|
||||||
makeLinks
|
|
||||||
|
|
||||||
nxscript close
|
|
||||||
}
|
|
||||||
#========================= laser distance reading ========================
|
|
||||||
proc disto args {
|
|
||||||
global distoCON
|
|
||||||
gpib sendwithterm $distoCON a 13
|
|
||||||
gpib readtillterm $distoCON 10
|
|
||||||
gpib sendwithterm $distoCON g 13
|
|
||||||
set result [gpib readtillterm $distoCON 10]
|
|
||||||
set l [split $result " +" ]
|
|
||||||
return [string trim [lindex $l 1] 0]
|
|
||||||
}
|
|
||||||
#========================= helper function for status display ============
|
|
||||||
proc statusinfo {} {
|
|
||||||
append result "SICS = " [SplitReply [status]] " \n"
|
|
||||||
append result [title] " \n"
|
|
||||||
append result [sample] " \n"
|
|
||||||
append result [user] " \n"
|
|
||||||
set tst [nvs list]
|
|
||||||
set l [split $tst "\n"]
|
|
||||||
append result "Velocity selector rotation = " \
|
|
||||||
[SplitReply [lindex $l 0]] " \n"
|
|
||||||
append result "lambda = " [SplitReply [lambda]] " \n"
|
|
||||||
append result "Collimation length = " [SplitReply [collimator]] " \n"
|
|
||||||
append result "filenumber = " [SplitReply [sicsdatanumber]] " \n"
|
|
||||||
return $result
|
|
||||||
}
|
|
||||||
#============= scripts for controlling the ECB display unit ============
|
|
||||||
proc disloadpar {unit offset val} {
|
|
||||||
ecb1 func 166 0 [expr $unit -1] $offset $val
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc startdisplay {} {
|
|
||||||
ecb1 func 128 0 0 0 1
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------
|
|
||||||
proc stopdisplay {} {
|
|
||||||
ecb1 func 129 0 0 0 0
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc setdispar {unit name key parnum} {
|
|
||||||
switch $key {
|
|
||||||
timer {set type 1}
|
|
||||||
scaler {set type 2}
|
|
||||||
ratemeter {set type 4}
|
|
||||||
motor {set type 3}
|
|
||||||
encoder {set type 5}
|
|
||||||
default {
|
|
||||||
error "Unknown parameter key"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
stopdisplay
|
|
||||||
disloadpar $unit 0 [ecb1 toint [string index $name 0]]
|
|
||||||
disloadpar $unit 1 [ecb1 toint [string index $name 1]]
|
|
||||||
disloadpar $unit 2 [ecb1 toint [string index $name 2]]
|
|
||||||
disloadpar $unit 3 $parnum
|
|
||||||
disloadpar $unit 4 $type
|
|
||||||
startdisplay
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc cleardisplay {} {
|
|
||||||
ecb1 func 131 0 0 0 0
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
proc defdisplay { num} {
|
|
||||||
ecb1 func 166 1 $num 0 0
|
|
||||||
}
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
proc displayunits { u1 u2 u3 u4} {
|
|
||||||
ecb1 func 130 $u1 $u2 $u3 $u4
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------
|
|
||||||
proc displaycontrol {command} {
|
|
||||||
ecb1 func 170 0 0 $command 0
|
|
||||||
}
|
|
||||||
39
sans2dis.tcl
39
sans2dis.tcl
@ -1,39 +0,0 @@
|
|||||||
#--------------------------------------------------------------------------
|
|
||||||
# display control file for SANS-II
|
|
||||||
#
|
|
||||||
# A place of genuine mystery and magic hacked from the appropriate TASCOM
|
|
||||||
# file.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, February 2003
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
setdispar 1 RmS ratemeter 1
|
|
||||||
setdispar 2 RmM ratemeter 1
|
|
||||||
setdispar 3 RmF ratemeter 1
|
|
||||||
setdispar 4 MON scaler 1
|
|
||||||
setdispar 5 TIM timer 0
|
|
||||||
setdispar 6 "I " scaler 2
|
|
||||||
setdispar 7 "sr " motor 1
|
|
||||||
setdispar 8 stx motor 2
|
|
||||||
setdispar 9 stz motor 3
|
|
||||||
setdispar 10 "sc " motor 4
|
|
||||||
setdispar 11 "gu " motor 5
|
|
||||||
setdispar 12 "gl " motor 6
|
|
||||||
setdispar 13 "tu " motor 7
|
|
||||||
setdispar 14 "tl " motor 8
|
|
||||||
setdispar 15 "om " encoder 1
|
|
||||||
setdispar 16 "sz " motor 10
|
|
||||||
setdispar 17 "sx " motor 11
|
|
||||||
setdispar 18 "sy " motor 12
|
|
||||||
setdispar 19 "dz " motor 13
|
|
||||||
setdispar 20 "dh " motor 14
|
|
||||||
setdispar 21 "dv " motor 15
|
|
||||||
setdispar 22 at1 motor 16
|
|
||||||
setdispar 23 at2 motor 17
|
|
||||||
setdispar 24 aux scaler 3
|
|
||||||
setdispar 25 "I4 " scaler 4
|
|
||||||
setdispar 26 "I5 " scaler 5
|
|
||||||
setdispar 27 "I6 " scaler 6
|
|
||||||
setdispar 28 RdS ratemeter 2
|
|
||||||
setdispar 29 RdM ratemeter 2
|
|
||||||
setdispar 30 RdF ratemeter 2
|
|
||||||
|
|
||||||
168
sansreal.tcl
168
sansreal.tcl
@ -1,168 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script the instrument SANS at SINQ
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke, June 1997
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption SaveFile sansstat.tcl
|
|
||||||
# File to save the status of the instrument too
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 10
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 10
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName /tmp/sanslog
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2915
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2917
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Manager Joachim 1
|
|
||||||
SicsUser User Kohl 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "SANS at SINQ,PSI"
|
|
||||||
#initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake User Text User
|
|
||||||
User "Albert von Villigen"
|
|
||||||
VarMake SubTitle Text User
|
|
||||||
VarMake environment Text User
|
|
||||||
VarMake comment Text User
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
#Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
|
|
||||||
#Motor a4 EL734DC LNSP22 4000 5 6
|
|
||||||
# EL734DC motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
|
|
||||||
# Motor nam SIM -20. 20. 5. 1.0
|
|
||||||
# Simulated motor with name nam, lower limit -20, upper limit +20,
|
|
||||||
# error ratio 5% and speed 1.0. Speed may be omitted
|
|
||||||
|
|
||||||
# Motors for sample movement
|
|
||||||
Motor schi SIM -22.0 +22.0 10.
|
|
||||||
Motor sphi SIM -22.0 +22.0 10.
|
|
||||||
Motor som SIM -180.0 360.0 10.
|
|
||||||
Motor sax SIM -30.0 +30.0 10.
|
|
||||||
Motor say SIM -22.0 +22.0 10.
|
|
||||||
Motor saz SIM .0 30.0 10.
|
|
||||||
|
|
||||||
#Motors for detector movement
|
|
||||||
Motor DetectorX EL734DC lnsp25.psi.ch 4000 3 1
|
|
||||||
DetectorX Precision 0.5
|
|
||||||
Motor DetectorY EL734DC lnsp25.psi.ch 4000 3 2
|
|
||||||
DetectorY Precision 0.2
|
|
||||||
Motor DetectorRotation EL734DC lnsp25.psi.ch 4000 3 3
|
|
||||||
DetectorRotation Precision 0.1
|
|
||||||
|
|
||||||
#Motors for beamstop
|
|
||||||
Motor BeamStopX EL734 lnsp25.psi.ch 4000 2 3
|
|
||||||
BeamStopX Precision 0.2
|
|
||||||
Motor BeamStopY EL734 lnsp25.psi.ch 4000 2 4
|
|
||||||
BeamStopY Precision 0.2
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
# create the drive command
|
|
||||||
MakeDrive
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# MultiMotor is an object which groups several motors together.
|
|
||||||
|
|
||||||
#--------------------------------- sample position
|
|
||||||
MakeMulti sample
|
|
||||||
# creates a MultiMotor with name sample
|
|
||||||
sample alias schi chi
|
|
||||||
# alias creates an internal name (chi) for motor schi
|
|
||||||
sample alias sphi phi
|
|
||||||
sample alias som omega
|
|
||||||
sample alias sax x
|
|
||||||
sample alias say y
|
|
||||||
sample alias saz z
|
|
||||||
sample pos Jo schi 0. sphi 0. som 45. sax 2. say 3. saz 10.
|
|
||||||
# define Jo as a named position. This means with sample Jo you'll reach
|
|
||||||
# the positions specified
|
|
||||||
sample pos Mo schi 0. sphi 0. som 180. sax 2. say 3. saz 10.
|
|
||||||
sample endconfig
|
|
||||||
# ends configuration of sample and install the command. This is REQUIRED
|
|
||||||
|
|
||||||
#---------------------------------- detector position
|
|
||||||
MakeMulti detector
|
|
||||||
detector alias DetectorX X
|
|
||||||
detector alias DetectorY Y
|
|
||||||
detector alias DetectorRotation phi
|
|
||||||
detector endconfig
|
|
||||||
|
|
||||||
#----------------------------------- beamstop
|
|
||||||
MakeMulti BeamStop
|
|
||||||
BeamStop alias BeamStopX X
|
|
||||||
BeamStop alias BeamStopY Y
|
|
||||||
BeamStop pos out BeamStopX 817.
|
|
||||||
BeamStop endconfig
|
|
||||||
#------------------------------------ Shortcuts
|
|
||||||
SicsAlias BeamStop bs
|
|
||||||
SicsAlias detector dt
|
|
||||||
#------------------------------------ Histogram Memory
|
|
||||||
MakeCounter counter EL737 lnsp25.psi.ch 4000 4
|
|
||||||
counter SetExponent 6
|
|
||||||
|
|
||||||
MakeHM banana SINQHM
|
|
||||||
banana configure HistMode Normal
|
|
||||||
banana configure OverFlowMode Ceil
|
|
||||||
banana configure Rank 1
|
|
||||||
banana configure Length 16384
|
|
||||||
banana configure BinWidth 4
|
|
||||||
banana preset 100.
|
|
||||||
banana CountMode Timer
|
|
||||||
banana configure HMComputer lnse02.psi.ch
|
|
||||||
banana configure HMPort 2400
|
|
||||||
banana configure Counter counter
|
|
||||||
banana init
|
|
||||||
banana exponent 6
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
# R U E N B U F F E R
|
|
||||||
MakeRuenBuffer
|
|
||||||
source /data/kohlb/bin/sics/log.tcl
|
|
||||||
Publish LogBook User
|
|
||||||
|
|
||||||
source /data/kohlb/bin/sics/count.tcl
|
|
||||||
Publish count User
|
|
||||||
77
servo.tcl
77
servo.tcl
@ -1,77 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for testing the SICS server. Also example for how
|
|
||||||
# such an insane script might look like,
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke November 1996
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption ServerLogBaseName /data/koenneck/src/sics/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2910
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2913
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument set "Druechal" #initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake User Text User
|
|
||||||
User set "Albert von Villigen"
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
Motor s5 SIM -22.0 +22.0 90.
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O N F I G U R E D E V I C E S T O H A L T I N
|
|
||||||
# I N T E R R U P T
|
|
||||||
AddHalt a4 s5 s6
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
MakeDrive
|
|
||||||
|
|
||||||
MakeCounter simpel SIM
|
|
||||||
295
sicsstat.tcl
295
sicsstat.tcl
@ -1,295 +0,0 @@
|
|||||||
exe batchpath ./
|
|
||||||
exe syspath ./
|
|
||||||
|
|
||||||
#--- BEGIN (commands producing errors on last restore)
|
|
||||||
#--- END (commands producing errors on last restore)
|
|
||||||
|
|
||||||
# Counter counter
|
|
||||||
counter SetPreset 3.000000
|
|
||||||
counter SetMode Timer
|
|
||||||
title UNKNOWN
|
|
||||||
title setAccess 2
|
|
||||||
user Uwe Filges
|
|
||||||
user setAccess 2
|
|
||||||
address UNKNOWN
|
|
||||||
address setAccess 2
|
|
||||||
adress UNKNOWN
|
|
||||||
adress setAccess 2
|
|
||||||
phone UNKNOWN
|
|
||||||
phone setAccess 2
|
|
||||||
email UNKNOWN
|
|
||||||
email setAccess 2
|
|
||||||
affiliation UNKNOWN
|
|
||||||
affiliation setAccess 2
|
|
||||||
countrate 0.000000
|
|
||||||
countrate setAccess 2
|
|
||||||
t2tx targetposition 0
|
|
||||||
t2tx sign 1
|
|
||||||
t2tx softzero 0
|
|
||||||
t2tx softlowerlim 0
|
|
||||||
t2tx softupperlim 2000
|
|
||||||
t2tx fixed -1
|
|
||||||
t2tx interruptmode 0
|
|
||||||
t2tx precision 0.01
|
|
||||||
t2tx accesscode 2
|
|
||||||
t2tx failafter 3
|
|
||||||
t2tx maxretry 3
|
|
||||||
t2tx ignorefault 0
|
|
||||||
t2tx movecount 10
|
|
||||||
t2ty targetposition 0
|
|
||||||
t2ty sign 1
|
|
||||||
t2ty softzero 0
|
|
||||||
t2ty softlowerlim 0
|
|
||||||
t2ty softupperlim 100
|
|
||||||
t2ty fixed -1
|
|
||||||
t2ty interruptmode 0
|
|
||||||
t2ty precision 0.01
|
|
||||||
t2ty accesscode 2
|
|
||||||
t2ty failafter 3
|
|
||||||
t2ty maxretry 3
|
|
||||||
t2ty ignorefault 0
|
|
||||||
t2ty movecount 10
|
|
||||||
sdw 0.000000
|
|
||||||
sdw setAccess 2
|
|
||||||
sdh 0.000000
|
|
||||||
sdh setAccess 2
|
|
||||||
t3tx targetposition 0
|
|
||||||
t3tx sign 1
|
|
||||||
t3tx softzero 0
|
|
||||||
t3tx softlowerlim 0
|
|
||||||
t3tx softupperlim 2000
|
|
||||||
t3tx fixed -1
|
|
||||||
t3tx interruptmode 0
|
|
||||||
t3tx precision 0.01
|
|
||||||
t3tx accesscode 2
|
|
||||||
t3tx failafter 3
|
|
||||||
t3tx maxretry 3
|
|
||||||
t3tx ignorefault 0
|
|
||||||
t3tx movecount 10
|
|
||||||
rt3 targetposition 0
|
|
||||||
rt3 sign 1
|
|
||||||
rt3 softzero 0
|
|
||||||
rt3 softlowerlim -180
|
|
||||||
rt3 softupperlim 180
|
|
||||||
rt3 fixed -1
|
|
||||||
rt3 interruptmode 0
|
|
||||||
rt3 precision 0.01
|
|
||||||
rt3 accesscode 2
|
|
||||||
rt3 failafter 3
|
|
||||||
rt3 maxretry 3
|
|
||||||
rt3 ignorefault 0
|
|
||||||
rt3 movecount 10
|
|
||||||
sew 0.000000
|
|
||||||
sew setAccess 2
|
|
||||||
seh 0.000000
|
|
||||||
seh setAccess 2
|
|
||||||
t4tx targetposition 0
|
|
||||||
t4tx sign 1
|
|
||||||
t4tx softzero 0
|
|
||||||
t4tx softlowerlim 500
|
|
||||||
t4tx softupperlim 12000
|
|
||||||
t4tx fixed -1
|
|
||||||
t4tx interruptmode 0
|
|
||||||
t4tx precision 0.01
|
|
||||||
t4tx accesscode 2
|
|
||||||
t4tx failafter 3
|
|
||||||
t4tx maxretry 3
|
|
||||||
t4tx ignorefault 0
|
|
||||||
t4tx movecount 10
|
|
||||||
t4ty targetposition 0
|
|
||||||
t4ty sign 1
|
|
||||||
t4ty softzero 0
|
|
||||||
t4ty softlowerlim 0
|
|
||||||
t4ty softupperlim 3000
|
|
||||||
t4ty fixed -1
|
|
||||||
t4ty interruptmode 0
|
|
||||||
t4ty precision 0.01
|
|
||||||
t4ty accesscode 2
|
|
||||||
t4ty failafter 3
|
|
||||||
t4ty maxretry 3
|
|
||||||
t4ty ignorefault 0
|
|
||||||
t4ty movecount 10
|
|
||||||
gau targetposition 0
|
|
||||||
gau sign 1
|
|
||||||
gau softzero 0
|
|
||||||
gau softlowerlim -25
|
|
||||||
gau softupperlim 25
|
|
||||||
gau fixed -1
|
|
||||||
gau interruptmode 0
|
|
||||||
gau precision 0.01
|
|
||||||
gau accesscode 2
|
|
||||||
gau failafter 3
|
|
||||||
gau maxretry 3
|
|
||||||
gau ignorefault 0
|
|
||||||
gau movecount 10
|
|
||||||
gal targetposition 0
|
|
||||||
gal sign 1
|
|
||||||
gal softzero 0
|
|
||||||
gal softlowerlim -25
|
|
||||||
gal softupperlim 25
|
|
||||||
gal fixed -1
|
|
||||||
gal interruptmode 0
|
|
||||||
gal precision 0.01
|
|
||||||
gal accesscode 2
|
|
||||||
gal failafter 3
|
|
||||||
gal maxretry 3
|
|
||||||
gal ignorefault 0
|
|
||||||
gal movecount 10
|
|
||||||
t5tx targetposition 0
|
|
||||||
t5tx sign 1
|
|
||||||
t5tx softzero 0
|
|
||||||
t5tx softlowerlim 500
|
|
||||||
t5tx softupperlim 12000
|
|
||||||
t5tx fixed -1
|
|
||||||
t5tx interruptmode 0
|
|
||||||
t5tx precision 0.01
|
|
||||||
t5tx accesscode 2
|
|
||||||
t5tx failafter 3
|
|
||||||
t5tx maxretry 3
|
|
||||||
t5tx ignorefault 0
|
|
||||||
t5tx movecount 10
|
|
||||||
t5ty targetposition 0
|
|
||||||
t5ty sign 1
|
|
||||||
t5ty softzero 0
|
|
||||||
t5ty softlowerlim 0
|
|
||||||
t5ty softupperlim 3000
|
|
||||||
t5ty fixed -1
|
|
||||||
t5ty interruptmode 0
|
|
||||||
t5ty precision 0.01
|
|
||||||
t5ty accesscode 2
|
|
||||||
t5ty failafter 3
|
|
||||||
t5ty maxretry 3
|
|
||||||
t5ty ignorefault 0
|
|
||||||
t5ty movecount 10
|
|
||||||
sal targetposition 0
|
|
||||||
sal sign 1
|
|
||||||
sal softzero 0
|
|
||||||
sal softlowerlim -30
|
|
||||||
sal softupperlim 30
|
|
||||||
sal fixed -1
|
|
||||||
sal interruptmode 0
|
|
||||||
sal precision 0.01
|
|
||||||
sal accesscode 2
|
|
||||||
sal failafter 3
|
|
||||||
sal maxretry 3
|
|
||||||
sal ignorefault 0
|
|
||||||
sal movecount 10
|
|
||||||
sar targetposition 0
|
|
||||||
sar sign 1
|
|
||||||
sar softzero 0
|
|
||||||
sar softlowerlim -30
|
|
||||||
sar softupperlim 30
|
|
||||||
sar fixed -1
|
|
||||||
sar interruptmode 0
|
|
||||||
sar precision 0.01
|
|
||||||
sar accesscode 2
|
|
||||||
sar failafter 3
|
|
||||||
sar maxretry 3
|
|
||||||
sar ignorefault 0
|
|
||||||
sar movecount 10
|
|
||||||
sab targetposition 0
|
|
||||||
sab sign 1
|
|
||||||
sab softzero 0
|
|
||||||
sab softlowerlim -30
|
|
||||||
sab softupperlim 30
|
|
||||||
sab fixed -1
|
|
||||||
sab interruptmode 0
|
|
||||||
sab precision 0.01
|
|
||||||
sab accesscode 2
|
|
||||||
sab failafter 3
|
|
||||||
sab maxretry 3
|
|
||||||
sab ignorefault 0
|
|
||||||
sab movecount 10
|
|
||||||
sat targetposition 0
|
|
||||||
sat sign 1
|
|
||||||
sat softzero 0
|
|
||||||
sat softlowerlim 0
|
|
||||||
sat softupperlim 1000
|
|
||||||
sat fixed -1
|
|
||||||
sat interruptmode 0
|
|
||||||
sat precision 0.01
|
|
||||||
sat accesscode 2
|
|
||||||
sat failafter 3
|
|
||||||
sat maxretry 3
|
|
||||||
sat ignorefault 0
|
|
||||||
sat movecount 10
|
|
||||||
t6tx targetposition 0
|
|
||||||
t6tx sign 1
|
|
||||||
t6tx softzero 0
|
|
||||||
t6tx softlowerlim 500
|
|
||||||
t6tx softupperlim 12000
|
|
||||||
t6tx fixed -1
|
|
||||||
t6tx interruptmode 0
|
|
||||||
t6tx precision 0.01
|
|
||||||
t6tx accesscode 2
|
|
||||||
t6tx failafter 3
|
|
||||||
t6tx maxretry 3
|
|
||||||
t6tx ignorefault 0
|
|
||||||
t6tx movecount 10
|
|
||||||
t6ty targetposition 0
|
|
||||||
t6ty sign 1
|
|
||||||
t6ty softzero 0
|
|
||||||
t6ty softlowerlim 0
|
|
||||||
t6ty softupperlim 3000
|
|
||||||
t6ty fixed -1
|
|
||||||
t6ty interruptmode 0
|
|
||||||
t6ty precision 0.01
|
|
||||||
t6ty accesscode 2
|
|
||||||
t6ty failafter 3
|
|
||||||
t6ty maxretry 3
|
|
||||||
t6ty ignorefault 0
|
|
||||||
t6ty movecount 10
|
|
||||||
sbl targetposition 0
|
|
||||||
sbl sign 1
|
|
||||||
sbl softzero 0
|
|
||||||
sbl softlowerlim -30
|
|
||||||
sbl softupperlim 30
|
|
||||||
sbl fixed -1
|
|
||||||
sbl interruptmode 0
|
|
||||||
sbl precision 0.01
|
|
||||||
sbl accesscode 2
|
|
||||||
sbl failafter 3
|
|
||||||
sbl maxretry 3
|
|
||||||
sbl ignorefault 0
|
|
||||||
sbl movecount 10
|
|
||||||
sbr targetposition 0
|
|
||||||
sbr sign 1
|
|
||||||
sbr softzero 0
|
|
||||||
sbr softlowerlim -30
|
|
||||||
sbr softupperlim 30
|
|
||||||
sbr fixed -1
|
|
||||||
sbr interruptmode 0
|
|
||||||
sbr precision 0.01
|
|
||||||
sbr accesscode 2
|
|
||||||
sbr failafter 3
|
|
||||||
sbr maxretry 3
|
|
||||||
sbr ignorefault 0
|
|
||||||
sbr movecount 10
|
|
||||||
sbb targetposition 0
|
|
||||||
sbb sign 1
|
|
||||||
sbb softzero 0
|
|
||||||
sbb softlowerlim -30
|
|
||||||
sbb softupperlim 30
|
|
||||||
sbb fixed -1
|
|
||||||
sbb interruptmode 0
|
|
||||||
sbb precision 0.01
|
|
||||||
sbb accesscode 2
|
|
||||||
sbb failafter 3
|
|
||||||
sbb maxretry 3
|
|
||||||
sbb ignorefault 0
|
|
||||||
sbb movecount 10
|
|
||||||
sbt targetposition 0
|
|
||||||
sbt sign 1
|
|
||||||
sbt softzero 0
|
|
||||||
sbt softlowerlim 0
|
|
||||||
sbt softupperlim 1000
|
|
||||||
sbt fixed -1
|
|
||||||
sbt interruptmode 0
|
|
||||||
sbt precision 0.01
|
|
||||||
sbt accesscode 2
|
|
||||||
sbt failafter 3
|
|
||||||
sbt maxretry 3
|
|
||||||
sbt ignorefault 0
|
|
||||||
sbt movecount 10
|
|
||||||
hm preset 12
|
|
||||||
hm mode timer
|
|
||||||
@ -1,10 +0,0 @@
|
|||||||
# Motor m4
|
|
||||||
m4 sign 1.000000
|
|
||||||
m4 SoftZero 0.000000
|
|
||||||
m4 SoftLowerLim -22.004999
|
|
||||||
m4 SoftUpperLim 21.995001
|
|
||||||
m4 Fixed -1.000000
|
|
||||||
m4 InterruptMode 0.000000
|
|
||||||
m4 precision 0.010000
|
|
||||||
m4 AccessCode 2.000000
|
|
||||||
m4 poscount 10.000000
|
|
||||||
@ -1,107 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# This file contaisn template generation code for SICS programming
|
|
||||||
#
|
|
||||||
# copyright: see file COPYRIGHT
|
|
||||||
#
|
|
||||||
# Mark Koennecke, December 2006
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc stdIncludes {} {
|
|
||||||
append txt "#include <stdlib.h>\n"
|
|
||||||
append txt "#include <assert.h>\n"
|
|
||||||
append txt "#include <sics.h>\n"
|
|
||||||
append txt "#include <splitter.h>\n"
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
proc makeSicsFunc {name} {
|
|
||||||
append txt "int ${name}(SConnection *pCon,SicsInterp *pSics, void *pData,\n"
|
|
||||||
append txt " int argc, char *argv\[\])"
|
|
||||||
return $txt
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc newStruc {name indent} {
|
|
||||||
set pre [string repeat " " $indent]
|
|
||||||
append txt "pNew = malloc(sizeof($name));\n"
|
|
||||||
append txt $pre "if(pNew == NULL){\n"
|
|
||||||
append txt $pre " return NULL;\n"
|
|
||||||
append txt $pre "}\n"
|
|
||||||
append txt $pre "memset(pNew,0,sizeof($name));\n"
|
|
||||||
return $txt
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc newStrucRet {name indent retval} {
|
|
||||||
set pre [string repeat " " $indent]
|
|
||||||
append txt "pNew = malloc(sizeof($name));\n"
|
|
||||||
append txt $pre "if(pNew == NULL){\n"
|
|
||||||
append txt $pre " return $retval;\n"
|
|
||||||
append txt $pre "}\n"
|
|
||||||
append txt $pre "memset(pNew,0,sizeof($name));\n"
|
|
||||||
return $txt
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
proc testNoPar {noPar indent} {
|
|
||||||
set pre [string repeat " " $indent]
|
|
||||||
append txt "if(argc < $noPar){\n"
|
|
||||||
append txt $pre " SCWrite(pCon,\"ERROR: Not enough arguments\",eError);\n"
|
|
||||||
append txt $pre " return 0;\n"
|
|
||||||
append txt $pre "}\n"
|
|
||||||
return $txt
|
|
||||||
}
|
|
||||||
#-------------------------------------------------------------------------------
|
|
||||||
proc testPriv {priv indent} {
|
|
||||||
set pre [string repeat " " $indent]
|
|
||||||
append txt "if(!SCMatchRights(pCon,$priv)){\n"
|
|
||||||
append txt $pre " return 0;\n"
|
|
||||||
append txt $pre "}\n"
|
|
||||||
return $txt
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------------
|
|
||||||
proc sicsPar {parName parCName noPar priv type indent} {
|
|
||||||
set pre [string repeat " " $indent]
|
|
||||||
append txt "if(argc < $noPar) {\n"
|
|
||||||
switch $type {
|
|
||||||
int {
|
|
||||||
append txt $pre
|
|
||||||
append txt " snprintf(buffer,512,\"%s.%s = %d\", argv\[0\], \"$parName\", $parCName);\n"
|
|
||||||
}
|
|
||||||
float {
|
|
||||||
append txt $pre
|
|
||||||
append txt " snprintf(buffer,512,\"%s.%s = %f\", argv\[0\], \"$parName\", $parCName);\n"
|
|
||||||
}
|
|
||||||
text {
|
|
||||||
append txt $pre
|
|
||||||
append txt " snprintf(buffer,512,\"%s.%s = %s\", argv\[0\], \"$parName\", $parCName);\n"
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
error "$type is unknown"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
append txt $pre "} else {\n"
|
|
||||||
append txt $pre " " [testPriv $priv [expr $indent + 4]]
|
|
||||||
set n [expr $noPar -1]
|
|
||||||
switch $type {
|
|
||||||
int {
|
|
||||||
append txt $pre " status = sscanf(argv\[$n\],\"%d\",&$parCName);\n"
|
|
||||||
}
|
|
||||||
float {
|
|
||||||
append txt $pre " status = sscanf(argv\[$n\],\"%f\",&$parCName);\n"
|
|
||||||
}
|
|
||||||
text {
|
|
||||||
append txt $pre " if($parCName != NULL){\n"
|
|
||||||
append txt $pre " free($parCName);\n"
|
|
||||||
append txt $pre " }\n"
|
|
||||||
append txt $pre " $parCName = strdup(argv\[$n\]);\n"
|
|
||||||
append txt $pre " status = 1;\n"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
append txt $pre " if(status != 1) {\n"
|
|
||||||
append txt $pre " snprintf(buffer,512,"
|
|
||||||
append txt "\"ERROR: failed to convert %s to $type\",argv\[$n\]);\n"
|
|
||||||
append txt $pre " SCWrite(pCon,buffer,eError);\n"
|
|
||||||
append txt $pre " return 0;\n"
|
|
||||||
append txt $pre " } else {\n"
|
|
||||||
append txt $pre " SCSendOK(pCon);\n"
|
|
||||||
append txt $pre " return 1;\n"
|
|
||||||
append txt $pre " }\n"
|
|
||||||
append txt $pre "}"
|
|
||||||
return $txt
|
|
||||||
}
|
|
||||||
387
sinfo.tcl
387
sinfo.tcl
@ -1,387 +0,0 @@
|
|||||||
# requires stooop package from tcllib
|
|
||||||
# loaded from sycamore.tcl
|
|
||||||
|
|
||||||
proc arga argStr {
|
|
||||||
set args [ split $argStr ]
|
|
||||||
set argc [llength $args]
|
|
||||||
# syc::debug "arga.argc = %s" $argc
|
|
||||||
set objName ""
|
|
||||||
set key ""
|
|
||||||
set name ""
|
|
||||||
set val ""
|
|
||||||
set bObj [expr $argc > 0]
|
|
||||||
set bKey [expr $argc > 1]
|
|
||||||
set bName [expr $argc > 2]
|
|
||||||
set bVal [expr $argc > 3]
|
|
||||||
if $bObj {
|
|
||||||
set objName [string tolower [lindex $args 0]]
|
|
||||||
#syc::debug "arga.objName = %s" $objName
|
|
||||||
}
|
|
||||||
if $bKey {
|
|
||||||
set key [string tolower [lindex $args 1]]
|
|
||||||
#syc::debug "arga.key = %s" $key
|
|
||||||
}
|
|
||||||
if $bName {
|
|
||||||
set name [string tolower [lindex $args 2]]
|
|
||||||
}
|
|
||||||
if $bVal {
|
|
||||||
set val [string tolower [lindex $args 3]]
|
|
||||||
}
|
|
||||||
# ? cannot get 'array set' to work in the form:
|
|
||||||
# array set argv {
|
|
||||||
# argc $argc
|
|
||||||
# objName $objName
|
|
||||||
# ... etcetera
|
|
||||||
# }
|
|
||||||
set argv(argc) $argc
|
|
||||||
set argv(bObj) $bObj
|
|
||||||
set argv(bKey) $bKey
|
|
||||||
set argv(bName) $bName
|
|
||||||
set argv(bVal) $bVal
|
|
||||||
set argv(objName) $objName
|
|
||||||
set argv(key) $key
|
|
||||||
set argv(name) $name
|
|
||||||
set argv(val) $val
|
|
||||||
# would like to return associative array
|
|
||||||
# for now, settle for list
|
|
||||||
# syc::debug "arga.argv = { %s }" [array get argv]
|
|
||||||
return [array get argv]
|
|
||||||
}
|
|
||||||
|
|
||||||
# -----------------------------------------------------------------------------
|
|
||||||
class sinfo { ;# base class definition
|
|
||||||
proc sinfo {this} { ;# base class constructor
|
|
||||||
# non-static data member initialisation
|
|
||||||
set ($this,objectID) $this
|
|
||||||
}
|
|
||||||
|
|
||||||
proc ~sinfo {this} {} ;# base class destructor
|
|
||||||
|
|
||||||
proc id {this} {
|
|
||||||
return [format "sin.objectID = \{ %s \}" $($this,objectID)]
|
|
||||||
}
|
|
||||||
|
|
||||||
# static data member variables
|
|
||||||
# set File default.dat
|
|
||||||
set delimiter ", "
|
|
||||||
set debug 0
|
|
||||||
set init 0
|
|
||||||
set name "sinfo"
|
|
||||||
set usage {sinfo init|diag|config|server|device|command [parameter]}
|
|
||||||
set version 0.6
|
|
||||||
|
|
||||||
class server {
|
|
||||||
proc server {this name} {
|
|
||||||
set ($this,name) $name
|
|
||||||
|
|
||||||
proc name {this} {
|
|
||||||
return [format "server.name = \{ %s \}" $($this,name)]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
proc ~server {this} {}
|
|
||||||
}
|
|
||||||
|
|
||||||
class sinfot {
|
|
||||||
proc sinfot {this} {}
|
|
||||||
proc ~sinfot {this} {}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc helpMsgStr args {
|
|
||||||
return [formatMsg $sinfo::name "usage" $sinfo::usage]
|
|
||||||
}
|
|
||||||
|
|
||||||
proc debug args {
|
|
||||||
if {$sinfo::debug < 1} {
|
|
||||||
return
|
|
||||||
}
|
|
||||||
set l [llength $args]
|
|
||||||
set dMsg "Script code event"
|
|
||||||
set dVal " "
|
|
||||||
if {$l > 0} {
|
|
||||||
set dMsg [lindex $args 0]
|
|
||||||
if {$l > 1} {
|
|
||||||
set dVal [lindex $args 1]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
sinWrite [format "sinfo::debug: %s" [format $dMsg $dVal]] "value"
|
|
||||||
}
|
|
||||||
|
|
||||||
proc diag args {
|
|
||||||
set flag [lindex $args 0]
|
|
||||||
set msg [format "diag=%s" $flag]
|
|
||||||
switch $flag {
|
|
||||||
"on" {
|
|
||||||
set sinfo::debug 1
|
|
||||||
}
|
|
||||||
"off" {
|
|
||||||
set sinfo::debug 0
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
if {1 == $sinfo::debug} {
|
|
||||||
set msg "diag=on"
|
|
||||||
} else {
|
|
||||||
set msg "diag=off"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return [format "sinfo.diag = \{ %s \}" $msg]
|
|
||||||
}
|
|
||||||
|
|
||||||
proc formatMsg {objName parName msg} {
|
|
||||||
# return [format "%s.%s = \{ %s \}" $objName $parName $msg]
|
|
||||||
# set msgStr [format "%s.%s = %s " $objName $parName $msg]
|
|
||||||
#sinWrite "DEBUG formatMsg: msg = $msg" "value"
|
|
||||||
return "$objName.$parName=$msg"
|
|
||||||
}
|
|
||||||
|
|
||||||
proc writeObjPar {objName parName} {
|
|
||||||
return [format "%s.%s = \{ %s \}" \
|
|
||||||
$objName $parName [set ::$objName::$parName]]
|
|
||||||
}
|
|
||||||
|
|
||||||
proc writeError {objName msg} {
|
|
||||||
# return [format "%s.error = \{ %s \}" $objName $msg]
|
|
||||||
set msg [format "%s.error = \{ %s \}" $objName $msg]
|
|
||||||
sinWrite $msg "error"
|
|
||||||
return $msg
|
|
||||||
}
|
|
||||||
|
|
||||||
proc writeNspPar {objName parName} {
|
|
||||||
set result ::
|
|
||||||
append result $objName :: $parName
|
|
||||||
# return [format "%s.%s = \{ %s \}" $objName $parName [set $result]]
|
|
||||||
sinWrite [format "%s" [set $result]] "value"
|
|
||||||
}
|
|
||||||
|
|
||||||
proc writeList {objName parName parList} {
|
|
||||||
# return [format "%s.%s = %s " $objName $parName \
|
|
||||||
# [join $parList $sinfo::delimiter]]
|
|
||||||
set msg [format "%s" [join $parList $sinfo::delimiter]]
|
|
||||||
sinWrite $msg "value"
|
|
||||||
#return $msg
|
|
||||||
}
|
|
||||||
|
|
||||||
proc writeNamespaceChildren {obj key nsp} {
|
|
||||||
set chList {}
|
|
||||||
set nameList {}
|
|
||||||
set chList [namespace children $nsp]
|
|
||||||
set l [llength $chList]
|
|
||||||
for {set i 0} {$i < $l} {incr i} {
|
|
||||||
lappend nameList [namespace tail [lindex $chList $i]]
|
|
||||||
}
|
|
||||||
writeList $obj $key $nameList
|
|
||||||
}
|
|
||||||
|
|
||||||
proc writeNamespaceList {obj key nsp} {
|
|
||||||
set nameList {}
|
|
||||||
foreach v [info vars ${nsp}::*] {
|
|
||||||
lappend nameList [namespace tail $v]
|
|
||||||
}
|
|
||||||
writeList $obj $key $nameList
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc sinfo::server args {
|
|
||||||
array set argv [arga $args]
|
|
||||||
debug "sinfo::server, server.argv = { %s }" [array get argv]
|
|
||||||
set parSet {}
|
|
||||||
set parNames {}
|
|
||||||
if {$argv(bKey)} {
|
|
||||||
set key $argv(key)
|
|
||||||
debug "sinfo::server, key = $key"
|
|
||||||
switch $key {
|
|
||||||
"connection" -
|
|
||||||
"experiment" -
|
|
||||||
"help" -
|
|
||||||
"key" -
|
|
||||||
"list"
|
|
||||||
{
|
|
||||||
debug "sinfo::server, in switch $key, sinfox list server $key"
|
|
||||||
set nameList [sinfox list server $key]
|
|
||||||
sinfo::writeList "server" $key $nameList
|
|
||||||
}
|
|
||||||
"command" -
|
|
||||||
"device" -
|
|
||||||
"devicetype" -
|
|
||||||
"group" -
|
|
||||||
"interface"
|
|
||||||
{
|
|
||||||
if {$argv(bName)} {
|
|
||||||
set name $argv(name)
|
|
||||||
debug "sinfo::server, using name $name"
|
|
||||||
#sinWrite [format "DEBUG: if bname, key = %s, name = %s" $key $name] "value"
|
|
||||||
set nameList [sinfox list server $key $name]
|
|
||||||
sinfo::writeList "server" $name $nameList
|
|
||||||
#todo: improve response for unknown name
|
|
||||||
# eg server.error={device=foo}
|
|
||||||
} else {
|
|
||||||
set nameList [sinfox list server $key]
|
|
||||||
debug "sinfo::server, key=$key, nameList = $nameList"
|
|
||||||
sinfo::writeList "server" $key $nameList
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
"gtdevice"
|
|
||||||
{
|
|
||||||
if {$argv(bName)} {
|
|
||||||
set name $argv(name)
|
|
||||||
if [info exists ::server::gtDeviceList::$name] {
|
|
||||||
sinfo::writeNspPar server::gtDeviceList $name
|
|
||||||
} else {
|
|
||||||
set msg [format "key=%s.%s" "server" $key]
|
|
||||||
return [sinfo::writeList "server" error $msg]
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
writeList "server" $key [gumtree::gtDeviceList]
|
|
||||||
# sinfo::writeNamespaceList "server" $key \
|
|
||||||
# [ ::server::gtDeviceList
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
default {
|
|
||||||
puts default
|
|
||||||
if [info exists ::server::$key] {
|
|
||||||
sinfo::writeNspPar server $key
|
|
||||||
} else {
|
|
||||||
set msg [format "key=%s.%s" "server" $key]
|
|
||||||
return [sinfo::writeList "server" error $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
# writeNamespaceList $objName
|
|
||||||
set nameList [sinfox list server list]
|
|
||||||
writeList "server" "list" $nameList
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc sinfo::checkType {objName} {
|
|
||||||
if { [string compare -nocase $objName server] == 0 } then {
|
|
||||||
set return "server"
|
|
||||||
} elseif { [string compare -nocase $objName sequencer] == 0 } then {
|
|
||||||
set return "sequencer"
|
|
||||||
} else {
|
|
||||||
switch [SICSType $objName] {
|
|
||||||
COUNT -
|
|
||||||
DRIV { return "device" }
|
|
||||||
COM { return "command" }
|
|
||||||
TEXT { return "object" }
|
|
||||||
default { return "unknown" }
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
proc sinfo::list args {
|
|
||||||
array set argv [arga $args]
|
|
||||||
debug "sinfo.argv = { %s }" [array get argv]
|
|
||||||
set argc [llength $args]
|
|
||||||
set objName $argv(objName)
|
|
||||||
set key $argv(key)
|
|
||||||
set name $argv(name)
|
|
||||||
sinfo::debug "sinfo.numargs = %s" $argc
|
|
||||||
if {$argc < 1} {
|
|
||||||
sinWrite [sinfo::helpMsgStr] "value"
|
|
||||||
return
|
|
||||||
}
|
|
||||||
sinfo::debug "object = %s" $argv(objName)
|
|
||||||
if $argv(bKey) {
|
|
||||||
sinfo::debug "key = %s" $argv(key)
|
|
||||||
}
|
|
||||||
if $argv(bName) {
|
|
||||||
sinfo::debug "name = %s" $argv(name)
|
|
||||||
}
|
|
||||||
|
|
||||||
set parList {}
|
|
||||||
set numPars 0
|
|
||||||
|
|
||||||
set objType [checkType $objName]
|
|
||||||
sinfo::debug "sinfo.objectType = %s" $objType
|
|
||||||
|
|
||||||
switch $objType {
|
|
||||||
device
|
|
||||||
{
|
|
||||||
set nameList [sinfox list $objName $key $name]
|
|
||||||
writeList $objName $key $nameList
|
|
||||||
}
|
|
||||||
command
|
|
||||||
{
|
|
||||||
debug "sinfo.message = { %s is command objectType}" $objName
|
|
||||||
}
|
|
||||||
server
|
|
||||||
{
|
|
||||||
set cmd [format "sinfo::server %s %s %s %s" \
|
|
||||||
$objName $key $argv(name) $argv(val)]
|
|
||||||
return [eval $cmd]
|
|
||||||
}
|
|
||||||
sequencer
|
|
||||||
{
|
|
||||||
debug "sinfo.message = { %s is sequencer objectType}" $objName
|
|
||||||
if {$argv(bKey)} {
|
|
||||||
set key $argv(key)
|
|
||||||
switch $key {
|
|
||||||
"command"
|
|
||||||
{
|
|
||||||
if $bName {
|
|
||||||
set target [format "::sequencer::%s" $name]
|
|
||||||
sinfo::writeNamespaceList $objName $name $target
|
|
||||||
} else {
|
|
||||||
sinfo::writeNamespaceChildren $objName \
|
|
||||||
$key ::sequencer
|
|
||||||
}
|
|
||||||
}
|
|
||||||
default
|
|
||||||
{
|
|
||||||
}
|
|
||||||
}
|
|
||||||
} else {
|
|
||||||
sinfo::writeNamespaceList "sequencer" "list" "::sequencer"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
object
|
|
||||||
{
|
|
||||||
# todo: test for interface name
|
|
||||||
switch $objName {
|
|
||||||
default {
|
|
||||||
writeError "sinfo" \
|
|
||||||
[format "'%s' is invalid object" $objName]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
unknown -
|
|
||||||
default {
|
|
||||||
writeError "sinfo" [format "'%s' has invalid object type" $objName]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
# -----------------------------------------------------------------------------
|
|
||||||
# wrapper procs for sinfo class
|
|
||||||
|
|
||||||
proc sinfo args {
|
|
||||||
set l [llength $args]
|
|
||||||
if {$l < 1} {
|
|
||||||
sinWrite [sinfo::helpMsgStr] "value"
|
|
||||||
return
|
|
||||||
}
|
|
||||||
set arglist [ split $args ]
|
|
||||||
set objName [lindex $arglist 0]
|
|
||||||
set cmd [format "sinfo::%s $args" $objName]
|
|
||||||
#sinWrite "DEBUG: $cmd" "value"
|
|
||||||
# set cmd $args
|
|
||||||
#set cmd "sinfo::list $args"
|
|
||||||
#FIXME the command should provide the output code for sinWrite
|
|
||||||
#sinWrite [eval $cmd] "value"
|
|
||||||
eval $cmd
|
|
||||||
}
|
|
||||||
|
|
||||||
proc sin args {
|
|
||||||
set argc [llength $args]
|
|
||||||
if {$argc < 1} {
|
|
||||||
set msg \
|
|
||||||
"sin.usage = \
|
|
||||||
{ sin \[server|sequencer|device|command\] \[parameter\] }"
|
|
||||||
sinWrite $msg "value"
|
|
||||||
} else {
|
|
||||||
sinWrite [sinfo::list $args] "value"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
@ -1,7 +0,0 @@
|
|||||||
scan clear
|
|
||||||
scan np 10
|
|
||||||
scan var A4 20. 2.
|
|
||||||
scan preset 10
|
|
||||||
for {set i 0 } { $i < 2000 } { incr i} {
|
|
||||||
scan run
|
|
||||||
}
|
|
||||||
219
sycamore.tcl
219
sycamore.tcl
@ -1,219 +0,0 @@
|
|||||||
#source $sychome/stooop/mkpkgidx.tcl
|
|
||||||
#source stooop.tcl
|
|
||||||
#set tcl_pkgPath $sychome
|
|
||||||
# ClientPut $tcl_pkgPath "value"
|
|
||||||
# package require stooop 4 ;# load stooop package
|
|
||||||
# namespace forget stooop::* ;# remove if previously loaded
|
|
||||||
# namespace import stooop::*
|
|
||||||
|
|
||||||
# -----------------------------------------------------------------------------
|
|
||||||
# source $sychome/ns_site.tcl
|
|
||||||
# source $sychome/ns_sequencer.tcl
|
|
||||||
# source $sychome/ns_server.tcl
|
|
||||||
|
|
||||||
set STACKTRACE 0
|
|
||||||
proc stackTrace args {
|
|
||||||
set level [ info level ]
|
|
||||||
ClientPut "====================" "value"
|
|
||||||
for {set i 1} {$i < $level} {incr i} {
|
|
||||||
ClientPut [info level $i] "value"
|
|
||||||
ClientPut " " "value"
|
|
||||||
}
|
|
||||||
ClientPut "====================" "value"
|
|
||||||
}
|
|
||||||
|
|
||||||
# -----------------------------------------------------------------------------
|
|
||||||
# testing stubs when SICS modules not available
|
|
||||||
# proc sinfox args
|
|
||||||
# proc ClientPut {msg oCode}
|
|
||||||
# proc SICSType {objName}
|
|
||||||
# source stubs.tcl
|
|
||||||
|
|
||||||
# -----------------------------------------------------------------------------
|
|
||||||
# Sycamore Utilities: tcl procedures required by sycamore implementation
|
|
||||||
|
|
||||||
proc sinWrite {msg oCode} {
|
|
||||||
# simplest processing of format for now
|
|
||||||
global STACKTRACE
|
|
||||||
if {$STACKTRACE} {
|
|
||||||
stackTrace
|
|
||||||
}
|
|
||||||
ClientPut $msg $oCode
|
|
||||||
}
|
|
||||||
|
|
||||||
proc varexist {nsp var} {
|
|
||||||
return [expr [string compare $nsp$var [namespace which -variable $nsp$var]]==0]
|
|
||||||
}
|
|
||||||
|
|
||||||
#proc sycFormat {connID transID devID msgFlag args} {
|
|
||||||
# return "\[$connID:$transID:$devID:$msgFlag\] $args"
|
|
||||||
#}
|
|
||||||
#source $sychome/sycFormat.tcl
|
|
||||||
#publish sycFormat spy
|
|
||||||
|
|
||||||
proc arga argStr {
|
|
||||||
set args [ split $argStr ]
|
|
||||||
set argc [llength $args]
|
|
||||||
# syc::debug "arga.argc = %s" $argc
|
|
||||||
set objName ""
|
|
||||||
set key ""
|
|
||||||
set name ""
|
|
||||||
set val ""
|
|
||||||
set bObj [expr $argc > 0]
|
|
||||||
set bKey [expr $argc > 1]
|
|
||||||
set bName [expr $argc > 2]
|
|
||||||
set bVal [expr $argc > 3]
|
|
||||||
if $bObj {
|
|
||||||
set objName [string tolower [lindex $args 0]]
|
|
||||||
#syc::debug "arga.objName = %s" $objName
|
|
||||||
}
|
|
||||||
if $bKey {
|
|
||||||
set key [string tolower [lindex $args 1]]
|
|
||||||
#syc::debug "arga.key = %s" $key
|
|
||||||
}
|
|
||||||
if $bName {
|
|
||||||
set name [string tolower [lindex $args 2]]
|
|
||||||
}
|
|
||||||
if $bVal {
|
|
||||||
set val [string tolower [lindex $args 3]]
|
|
||||||
}
|
|
||||||
# ? cannot get 'array set' to work in the form:
|
|
||||||
# array set argv {
|
|
||||||
# argc $argc
|
|
||||||
# objName $objName
|
|
||||||
# ... etcetera
|
|
||||||
# }
|
|
||||||
set argv(argc) $argc
|
|
||||||
set argv(bObj) $bObj
|
|
||||||
set argv(bKey) $bKey
|
|
||||||
set argv(bName) $bName
|
|
||||||
set argv(bVal) $bVal
|
|
||||||
set argv(objName) $objName
|
|
||||||
set argv(key) $key
|
|
||||||
set argv(name) $name
|
|
||||||
set argv(val) $val
|
|
||||||
# would like to return associative array
|
|
||||||
# for now, settle for list
|
|
||||||
# syc::debug "arga.argv = { %s }" [array get argv]
|
|
||||||
return [array get argv]
|
|
||||||
}
|
|
||||||
|
|
||||||
# alternative solution for passing arguments around
|
|
||||||
#class argv {
|
|
||||||
# proc argv {this args} {
|
|
||||||
# set ($this,argc) [llength $args]
|
|
||||||
# set ($this,objName) ""
|
|
||||||
# set ($this,key) ""
|
|
||||||
# set ($this,name) ""
|
|
||||||
# set ($this,val) ""
|
|
||||||
# set ($this,bObj) [expr $l > 0]
|
|
||||||
# set ($this,bKey) [expr $l > 0]
|
|
||||||
# set ($this,bName) [expr $l > 1]
|
|
||||||
# set ($this,bVal) [expr $l > 2]
|
|
||||||
# if $($this,bObj) {
|
|
||||||
# set ($this,objName) [lindex $args 0]
|
|
||||||
# }
|
|
||||||
# if $($this,bKey) {
|
|
||||||
# set ($this,key) [lindex $args 0]
|
|
||||||
# }
|
|
||||||
# if $($this,bName) {
|
|
||||||
# set ($this,name) [lindex $args 1]
|
|
||||||
# }
|
|
||||||
# if $($this,bVal) {
|
|
||||||
# set ($this,val) [lindex $args 2]
|
|
||||||
# }
|
|
||||||
# }
|
|
||||||
# proc ~argv {this} {}
|
|
||||||
#}
|
|
||||||
#
|
|
||||||
## -----------------------------------------------------------------------------
|
|
||||||
# working idea for making diagnostic class global
|
|
||||||
class diagnostic {
|
|
||||||
proc diagnostic {this} {
|
|
||||||
set ($this,id) $this
|
|
||||||
set ($this,debug) 0
|
|
||||||
}
|
|
||||||
proc ~diagnostic {this} {}
|
|
||||||
|
|
||||||
proc diag {this flag} {
|
|
||||||
set msg [format "diag=%s" $flag]
|
|
||||||
switch $flag {
|
|
||||||
"on" {
|
|
||||||
set ($this,debug) 1
|
|
||||||
}
|
|
||||||
"off" {
|
|
||||||
set ($this,debug) 0
|
|
||||||
}
|
|
||||||
default {}
|
|
||||||
}
|
|
||||||
if {1 == ($this,debug)} {
|
|
||||||
set msg "diag=on"
|
|
||||||
} else {
|
|
||||||
set msg "diag=off"
|
|
||||||
}
|
|
||||||
return [format "%s.diag = \{ %s \}" $this $msg]
|
|
||||||
}
|
|
||||||
|
|
||||||
proc debug {this dMsg dVal} {
|
|
||||||
if {1 > ($this,debug)} {
|
|
||||||
return
|
|
||||||
}
|
|
||||||
sinWrite [format "%s::debug: %s" $this [format $dMsg $dVal]] "value"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
## -----------------------------------------------------------------------------
|
|
||||||
# Class for module static variables and methods
|
|
||||||
class syc {
|
|
||||||
# class lifecycle methods
|
|
||||||
proc syc {this} {}
|
|
||||||
proc ~syc {this} {}
|
|
||||||
|
|
||||||
# static data members
|
|
||||||
set debug 0
|
|
||||||
|
|
||||||
# static methods
|
|
||||||
proc debug args {
|
|
||||||
if {$syc::debug < 1} {
|
|
||||||
return
|
|
||||||
}
|
|
||||||
set l [llength $args]
|
|
||||||
set dMsg "Script code event"
|
|
||||||
set dVal " "
|
|
||||||
if {$l > 0} {
|
|
||||||
set dMsg [lindex $args 0]
|
|
||||||
if {$l > 1} {
|
|
||||||
set dVal [lindex $args 1]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
sinWrite [format "syc::debug: %s" [format $dMsg $dVal]] "value"
|
|
||||||
}
|
|
||||||
|
|
||||||
proc diag args {
|
|
||||||
set flag [lindex $args 0]
|
|
||||||
set msg [format "diag=%s" $flag]
|
|
||||||
switch $flag {
|
|
||||||
"on" {
|
|
||||||
set syc::debug 1
|
|
||||||
}
|
|
||||||
"off" {
|
|
||||||
set syc::debug 0
|
|
||||||
}
|
|
||||||
default {
|
|
||||||
if {1 == $syc::debug} {
|
|
||||||
set msg "diag=on"
|
|
||||||
} else {
|
|
||||||
set msg "diag=off"
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
return [format "syc.diag = \{ %s \}" $msg]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
|
|
||||||
## -----------------------------------------------------------------------------
|
|
||||||
sinWrite "Loading sinfo" "value"
|
|
||||||
#source $sychome/sinfo.tcl
|
|
||||||
#publish sinfo spy
|
|
||||||
# source $sychome/sequencer.tcl
|
|
||||||
|
|
||||||
1177
tascom.tcl
1177
tascom.tcl
File diff suppressed because it is too large
Load Diff
104
tasregress.tcl
104
tasregress.tcl
@ -1,104 +0,0 @@
|
|||||||
#-------------------------------------------------------------------------
|
|
||||||
# Regression test for TAS
|
|
||||||
#
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
|
|
||||||
config file simchal.log
|
|
||||||
|
|
||||||
#--------- zero points
|
|
||||||
A1 softzero .59
|
|
||||||
A2 softzero -.01
|
|
||||||
A3 softzero 11.54
|
|
||||||
A4 softzero -.71
|
|
||||||
A5 softzero 176.48
|
|
||||||
A6 softzero .04
|
|
||||||
|
|
||||||
MTU softzero 2.85
|
|
||||||
ATU softzero -.88
|
|
||||||
MGL softzero 1.3
|
|
||||||
SGL softzero 1.55
|
|
||||||
AGL softzero -.49
|
|
||||||
|
|
||||||
#------------- box parameters
|
|
||||||
DM 3.354
|
|
||||||
DA 3.354
|
|
||||||
SM 1
|
|
||||||
SS 1
|
|
||||||
SA -1
|
|
||||||
FX 2
|
|
||||||
NP 9
|
|
||||||
MRX1 .28
|
|
||||||
MRX2 10.42
|
|
||||||
ARX1 .15
|
|
||||||
ARX2 4.29
|
|
||||||
|
|
||||||
#----------- sample
|
|
||||||
AS 5.
|
|
||||||
BS 5.0
|
|
||||||
CS 5.0
|
|
||||||
AA 90.
|
|
||||||
BB 90.
|
|
||||||
CC 90.
|
|
||||||
AX 1.0
|
|
||||||
AY 0
|
|
||||||
AZ 0
|
|
||||||
BX 0
|
|
||||||
BY 1.
|
|
||||||
BZ 0
|
|
||||||
|
|
||||||
dr ef 8.0
|
|
||||||
output a1,a2,a3,a4
|
|
||||||
sc qh 2 0 0 3 dqh 0 0 0 0.05 np 9 ti 2
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0 0 .0
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0.01 0 .0
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0.01 0 .1
|
|
||||||
|
|
||||||
dr ei 8
|
|
||||||
fx 1
|
|
||||||
|
|
||||||
output a3,a4,a5,a6
|
|
||||||
|
|
||||||
sc qh 2 0 0 3 dqh 0 0 0 0.05 np 9 ti 2
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0 0 .0
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0.01 0 .0
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0.01 0 .1
|
|
||||||
|
|
||||||
fx 2
|
|
||||||
dr ef 8
|
|
||||||
cc 120
|
|
||||||
cs 10
|
|
||||||
|
|
||||||
output a1,a2,a3,a4
|
|
||||||
sc qh 2 0 0 3 dqh 0 0 0 0.05 np 9 ti 2
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0 0 .0
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0.01 0 .0
|
|
||||||
sc qh 2 0 0 3 dqh 0.01 0.01 0 .1
|
|
||||||
|
|
||||||
bz 1
|
|
||||||
by 0
|
|
||||||
|
|
||||||
sc qh 0 0 2 3 dqh 0 0 0 0.05 np 9 ti 2
|
|
||||||
sc qh 0 0 2 3 dqh 0.0 0.00 0.01 .0
|
|
||||||
sc qh 0 0 2 3 dqh 0.01 0.0 0.01 .0
|
|
||||||
sc qh 0 0 2 3 dqh 0.01 0.0 0.01 .1
|
|
||||||
|
|
||||||
dr ef 8 ei 8
|
|
||||||
|
|
||||||
output ach mcv
|
|
||||||
sc ei 8 dei .5 np 15
|
|
||||||
sc ef 8 dei .5 np 15
|
|
||||||
|
|
||||||
cs 7
|
|
||||||
bb 67.89
|
|
||||||
cc 90
|
|
||||||
dr ef 8
|
|
||||||
|
|
||||||
output a1,a2,a3,a4
|
|
||||||
sc qh 0 0 2 3 dqh 0 0 0 0.05 np 9 ti 2
|
|
||||||
sc qh 0 0 2 3 dqh 0.0 0.00 0.01 .0
|
|
||||||
sc qh 0 0 2 3 dqh 0.01 0.0 0.01 .0
|
|
||||||
sc qh 0 0 2 3 dqh 0.01 0.0 0.01 .1
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
config close 0
|
|
||||||
273
tassim.tcl
273
tassim.tcl
@ -1,273 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for Triple Axis Instruments
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke, November 2000
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
set root "/data/koenneck/src/sics"
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
#ServerOption RedirectFile $root/log/stdtas
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 10
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 10
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName $root/log/taslog
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 3015
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 3017
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
ServerOption LogFileDir $root/simlog
|
|
||||||
#Where log files from commandlog are stored
|
|
||||||
|
|
||||||
ServerOption QuieckPort 2108
|
|
||||||
# port to send data update messages to
|
|
||||||
|
|
||||||
ServerOption statusfile tasstat.tcl
|
|
||||||
|
|
||||||
# Telnet Options
|
|
||||||
ServerOption TelnetPort 1305
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
# The token system
|
|
||||||
TokenInit connan
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# Here the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Spy 007 1
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# M O T O R S
|
|
||||||
Motor A1 SIM 0. 111. -.1 2. # Monochromator Theta
|
|
||||||
Motor A2 SIM 33.1 120. -.1 2. # Monochromator Two-Theta
|
|
||||||
Motor A3 SIM -177.3 177.3 -.1 2. # Sample theta or omega
|
|
||||||
Motor A4 SIM -135.1 123.4 -.1 2. # Sample Two-Theta
|
|
||||||
Motor A5 SIM -200 200 -.1 2. # Analyzer Theta
|
|
||||||
Motor A6 SIM -116. 166. -.1 2. # Analyzer Two-Theta
|
|
||||||
Motor MCV SIM -9 124. -.1 2. # Monochromator curvature vertical
|
|
||||||
Motor SRO SIM 0. 351. -.1 2. # Sample table second ring
|
|
||||||
Motor ACH SIM -.5 11.5 -.1 2. # Analyzer curvature horizontal
|
|
||||||
Motor MTL SIM -17 17 -.1 2. # Monochromator translation lower
|
|
||||||
Motor MTU SIM -17 17. -.1 2. # Monochromator Translation upper
|
|
||||||
Motor STL SIM -30 30. -.1 2. # Sample lower translation
|
|
||||||
Motor STU SIM -30. 30. -.1 2. # Sample upper translation
|
|
||||||
Motor ATL SIM -17 17 -.1 2. # Analyzer lower translation
|
|
||||||
Motor ATU SIM -17 16.88 -.1 2. # Analyzer upper translation
|
|
||||||
Motor MGL SIM -10 10 -.1 2. # Monochromator lower goniometer
|
|
||||||
#Motor MGU SIM -30. 30. -.1 2. # Monochromator upper goniometer
|
|
||||||
Motor SGL SIM -16 16 -.1 2. # Sample lower goniometer
|
|
||||||
Motor SGU SIM -16 16. -.1 2. # Sample upper goniometer
|
|
||||||
Motor AGL SIM -10 10 -.1 2. # 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
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R
|
|
||||||
MakeCounter counter SIM -1.
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# SA M P L E V A R I A B L E S
|
|
||||||
# AS-CS cell length
|
|
||||||
# AA-CC cell angles
|
|
||||||
# AX-AZ scattering vector 1
|
|
||||||
# BX-BY scattering vector 2
|
|
||||||
|
|
||||||
VarMake AS Float User
|
|
||||||
VarMake BS Float User
|
|
||||||
VarMake CS Float User
|
|
||||||
VarMake AA Float User
|
|
||||||
VarMake BB Float User
|
|
||||||
VarMake CC Float User
|
|
||||||
VarMake AX Float User
|
|
||||||
VarMake AY Float User
|
|
||||||
VarMake AZ Float User
|
|
||||||
VarMake BX Float User
|
|
||||||
VarMake BY Float User
|
|
||||||
VarMake BZ Float User
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# E N E R G Y & R E L A T E D V A R I A B L E S
|
|
||||||
#
|
|
||||||
# EI incident energy
|
|
||||||
# KI incident neutron wavevector
|
|
||||||
# EF final neutron energy
|
|
||||||
# KF final neutron wavevector
|
|
||||||
# QH-QL Q in reciprocal space
|
|
||||||
# EN energy transfer
|
|
||||||
|
|
||||||
|
|
||||||
VarMake EI Float User
|
|
||||||
VarMake KI Float User
|
|
||||||
VarMake EF Float User
|
|
||||||
VarMake KF Float User
|
|
||||||
VarMake QH Float User
|
|
||||||
VarMake QK Float User
|
|
||||||
VarMake QL Float User
|
|
||||||
VarMake EN Float User
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# I N S T R U M E N T V A R I A B L E S
|
|
||||||
# DM, DA d-spacing monochromator, analyzer
|
|
||||||
# SM, SS, SA scattering senses monochromator, sample, analyzer
|
|
||||||
# FX 1 for constant KI, 2 for constant KF
|
|
||||||
# NP no of scan points
|
|
||||||
# TI preset time
|
|
||||||
# MN preset monitor
|
|
||||||
# IF* various magnet currents
|
|
||||||
# HELM Helmholtz angle of some sort.
|
|
||||||
# HX-HZ Helmholtz field components
|
|
||||||
# F1, F2 Flipper switches
|
|
||||||
|
|
||||||
VarMake instrument Text Mugger
|
|
||||||
instrument SIM-DRUECHAL
|
|
||||||
instrument lock
|
|
||||||
|
|
||||||
VarMake DM Float Mugger
|
|
||||||
VarMake DA Float Mugger
|
|
||||||
VarMake SM Int User
|
|
||||||
VarMake SS Int User
|
|
||||||
VarMake SA Int User
|
|
||||||
VarMake FX Int User
|
|
||||||
VarMake NP Int User
|
|
||||||
VarMake TI Float User
|
|
||||||
VarMake MN Int User
|
|
||||||
VarMake IF1V Float User
|
|
||||||
VarMake IF2V Float User
|
|
||||||
VarMake IF1H Float User
|
|
||||||
VarMake IF2H Float User
|
|
||||||
VarMake HELM Float User
|
|
||||||
VarMake HX Float User
|
|
||||||
VarMake HY Float User
|
|
||||||
VarMake HZ Float User
|
|
||||||
VarMake SWUNIT Int User
|
|
||||||
|
|
||||||
VarMake F1 Int User
|
|
||||||
VarMake F2 Int User
|
|
||||||
|
|
||||||
VarMake title Text User
|
|
||||||
VarMake user Text User
|
|
||||||
VarMake lastcommand Text User
|
|
||||||
VarMake output Text User
|
|
||||||
VarMake local Text User
|
|
||||||
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
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# I N C R E M E N T V A R I A B L E S
|
|
||||||
VarMake DA1 Float User
|
|
||||||
VarMake DA2 Float User
|
|
||||||
VarMake DA3 Float User
|
|
||||||
VarMake DA4 Float User
|
|
||||||
VarMake DA5 Float User
|
|
||||||
VarMake DA6 Float User
|
|
||||||
VarMake DMCV Float User
|
|
||||||
VarMake DSRO Float User
|
|
||||||
VarMake DACH Float User
|
|
||||||
VarMake DMTL Float User
|
|
||||||
VarMake DMTU Float User
|
|
||||||
VarMake DSTL Float User
|
|
||||||
VarMake DSTU Float User
|
|
||||||
VarMake DATL Float User
|
|
||||||
VarMake DATU Float User
|
|
||||||
VarMake DMGL Float User
|
|
||||||
#VarMake DMGU Float User
|
|
||||||
VarMake DSGL Float User
|
|
||||||
VarMake DSGU Float User
|
|
||||||
VarMake DAGL Float User
|
|
||||||
#VarMake DAGU Float User
|
|
||||||
#VarMake DMSC Float User
|
|
||||||
#VarMake DASC Float User
|
|
||||||
#VarMake DCSC Float User
|
|
||||||
VarMake DEI Float User
|
|
||||||
VarMake DKI Float User
|
|
||||||
VarMake DEF Float User
|
|
||||||
VarMake DKF Float User
|
|
||||||
VarMake DQH Float User
|
|
||||||
VarMake DQK Float User
|
|
||||||
VarMake DQL Float User
|
|
||||||
VarMake DEN Float User
|
|
||||||
VarMake WAV Float User
|
|
||||||
VarMake ETAM Float User
|
|
||||||
VarMake ETAS Float User
|
|
||||||
VarMake ETAA Float User
|
|
||||||
VarMake QM Float User
|
|
||||||
VarMake DQM Float User
|
|
||||||
VarMake DT Float User
|
|
||||||
VarMake LPA Int User
|
|
||||||
VarMake DI1 Float User
|
|
||||||
VarMake DI2 Float User
|
|
||||||
VarMake DI3 Float User
|
|
||||||
VarMake DI4 Float User
|
|
||||||
VarMake DI5 Float User
|
|
||||||
VarMake DI6 Float User
|
|
||||||
VarMake DI7 Float User
|
|
||||||
VarMake DI8 Float User
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Curvature variables
|
|
||||||
VarMake MRX1 Float Mugger
|
|
||||||
VarMake MRX2 Float Mugger
|
|
||||||
VarMake ARX1 Float Mugger
|
|
||||||
VarMake ARX2 Float Mugger
|
|
||||||
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
# Datafile generation variables
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath "$root/tmp/"
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix simchal
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".scn"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
MakeDataNumber SicsDataNumber "$root/danu.dat"
|
|
||||||
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# 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 S I C S C O M M A N D S
|
|
||||||
MakeScanCommand iscan counter tas.hdd recover.bin
|
|
||||||
MakePeakCenter iscan
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# I N S T A L L T A S C O M P A T A B I L I T Y C O M M A N D S
|
|
||||||
MakeTAS iscan
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# I N S T A L L T A S S C R I P T E D C O M M A N D S
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Install sync
|
|
||||||
MakeSync localhost 2915 Spy 007
|
|
||||||
|
|
||||||
source $root/tascom.tcl
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
322
tastest.tcl
322
tastest.tcl
@ -1,322 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for Triple Axis Instruments
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke, November 2000
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
set root "/data/koenneck/src/sics"
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
#ServerOption RedirectFile $root/log/stdtas
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 10
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 10
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName $root/log/taslog
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2915
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2917
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
ServerOption LogFileDir $root/log
|
|
||||||
#Where log files from commandlog are stored
|
|
||||||
|
|
||||||
ServerOption QuieckPort 2108
|
|
||||||
# port to send data update messages to
|
|
||||||
|
|
||||||
ServerOption statusfile tasstat.tcl
|
|
||||||
|
|
||||||
# Telnet Options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
# The token system
|
|
||||||
TokenInit connan
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# Here the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Spy 007 1
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# M O T O R S
|
|
||||||
Motor A1 SIM -87. 6.1 -.1 2. # Monochromator Theta
|
|
||||||
Motor A2 SIM -129.1 -22. -.1 2. # Monochromator Two-Theta
|
|
||||||
Motor A3 SIM -177.3 177.3 -.1 2. # Sample theta or omega
|
|
||||||
Motor A4 SIM -135.1 123.4 -.1 2. # Sample Two-Theta
|
|
||||||
Motor A5 SIM -200 200 -.1 2. # Analyzer Theta
|
|
||||||
Motor A6 SIM -116. 166. -.1 2. # Analyzer Two-Theta
|
|
||||||
Motor MCV SIM -9 124. -.1 2. # Monochromator curvature vertical
|
|
||||||
Motor SRO SIM 0. 351. -.1 2. # Sample table second ring
|
|
||||||
Motor ACH SIM -.5 11.5 -.1 2. # Analyzer curvature horizontal
|
|
||||||
Motor MTL SIM -17 17 -.1 2. # Monochromator translation lower
|
|
||||||
Motor MTU SIM -17 17. -.1 2. # Monochromator Translation upper
|
|
||||||
Motor STL SIM -30 30. -.1 2. # Sample lower translation
|
|
||||||
Motor STU SIM -30. 30. -.1 2. # Sample upper translation
|
|
||||||
Motor ATL SIM -17 17 -.1 2. # Analyzer lower translation
|
|
||||||
Motor ATU SIM -17 16.88 -.1 2. # Analyzer upper translation
|
|
||||||
Motor MGL SIM -10 10 -.1 2. # Monochromator lower goniometer
|
|
||||||
#Motor MGU SIM -30. 30. -.1 2. # Monochromator upper goniometer
|
|
||||||
Motor SGL SIM -16 16 -.1 2. # Sample lower goniometer
|
|
||||||
Motor SGU SIM -16 16. -.1 2. # Sample upper goniometer
|
|
||||||
Motor AGL SIM -10 10 -.1 2. # 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
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R
|
|
||||||
MakeCounter counter SIM -1.
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# SA M P L E V A R I A B L E S
|
|
||||||
# AS-CS cell length
|
|
||||||
# AA-CC cell angles
|
|
||||||
# AX-AZ scattering vector 1
|
|
||||||
# BX-BY scattering vector 2
|
|
||||||
|
|
||||||
VarMake AS Float User
|
|
||||||
VarMake BS Float User
|
|
||||||
VarMake CS Float User
|
|
||||||
VarMake AA Float User
|
|
||||||
VarMake BB Float User
|
|
||||||
VarMake CC Float User
|
|
||||||
VarMake AX Float User
|
|
||||||
VarMake AY Float User
|
|
||||||
VarMake AZ Float User
|
|
||||||
VarMake BX Float User
|
|
||||||
VarMake BY Float User
|
|
||||||
VarMake BZ Float User
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# E N E R G Y & R E L A T E D V A R I A B L E S
|
|
||||||
#
|
|
||||||
# EI incident energy
|
|
||||||
# KI incident neutron wavevector
|
|
||||||
# EF final neutron energy
|
|
||||||
# KF final neutron wavevector
|
|
||||||
# QH-QL Q in reciprocal space
|
|
||||||
# EN energy transfer
|
|
||||||
|
|
||||||
|
|
||||||
VarMake EI Float User
|
|
||||||
VarMake KI Float User
|
|
||||||
VarMake EF Float User
|
|
||||||
VarMake KF Float User
|
|
||||||
VarMake QH Float User
|
|
||||||
VarMake QK Float User
|
|
||||||
VarMake QL Float User
|
|
||||||
VarMake EN Float User
|
|
||||||
|
|
||||||
#-------- energy Q targets
|
|
||||||
VarMake TEI Float User
|
|
||||||
VarMake TKI Float User
|
|
||||||
VarMake TEF Float User
|
|
||||||
VarMake TKF Float User
|
|
||||||
VarMake TQH Float User
|
|
||||||
VarMake TQK Float User
|
|
||||||
VarMake TQL Float User
|
|
||||||
VarMake TEN Float User
|
|
||||||
VarMake TQM Float User
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# I N S T R U M E N T V A R I A B L E S
|
|
||||||
# DM, DA d-spacing monochromator, analyzer
|
|
||||||
# SM, SS, SA scattering senses monochromator, sample, analyzer
|
|
||||||
# FX 1 for constant KI, 2 for constant KF
|
|
||||||
# NP no of scan points
|
|
||||||
# TI preset time
|
|
||||||
# MN preset monitor
|
|
||||||
# IF* various magnet currents
|
|
||||||
# HELM Helmholtz angle of some sort.
|
|
||||||
# HX-HZ Helmholtz field components
|
|
||||||
# F1, F2 Flipper switches
|
|
||||||
|
|
||||||
VarMake instrument Text Mugger
|
|
||||||
instrument DRUECHAL
|
|
||||||
instrument lock
|
|
||||||
|
|
||||||
VarMake DM Float Mugger
|
|
||||||
VarMake DA Float Mugger
|
|
||||||
VarMake SM Int User
|
|
||||||
SM -1
|
|
||||||
SM lock
|
|
||||||
VarMake SS Int User
|
|
||||||
VarMake SA Int User
|
|
||||||
VarMake FX Int User
|
|
||||||
VarMake NP Int User
|
|
||||||
VarMake TI Float User
|
|
||||||
VarMake MN Int User
|
|
||||||
VarMake IF1V Float User
|
|
||||||
VarMake IF2V Float User
|
|
||||||
VarMake IF1H Float User
|
|
||||||
VarMake IF2H Float User
|
|
||||||
IF1V 1.0
|
|
||||||
IF1H 1.0
|
|
||||||
IF2V 1.0
|
|
||||||
IF2H 1.0
|
|
||||||
VarMake HELM Float User
|
|
||||||
VarMake HX Float User
|
|
||||||
VarMake HY Float User
|
|
||||||
VarMake HZ Float User
|
|
||||||
VarMake SWUNIT Int User
|
|
||||||
|
|
||||||
VarMake F1 Int User
|
|
||||||
VarMake F2 Int User
|
|
||||||
|
|
||||||
VarMake title Text User
|
|
||||||
VarMake user Text User
|
|
||||||
VarMake lastcommand Text User
|
|
||||||
VarMake output Text User
|
|
||||||
VarMake local Text User
|
|
||||||
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
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# I N C R E M E N T V A R I A B L E S
|
|
||||||
VarMake DA1 Float User
|
|
||||||
VarMake DA2 Float User
|
|
||||||
VarMake DA3 Float User
|
|
||||||
VarMake DA4 Float User
|
|
||||||
VarMake DA5 Float User
|
|
||||||
VarMake DA6 Float User
|
|
||||||
VarMake DMCV Float User
|
|
||||||
VarMake DSRO Float User
|
|
||||||
VarMake DACH Float User
|
|
||||||
VarMake DMTL Float User
|
|
||||||
VarMake DMTU Float User
|
|
||||||
VarMake DSTL Float User
|
|
||||||
VarMake DSTU Float User
|
|
||||||
VarMake DATL Float User
|
|
||||||
VarMake DATU Float User
|
|
||||||
VarMake DMGL Float User
|
|
||||||
#VarMake DMGU Float User
|
|
||||||
VarMake DSGL Float User
|
|
||||||
VarMake DSGU Float User
|
|
||||||
VarMake DAGL Float User
|
|
||||||
#VarMake DAGU Float User
|
|
||||||
#VarMake DMSC Float User
|
|
||||||
#VarMake DASC Float User
|
|
||||||
#VarMake DCSC Float User
|
|
||||||
VarMake DEI Float User
|
|
||||||
VarMake DKI Float User
|
|
||||||
VarMake DEF Float User
|
|
||||||
VarMake DKF Float User
|
|
||||||
VarMake DQH Float User
|
|
||||||
VarMake DQK Float User
|
|
||||||
VarMake DQL Float User
|
|
||||||
VarMake DEN Float User
|
|
||||||
VarMake WAV Float User
|
|
||||||
VarMake ETAM Float User
|
|
||||||
VarMake ETAS Float User
|
|
||||||
VarMake ETAA Float User
|
|
||||||
VarMake QM Float User
|
|
||||||
VarMake DQM Float User
|
|
||||||
VarMake DT Float User
|
|
||||||
VarMake LPA Int User
|
|
||||||
|
|
||||||
#----------- Current increments
|
|
||||||
VarMake DI1 Float User
|
|
||||||
VarMake DI2 Float User
|
|
||||||
VarMake DI3 Float User
|
|
||||||
VarMake DI4 Float User
|
|
||||||
VarMake DI5 Float User
|
|
||||||
VarMake DI6 Float User
|
|
||||||
VarMake DI7 Float User
|
|
||||||
VarMake DI8 Float User
|
|
||||||
VarMake DHX Float User
|
|
||||||
VarMake DHY Float User
|
|
||||||
VarMake DHZ Float User
|
|
||||||
|
|
||||||
|
|
||||||
#----------- Current Targets
|
|
||||||
VarMake TI1 Float User
|
|
||||||
VarMake TI2 Float User
|
|
||||||
VarMake TI3 Float User
|
|
||||||
VarMake TI4 Float User
|
|
||||||
VarMake TI5 Float User
|
|
||||||
VarMake TI6 Float User
|
|
||||||
VarMake TI7 Float User
|
|
||||||
VarMake TI8 Float User
|
|
||||||
VarMake THX Float User
|
|
||||||
VarMake THY Float User
|
|
||||||
VarMake THZ Float User
|
|
||||||
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Curvature variables
|
|
||||||
VarMake MRX1 Float Mugger
|
|
||||||
VarMake MRX2 Float Mugger
|
|
||||||
VarMake ARX1 Float Mugger
|
|
||||||
VarMake ARX2 Float Mugger
|
|
||||||
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
# Conversion factors from gauss to ampere for Helmholtz calculations
|
|
||||||
VarMake HCONV1 Float Mugger
|
|
||||||
VarMake HCONV2 Float Mugger
|
|
||||||
VarMake HCONV3 Float Mugger
|
|
||||||
VarMake HCONV4 Float Mugger
|
|
||||||
HCONV1 1.0
|
|
||||||
HCONV2 1.0
|
|
||||||
HCONV3 1.0
|
|
||||||
HCONV4 1.0
|
|
||||||
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# Polarisation file
|
|
||||||
VarMake polfile Text User
|
|
||||||
|
|
||||||
#-------------------------------------------------------------------------
|
|
||||||
# Datafile generation variables
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath "$root/tmp/"
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix simchal
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".scn"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
MakeDataNumber SicsDataNumber "$root/danu.dat"
|
|
||||||
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# 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 S I C S C O M M A N D S
|
|
||||||
MakeScanCommand iscan counter tas.hdd recover.bin
|
|
||||||
MakePeakCenter iscan
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# I N S T A L L T A S C O M P A T A B I L I T Y C O M M A N D S
|
|
||||||
MakeTAS iscan
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# I N S T A L L T A S S C R I P T E D C O M M A N D S
|
|
||||||
MakeDrive
|
|
||||||
source $root/tascom.tcl
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
57
tclvarex.tcl
57
tclvarex.tcl
@ -1,57 +0,0 @@
|
|||||||
#---------------------------------------------------------------------------
|
|
||||||
# T C L D E F I N E D S I C S V A R I A B L E S
|
|
||||||
|
|
||||||
set OM2T(omega) A3
|
|
||||||
set OM2T(2Theta) A6
|
|
||||||
|
|
||||||
proc OM2TDriv { } {
|
|
||||||
return $Boerks
|
|
||||||
}
|
|
||||||
proc OM2TSet { f } {
|
|
||||||
global OM2T
|
|
||||||
set command "run "
|
|
||||||
append command $OM2T(omega) " " [expr $f/2.] " "
|
|
||||||
append command $OM2T(2Theta) " " $f " "
|
|
||||||
set ret [catch {eval $command} msg]
|
|
||||||
if { $ret == 1 } {
|
|
||||||
ClientPut $msg error
|
|
||||||
return 0
|
|
||||||
} else {
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
}
|
|
||||||
proc OM2TStat { } {
|
|
||||||
global OM2T
|
|
||||||
set ret [SICSStatus $OM2T(omega)]
|
|
||||||
if { ($ret == 1) || ($ret == 2) } {
|
|
||||||
set ret [SICSStatus $OM2T(2Theta)]
|
|
||||||
}
|
|
||||||
return $ret
|
|
||||||
}
|
|
||||||
proc OM2TGet { } {
|
|
||||||
global OM2T
|
|
||||||
set res [$OM2T(2Theta) position]
|
|
||||||
return $res
|
|
||||||
}
|
|
||||||
proc OM2TCheck { f } {
|
|
||||||
global OM2T
|
|
||||||
set ret [catch {SICSBounds $OM2T(omega) [expr $f/2.] } msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
ClientPut $msg error
|
|
||||||
return -code error -text $msg
|
|
||||||
}
|
|
||||||
set ret [catch {SICSBounds $OM2T(2Theta) $f } msg]
|
|
||||||
if { $ret != 0 } {
|
|
||||||
ClientPut $msg error
|
|
||||||
return -code error -text $msg
|
|
||||||
}
|
|
||||||
return 1
|
|
||||||
}
|
|
||||||
MakeTSVar OM2TH
|
|
||||||
|
|
||||||
OM2TH isDrivable OM2TDriv
|
|
||||||
OM2TH SetValue OM2TSet
|
|
||||||
OM2TH CheckStatus OM2TStat
|
|
||||||
OM2TH GetValue OM2TGet
|
|
||||||
OM2TH CheckLimits OM2TCheck
|
|
||||||
|
|
||||||
5
tdir.tcl
5
tdir.tcl
@ -1,5 +0,0 @@
|
|||||||
for {set i 0} { $i < 3000} {incr i} {
|
|
||||||
ClientPut "Hello you"
|
|
||||||
}
|
|
||||||
ClientPut "I'am finished"
|
|
||||||
ClientPut [sicstime]
|
|
||||||
504
test.tcl
504
test.tcl
@ -1,504 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for a simulated TOPSI instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke February, 1996
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
# --------------- Initialize Tcl internals --------------------------------
|
|
||||||
|
|
||||||
rename scan stscan
|
|
||||||
|
|
||||||
#-------- a home for this, everything else is in relation to this
|
|
||||||
set shome /afs/psi.ch/user/k/koennecke/Tru64/src
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
#ServerOption RedirectFile $shome/sics/stdout
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 10
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 10
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 10
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileDir $shome/log
|
|
||||||
#LogFileDir is the directory where the command log is going
|
|
||||||
|
|
||||||
#ServerOption logstartfile $shome/sics/start.tcl
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName $shome/sics/tmp/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption TecsStartCmd "tecs/bin/TecsServer -h lnsp26:4000/0"
|
|
||||||
# -h host:port/channel is for serial server
|
|
||||||
ServerOption TecsBinDir tecs/bin/
|
|
||||||
ServerOption TecsLogDir /data/koenneck/tmp/
|
|
||||||
ServerOption TecsPort 9753
|
|
||||||
|
|
||||||
ServerOption statusfile sicsstatus.tcl
|
|
||||||
|
|
||||||
ServerOption ServerPort 2911
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2914
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
# Telnet options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory $shome/sics/tcl
|
|
||||||
ServerOption DefaultCommandFile ""
|
|
||||||
|
|
||||||
#------ a port for broadcasting UDP messages
|
|
||||||
#ServerOption QuieckPort 2108
|
|
||||||
|
|
||||||
TokenInit connan
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 1
|
|
||||||
SicsUser me me 1
|
|
||||||
SicsUser testuser 01lns1 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "TOPSI"
|
|
||||||
Instrument lock
|
|
||||||
|
|
||||||
VarMake starttime Text User
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake sample Text User
|
|
||||||
sample "DanielOxid"
|
|
||||||
Title "TopsiTupsiTapsi"
|
|
||||||
VarMake User Text User
|
|
||||||
User "Daniel_the_Clementine"
|
|
||||||
|
|
||||||
VarMake detectordist Float Mugger
|
|
||||||
detectordist 2500
|
|
||||||
detectordist lock
|
|
||||||
VarMake sampledist Float Mugger
|
|
||||||
sampledist 496.
|
|
||||||
sampledist lock
|
|
||||||
|
|
||||||
VarMake batchroot Text User
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
#Motor D1V EL734 lnsp22.psi.ch 4000 3 3
|
|
||||||
Motor A1 SIM 15.0 120. .1 2. # Monochromator Theta
|
|
||||||
Motor A2 SIM -73. 137. .1 1. # Monochromator 2Theta
|
|
||||||
Motor A3 SIM -360. 360. .1 3. # Sample Omega
|
|
||||||
#Motor A3 el734 localhost 4000 2 3
|
|
||||||
Motor A4 SIM -130. 130. .1 1. # Sample 2Theta
|
|
||||||
Motor A5 SIM -30. 30. .1 3. # ? horiz. Translation
|
|
||||||
Motor A6 SIM -30. 30. .1 3. # ? vert Translation
|
|
||||||
Motor MTL SIM -30. 30. .1 3. # mono lower translation
|
|
||||||
Motor MTU SIM -30. 30. .1 3. # mono upper translation
|
|
||||||
Motor STL SIM -30. 30. .1 3. # sample lower translation
|
|
||||||
Motor STU SIM -30. 30. .1 3. # sample upper translation
|
|
||||||
Motor MGU SIM -50. 50. .1 3. # mono upper goniometer
|
|
||||||
Motor SGL SIM -20. 20. .1 3. # sample lower goniometer
|
|
||||||
Motor SGU SIM -20. 20. .1 3. # sample upper goniometer
|
|
||||||
Motor SDM SIM -5 50. .1 3. # weird Motor
|
|
||||||
SicsAlias A4 Tasse
|
|
||||||
SicsAlias A5 MonoX
|
|
||||||
SicsAlias A5 MonoY
|
|
||||||
SicsAlias A5 MonoPhi
|
|
||||||
SicsAlias A5 MonoChi
|
|
||||||
|
|
||||||
Motor D1R SIM -20. 20. .1 3. # Diaphragm 1 right
|
|
||||||
Motor D1L SIM -20. 20. .1 3. # Diaphragm 1 left
|
|
||||||
Motor D1T SIM -20. 20. .1 3. # Diaphragm 1 top & Bottom
|
|
||||||
|
|
||||||
Motor D2R SIM -20. 20. .1 3. # Diaphragm 2 right
|
|
||||||
Motor D2L SIM -20. 20. .1 3. # Diaphragm 2 left
|
|
||||||
Motor D2T SIM -20. 20. .1 3. # Diaphragm 2 top & Bottom
|
|
||||||
|
|
||||||
Motor BeamStopX SIM -20. 20. .1 3. # Diaphragm 2 right
|
|
||||||
Motor BeamStopY SIM -20. 20. .1 3. # Diaphragm 2 left
|
|
||||||
|
|
||||||
Motor DetectorX SIM -20. 20. .1 3. # Diaphragm 2 right
|
|
||||||
Motor DetectorY SIM -20. 20. .1 3. # Diaphragm 2 left
|
|
||||||
Motor DetectorRotation SIM -20. 20. .1 3. # Diaphragm 2 top & Bottom
|
|
||||||
|
|
||||||
ClientPut "Motors done"
|
|
||||||
|
|
||||||
MakeMulti sampletable
|
|
||||||
sampletable alias D1r x
|
|
||||||
sampletable alias D1L y
|
|
||||||
sampletable alias D1T z
|
|
||||||
sampletable pos henry D1r 5. D1L -5. D1T 0.
|
|
||||||
sampletable endconfig
|
|
||||||
SicsAlias sampletable st
|
|
||||||
#------------------------------------------------------------------------
|
|
||||||
# Velocity selector
|
|
||||||
#Motor tilt EL734 lnsp25.psi.ch 4000 2 2
|
|
||||||
Motor tilt SIM -15 15 .1 3.
|
|
||||||
set dornen(Host) lnsp25.psi.ch
|
|
||||||
set dornen(Port) 4000
|
|
||||||
set dornen(Channel) 6
|
|
||||||
set dornen(Timeout) 5000
|
|
||||||
#VelocitySelector nvs tilt DORNIER dornen
|
|
||||||
set d2003(Host) psts233
|
|
||||||
set d2003(Port) 3004
|
|
||||||
set d2003(Timeout) 20000
|
|
||||||
#VelocitySelector nvs tilt dornier2003 d2003
|
|
||||||
|
|
||||||
VelocitySelector nvs tilt SIM
|
|
||||||
nvs add -20 28800
|
|
||||||
nvs add 3800 4500
|
|
||||||
nvs add 5900 6700
|
|
||||||
nvs add 8100 9600
|
|
||||||
unset dornen
|
|
||||||
emon unregister nvswatch
|
|
||||||
MakeSANSWave lumbda nvs
|
|
||||||
ClientPut "Velocity Selector done"
|
|
||||||
SicsAlias MTL sax
|
|
||||||
SicsAlias A3 som
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R S
|
|
||||||
MakeCounter counter SIM .05
|
|
||||||
#MakeCounter counter EL737 lnsp19.psi.ch 4000 4
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# M U L T I D E V I C E V A R I A B L E S
|
|
||||||
MakeMono Mono "Ge-111" A1 A2 SDM
|
|
||||||
Mono dd 3.3537
|
|
||||||
Mono vk1 -0.025942
|
|
||||||
Mono vk2 5.35166
|
|
||||||
MakeWaveLength lambda Mono
|
|
||||||
MakeO2T O2T A3 A4
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
source tcl/log.tcl
|
|
||||||
|
|
||||||
MakeDrive
|
|
||||||
SicsAlias drive dr
|
|
||||||
Publish LogBook Spy
|
|
||||||
MakeRuenBuffer
|
|
||||||
#---------------- TestVariables for Storage
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath "$shome/sics/"
|
|
||||||
SicsDataPath lock
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix test
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".hdf"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
|
|
||||||
MakeDataNumber SicsDataNumber "$shome/sics/danu.dat"
|
|
||||||
#InitSANS $shome/sics/sansdict.dic
|
|
||||||
InitDMC
|
|
||||||
|
|
||||||
MakeScanCommand xxxscan counter topsi.hdd recover.bin
|
|
||||||
MakePeakCenter xxxscan
|
|
||||||
|
|
||||||
|
|
||||||
MakeHM banana SIM
|
|
||||||
#MakeHM banana SINQHM
|
|
||||||
#banana configure HistMode HRPT
|
|
||||||
banana configure HistMode Normal
|
|
||||||
#banana configure OverFlowMode reflect
|
|
||||||
banana configure OverFlowMode Ceil
|
|
||||||
banana configure Rank 1
|
|
||||||
#banana configure Length 400
|
|
||||||
banana configure Length 16384
|
|
||||||
banana configure dim0 128
|
|
||||||
banana configure dim1 128
|
|
||||||
banana configure BinWidth 4
|
|
||||||
banana preset 100.
|
|
||||||
banana CountMode Timer
|
|
||||||
banana configure HMComputer lnse02.psi.ch
|
|
||||||
banana configure HMPort 2400
|
|
||||||
banana configure Counter counter
|
|
||||||
banana init
|
|
||||||
|
|
||||||
ClientPut "HM initialized"
|
|
||||||
source $shome/sics/tcl/scancom.tcl
|
|
||||||
#source $shome/sics/countf.tcl
|
|
||||||
#source $shome/sics/tcl/count.tcl
|
|
||||||
#Publish count User
|
|
||||||
#Publish repeat user
|
|
||||||
source $shome/sics/tcl/fit.tcl
|
|
||||||
Publish fit Spy
|
|
||||||
SerialInit
|
|
||||||
Publish serialport User
|
|
||||||
Publish p1 User
|
|
||||||
Publish HakleGet User
|
|
||||||
#-------------------- Testing Haake thermostat
|
|
||||||
source hakle.tcl
|
|
||||||
Publish IniHaakeArray Mugger
|
|
||||||
ClientPut "Installed ev test stuff"
|
|
||||||
|
|
||||||
|
|
||||||
#------------------ 4 circle stuff
|
|
||||||
Motor twotheta SIM -120.0 120. .1 2. # 2 theta arm
|
|
||||||
Motor omega SIM -73. 134. .1 2. # omega
|
|
||||||
Motor chi SIM 0. 360. .1 2. # chi circle
|
|
||||||
Motor phi SIM -360. 360. .1 2. # phi circle
|
|
||||||
Motor muca SIM 30. 36. .1 2. # phi circle
|
|
||||||
Motor dg1 SIM -10. 40. .1 2. # phi circle
|
|
||||||
Motor dg2 SIM -10. 40. .1 2. # phi circle
|
|
||||||
Motor dg3 SIM -10. 40. .1 2. # phi circle
|
|
||||||
SicsAlias phi ph
|
|
||||||
SicsAlias chi ch
|
|
||||||
SicsAlias twotheta stt
|
|
||||||
SicsAlias omega om
|
|
||||||
VarMake monodescription Text Mugger
|
|
||||||
monodescription "unknownit crystal"
|
|
||||||
VarMake mono2theta Text Mugger
|
|
||||||
mono2theta 36.77
|
|
||||||
VarMake det1zerox Float Mugger
|
|
||||||
det1zerox 128.
|
|
||||||
VarMake det1zeroy Float Mugger
|
|
||||||
det1zeroy 128.
|
|
||||||
VarMake det1dist Float Mugger
|
|
||||||
det1dist 300.
|
|
||||||
VarMake det2zerox Float Mugger
|
|
||||||
det2zerox 128.
|
|
||||||
VarMake det2zeroy Float Mugger
|
|
||||||
det2zeroy 128.
|
|
||||||
VarMake det2dist Float Mugger
|
|
||||||
det2dist 300.
|
|
||||||
VarMake det3zerox Float Mugger
|
|
||||||
det3zerox 128.
|
|
||||||
VarMake det3zeroy Float Mugger
|
|
||||||
det3zeroy 128.
|
|
||||||
VarMake det3dist Float Mugger
|
|
||||||
det3dist 300.
|
|
||||||
VarMake detstepwidth Float Mugger
|
|
||||||
detstepwidth 0.1
|
|
||||||
detstepwidth lock
|
|
||||||
|
|
||||||
MakeHKL twotheta omega chi phi chi
|
|
||||||
HKL lambda 0.70379
|
|
||||||
HKL setub -0.1247023 0.0016176 -0.0413566 \
|
|
||||||
-0.1044479 -0.0013264 0.0493878 \
|
|
||||||
0.0007513 0.0840941 0.0015745
|
|
||||||
MakeOptimise opti counter
|
|
||||||
MakeMesure mess HKL xxxscan omega o2t $shome/sics/tmp \
|
|
||||||
SicsDataNumber
|
|
||||||
MakeHklscan xxxscan HKL
|
|
||||||
|
|
||||||
#------test rliste
|
|
||||||
SicsAlias twotheta th
|
|
||||||
SicsAlias omega om
|
|
||||||
SicsAlias chi ch
|
|
||||||
SicsAlias phi ph
|
|
||||||
|
|
||||||
source tcl/reflist.tcl
|
|
||||||
Publish rliste User
|
|
||||||
|
|
||||||
|
|
||||||
source fcircle.tcl
|
|
||||||
fcircleinit
|
|
||||||
|
|
||||||
MakeDifrac twotheta omega chi phi counter
|
|
||||||
|
|
||||||
#----------- histogram memory
|
|
||||||
|
|
||||||
#MakeHM hm1 SinqHM
|
|
||||||
MakeHM hm1 SIM
|
|
||||||
hm1 configure HistMode PSD
|
|
||||||
hm1 configure Rank 1
|
|
||||||
hm1 configure Length 65536
|
|
||||||
hm1 configure dim0 256
|
|
||||||
hm1 configure dim1 256
|
|
||||||
hm1 configure BinWidth 4
|
|
||||||
hm1 preset 100.
|
|
||||||
hm1 CountMode Timer
|
|
||||||
hm1 configure xoff 100
|
|
||||||
hm1 configure xfac 10
|
|
||||||
hm1 configure yoff 100
|
|
||||||
hm1 configure yfac 10
|
|
||||||
#hm1 configure HMComputer psds03.psi.ch
|
|
||||||
#hm1 configure HMPort 2400
|
|
||||||
hm1 configure Counter counter
|
|
||||||
hm1 genbin 0 10000 2
|
|
||||||
hm1 configure init 0
|
|
||||||
hm1 init
|
|
||||||
|
|
||||||
MakeHM hm2 SIM
|
|
||||||
hm2 configure HistMode PSD
|
|
||||||
hm2 configure Rank 1
|
|
||||||
hm2 configure Length 65536
|
|
||||||
hm2 configure dim0 256
|
|
||||||
hm2 configure dim1 256
|
|
||||||
hm2 configure BinWidth 4
|
|
||||||
#hm2 configure HMComputer lnse02.psi.ch
|
|
||||||
#hm2 configure HMPort 2400
|
|
||||||
hm2 init
|
|
||||||
|
|
||||||
#MakeHM hm3 SIM
|
|
||||||
#hm3 configure HistMode PSD
|
|
||||||
#hm3 configure Rank 1
|
|
||||||
#hm3 configure Length 65536
|
|
||||||
#hm3 configure dim0 256
|
|
||||||
#hm3 configure dim1 256
|
|
||||||
#hm3 configure BinWidth 4
|
|
||||||
#hm3 configure HMComputer lnse02.psi.ch
|
|
||||||
#hm3 configure HMPort 2400
|
|
||||||
#hm3 configure Counter counter
|
|
||||||
#hm3 init
|
|
||||||
|
|
||||||
|
|
||||||
ClientPut "Installed 4-circle stuff"
|
|
||||||
|
|
||||||
|
|
||||||
#source transact.tcl
|
|
||||||
#Publish transact Spy
|
|
||||||
#MakeSPS sps lnsa12.psi.ch 4000 4
|
|
||||||
|
|
||||||
#source beamdt.tcl
|
|
||||||
#------------- C804-DC motors
|
|
||||||
set nob(Computer) lnsp22.psi.ch
|
|
||||||
set nob(port) 4000
|
|
||||||
set nob(channel) 7
|
|
||||||
set nob(motor) 1
|
|
||||||
set nob(upperlimit) 250000
|
|
||||||
set nob(lowerlimit) -250000
|
|
||||||
#MakePIMotor nobi c804 nob
|
|
||||||
#set nob(channel) 6
|
|
||||||
#Motor pilz pipiezo nob
|
|
||||||
|
|
||||||
VarMake datafile Text Spy
|
|
||||||
datafile focus-1001848.hdf
|
|
||||||
#--------- create a time array for histogramming
|
|
||||||
#MakeHM chiquita SINQHM
|
|
||||||
MakeHM hm SIM
|
|
||||||
#chiquita configure HMComputer lnse03.psi.ch
|
|
||||||
#chiquita configure HMport 2400
|
|
||||||
hm configure HistMode TOF
|
|
||||||
hm configure OverFlowMode Ceil
|
|
||||||
hm configure Rank 1
|
|
||||||
hm configure dim0 383
|
|
||||||
hm configure Length 383
|
|
||||||
hm configure BinWidth 4
|
|
||||||
hm preset 100.
|
|
||||||
hm CountMode Timer
|
|
||||||
hm configure Counter counter
|
|
||||||
hm configure init 0
|
|
||||||
hm genbin 120. 35. 512
|
|
||||||
hm init
|
|
||||||
|
|
||||||
VarMake delay Float Mugger
|
|
||||||
delay 158.8
|
|
||||||
VarMake flightpath Float Mugger
|
|
||||||
delay 2000
|
|
||||||
VarMake flightpathlength Float Mugger
|
|
||||||
delay 2500
|
|
||||||
|
|
||||||
MakeFocusAverager average hm
|
|
||||||
|
|
||||||
FocusInstall hm focus.dic $shome/sics/focusmerge.dat
|
|
||||||
storefocus upper 1
|
|
||||||
storefocus lower 1
|
|
||||||
|
|
||||||
|
|
||||||
#MakeChopper choco docho lnsp20 4000 8
|
|
||||||
MakeChopper choco sim
|
|
||||||
#ChopperAdapter fermispeed choco chopper1.nspee 0 20000
|
|
||||||
#ChopperAdapter diskspeed choco chopper2.nspee 0 20000
|
|
||||||
#ChopperAdapter phase choco chopper2.nphas 0 90.
|
|
||||||
#ChopperAdapter ratio choco chopper2.ratio 0 6.
|
|
||||||
ChopperAdapter diskspeed choco speed 0 20000
|
|
||||||
ChopperAdapter phase choco phase 0 90.
|
|
||||||
ChopperAdapter ratio choco ratio 0 6.
|
|
||||||
|
|
||||||
#-------- SANS Cooker
|
|
||||||
#MakeChopper cooker sanscook lnsa10 4000 11
|
|
||||||
#ChopperAdapter cookp cooker mp 0 400
|
|
||||||
#ChopperAdapter cookz cooker mz 0 400
|
|
||||||
|
|
||||||
|
|
||||||
source chosta.tcl
|
|
||||||
Publish chosta Spy
|
|
||||||
|
|
||||||
#MakeSPS sps1 lnsp25.psi.ch 4000 10
|
|
||||||
|
|
||||||
|
|
||||||
Publish testscan User
|
|
||||||
proc testscan {} {
|
|
||||||
return " 1 2 3 4 5"
|
|
||||||
}
|
|
||||||
|
|
||||||
MakeXYTable ixi
|
|
||||||
|
|
||||||
source cotop.tcl
|
|
||||||
Publish co User
|
|
||||||
|
|
||||||
#source helium.tcl
|
|
||||||
|
|
||||||
MakeTRICSNEXUS sicsdatanumber $shome/sics/tmp trics.dic
|
|
||||||
source $shome/sics/tcl/tricscount.tcl
|
|
||||||
|
|
||||||
source autofile.tcl
|
|
||||||
autofilepath $shome/tmp/auto
|
|
||||||
|
|
||||||
MakeXYTable omth
|
|
||||||
|
|
||||||
Publish info user
|
|
||||||
MakeLin2Ang a5l a5
|
|
||||||
|
|
||||||
#source tmp/beam.tcl
|
|
||||||
source tcl/wwwpar.tcl
|
|
||||||
source bef.tcl
|
|
||||||
|
|
||||||
source batch.tcl
|
|
||||||
Publish batchrun User
|
|
||||||
|
|
||||||
|
|
||||||
#------- test of RS232Controller
|
|
||||||
#MakeRS232Controller hugo psts233 3004
|
|
||||||
|
|
||||||
#-------------------------- batch run issue
|
|
||||||
VarMake BatchRoot Text User
|
|
||||||
BatchRoot /data/koenneck/src/sics
|
|
||||||
Publish batchrun User
|
|
||||||
|
|
||||||
proc SplitReply { text } {
|
|
||||||
set l [split $text =]
|
|
||||||
return [lindex $l 1]
|
|
||||||
}
|
|
||||||
|
|
||||||
proc batchrun file {
|
|
||||||
fileeval [string trim [SplitReply [BatchRoot]]/$file]
|
|
||||||
}
|
|
||||||
@ -1,7 +0,0 @@
|
|||||||
drive mom 3.
|
|
||||||
scan clear
|
|
||||||
scan np 10
|
|
||||||
scan var a2t 0. .1
|
|
||||||
scan mode timer
|
|
||||||
scan preset 1
|
|
||||||
scan run
|
|
||||||
129
topsir.tcl
129
topsir.tcl
@ -1,129 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for a simulated TOPSI instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke February, 1996
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
# --------------- Initialize Tcl internals --------------------------------
|
|
||||||
set auto_path "/data/koenneck/src/sics/tcl"
|
|
||||||
source $auto_path/topsicom.tcl
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption ServerLogBaseName /data/koenneck/src/sics/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2910
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2913
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory /data/koenneck/src/sics/tcl
|
|
||||||
ServerOption DefaultCommandFile topsicom.tcl
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "TOPSI" #initialisation
|
|
||||||
VarMake sample Text User
|
|
||||||
sample "DanielOxid"
|
|
||||||
VarMake Temperature Float User
|
|
||||||
Temperature 21.5
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
Title "TopsiTupsiTapsi"
|
|
||||||
VarMake User Text User
|
|
||||||
User "Daniel_the_Clementine"
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
Motor A1 EL734 lnsp22.psi.ch 4000 2 1 # Monochromator 2Theta
|
|
||||||
Motor A2 EL734 lnsp22.psi.ch 4000 2 5 # Monochromator 2Theta
|
|
||||||
Motor A3 EL734 lnsp22.psi.ch 4000 2 6 # Sample Omega
|
|
||||||
Motor A4 SIM -130. 130. 1. 2. # Sample 2Theta
|
|
||||||
Motor A5 SIM -30. 30. 1. 3. # ? horiz. Translation
|
|
||||||
Motor A6 SIM -30. 30. 1. 3. # ? vert Translation
|
|
||||||
Motor MTL SIM -30. 30. 1. 3. # mono lower translation
|
|
||||||
Motor MTU SIM -30. 30. 1. 3. # mono upper translation
|
|
||||||
#Motor STL EL734 lnsp22.psi.ch 4000 5 10 # sample lower translation
|
|
||||||
Motor STL SIM -30. 30. 1. 3.
|
|
||||||
Motor STU SIM -30. 30. 1. 3. # sample upper translation
|
|
||||||
Motor MGU SIM -50. 50. 1. 3. # mono upper goniometer
|
|
||||||
Motor SGL SIM -20. 20. 1. 3. # sample lower goniometer
|
|
||||||
Motor SGU SIM -20. 20. 1. 3. # sample upper goniometer
|
|
||||||
Motor SDM SIM -5 5. 1. 3. # weird Motor
|
|
||||||
|
|
||||||
Motor D1R SIM -20. 20. 1. 3. # Diaphragm 1 right
|
|
||||||
Motor D1L SIM -20. 20. 1. 3. # Diaphragm 1 left
|
|
||||||
Motor D1T SIM -20. 20. 1. 3. # Diaphragm 1 top & Bottom
|
|
||||||
|
|
||||||
Motor D2R SIM -20. 20. 1. 3. # Diaphragm 2 right
|
|
||||||
Motor D2L SIM -20. 20. 1. 3. # Diaphragm 2 left
|
|
||||||
Motor D2T SIM -20. 20. 1. 3. # Diaphragm 2 top & Bottom
|
|
||||||
|
|
||||||
Motor D3R SIM -20. 20. 1. 3. # Diaphragm 2 right
|
|
||||||
Motor D3L SIM -20. 20. 1. 3. # Diaphragm 2 left
|
|
||||||
Motor D3T SIM -20. 20. 1. 3. # Diaphragm 2 top & Bottom
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R S
|
|
||||||
#MakeCounter counter EL737 lnsp22.psi.ch 4000 4
|
|
||||||
MakeCounter counter SIM
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# M U L T I D E V I C E V A R I A B L E S
|
|
||||||
MakeMono mono "Ge-111" A1 A2
|
|
||||||
MakeWaveLength lambda mono
|
|
||||||
MakeO2T O2T A3 A4
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O N F I G U R E D E V I C E S T O H A L T I N
|
|
||||||
# I N T E R R U P T
|
|
||||||
AddHalt A1 A2 A3 A4 A5 A6 MTL MTU STL STU MGU SGL SGU SDM D1R D1L D1T \
|
|
||||||
D2R D2L D2T D3R D3L D3T
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
MakeDrive
|
|
||||||
Publish scan User
|
|
||||||
Publish ScanCounts Spy
|
|
||||||
Publish TextStatus Spy
|
|
||||||
Publish otUnknown User
|
|
||||||
MakeRuenBuffer
|
|
||||||
MakeXYTable table
|
|
||||||
|
|
||||||
120
topsirr.tcl
120
topsirr.tcl
@ -1,120 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for a simulated TOPSI instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke February, 1996
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
# --------------- Initialize Tcl internals --------------------------------
|
|
||||||
set auto_path "/data/koenneck/src/sics/tcl"
|
|
||||||
source $auto_path/topsicom.tcl
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption ServerLogBaseName /data/koenneck/src/sics/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2910
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2913
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory /data/koenneck/src/sics/tcl
|
|
||||||
ServerOption DefaultCommandFile topsicom.tcl
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "TOPSI" #initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
Title "TopsiTupsiTapsi"
|
|
||||||
VarMake User Text User
|
|
||||||
User "Daniel_the_Clementine"
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
Motor A1 EL734 lnsp22.psi.ch 4000 1 1 # Monochromator 2Theta
|
|
||||||
Motor A2 EL734 lnsp22.psi.ch 4000 1 3 # Monochromator 2Theta
|
|
||||||
Motor A3 EL734 lnsp22.psi.ch 4000 1 9 # Sample Omega
|
|
||||||
Motor A4 SIM -130. 130. 1. 2. # Sample 2Theta
|
|
||||||
Motor A5 SIM -30. 30. 1. 3. # ? horiz. Translation
|
|
||||||
Motor A6 SIM -30. 30. 1. 3. # ? vert Translation
|
|
||||||
Motor MTL SIM -30. 30. 1. 3. # mono lower translation
|
|
||||||
Motor MTU SIM -30. 30. 1. 3. # mono upper translation
|
|
||||||
Motor STL EL734 lnsp22.psi.ch 4000 5 10 # sample lower translation
|
|
||||||
Motor STU SIM -30. 30. 1. 3. # sample upper translation
|
|
||||||
Motor MGU SIM -50. 50. 1. 3. # mono upper goniometer
|
|
||||||
Motor SGL SIM -20. 20. 1. 3. # sample lower goniometer
|
|
||||||
Motor SGU SIM -20. 20. 1. 3. # sample upper goniometer
|
|
||||||
Motor SDM SIM -5 5. 1. 3. # weird Motor
|
|
||||||
|
|
||||||
Motor D1R SIM -20. 20. 1. 3. # Diaphragm 1 right
|
|
||||||
Motor D1L SIM -20. 20. 1. 3. # Diaphragm 1 left
|
|
||||||
Motor D1T SIM -20. 20. 1. 3. # Diaphragm 1 top & Bottom
|
|
||||||
|
|
||||||
Motor D2R SIM -20. 20. 1. 3. # Diaphragm 2 right
|
|
||||||
Motor D2L SIM -20. 20. 1. 3. # Diaphragm 2 left
|
|
||||||
Motor D2T SIM -20. 20. 1. 3. # Diaphragm 2 top & Bottom
|
|
||||||
|
|
||||||
Motor D3R SIM -20. 20. 1. 3. # Diaphragm 2 right
|
|
||||||
Motor D3L SIM -20. 20. 1. 3. # Diaphragm 2 left
|
|
||||||
Motor D3T SIM -20. 20. 1. 3. # Diaphragm 2 top & Bottom
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R S
|
|
||||||
MakeCounter counter EL737 lnsp22.psi.ch 4000 4
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# M U L T I D E V I C E V A R I A B L E S
|
|
||||||
MakeMono mono "Ge-111" A1 A2
|
|
||||||
MakeWaveLength lambda mono
|
|
||||||
MakeO2T O2T A3 A4
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O N F I G U R E D E V I C E S T O H A L T I N
|
|
||||||
# I N T E R R U P T
|
|
||||||
AddHalt A1 A2 A3 A4 A5 A6 MTL MTU STL STU MGU SGL SGU SDM D1R D1L D1T \
|
|
||||||
D2R D2L D2T D3R D3L D3T
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
|
|
||||||
MakeDrive
|
|
||||||
Publish scan User
|
|
||||||
Publish otUnknown User
|
|
||||||
MakeRuenBuffer
|
|
||||||
20
transact.tcl
20
transact.tcl
@ -1,20 +0,0 @@
|
|||||||
#----------------------------------------------------------------------------
|
|
||||||
# This implements a little command which just sets marks in the output
|
|
||||||
# stream. This is for experimenting with client communications schemes.
|
|
||||||
#
|
|
||||||
# Mark Koennecke, May 1999
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
|
|
||||||
proc transact { key } {
|
|
||||||
set keyy [string tolower $key]
|
|
||||||
if {[string compare $keyy "start"] == 0 } {
|
|
||||||
ClientPut "TRANSACTSTART"
|
|
||||||
return
|
|
||||||
}
|
|
||||||
if {[string compare $keyy "end"] == 0 } {
|
|
||||||
ClientPut "TRANSACTEND"
|
|
||||||
return
|
|
||||||
}
|
|
||||||
ClientPut "ERROR: Transact understands only start and end"
|
|
||||||
return;
|
|
||||||
}
|
|
||||||
199
trics.tcl
199
trics.tcl
@ -1,199 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for the TRICS instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke November, 1996
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
set home /data/koenneck/src/sics/tmp
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 7000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption LogFileDir $home/log
|
|
||||||
#LogFileDir is the directory where the command log is going
|
|
||||||
|
|
||||||
ServerOption LogFileBaseName $home/log/tricsserver
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
|
|
||||||
ServerOption ServerPort 2911
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2914
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
# Telnet options
|
|
||||||
ServerOption TelnetPort 1301
|
|
||||||
ServerOption TelWord sicslogin
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory $home/bin
|
|
||||||
|
|
||||||
#------ a port for broadcasting UDP messages
|
|
||||||
ServerOption QuieckPort 2108
|
|
||||||
|
|
||||||
TokenInit connan
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Jurg willibald 1
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "TRICS" #initialisation
|
|
||||||
Instrument lock
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
VarMake sample Text User
|
|
||||||
sample "Scheferit"
|
|
||||||
VarMake User Text User
|
|
||||||
User "Jurg"
|
|
||||||
VarMake distance Float User
|
|
||||||
VarMake monochromator Text User
|
|
||||||
VarMake lambda Float Mugger
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
#Motor D1V EL734 lnsp22.psi.ch 4000 3 3
|
|
||||||
|
|
||||||
#------------ Monochromator Motors
|
|
||||||
ClientPut "Initialising Elephant"
|
|
||||||
Motor MOMU EL734 lnsp18.psi.ch 4000 4 9
|
|
||||||
Motor MTVU EL734 lnsp18.psi.ch 4000 4 11
|
|
||||||
Motor MTPU EL734 lnsp18.psi.ch 4000 4 10
|
|
||||||
Motor MGVU EL734 lnsp18.psi.ch 4000 4 5
|
|
||||||
Motor MGPU EL734 lnsp18.psi.ch 4000 4 12
|
|
||||||
Motor MCVU EL734 lnsp18.psi.ch 4000 4 6
|
|
||||||
Motor MOML EL734 lnsp18.psi.ch 4000 4 7
|
|
||||||
Motor MTVL EL734 lnsp18.psi.ch 4000 4 1
|
|
||||||
Motor MTPL EL734 lnsp18.psi.ch 4000 4 8
|
|
||||||
Motor MGVL EL734 lnsp18.psi.ch 4000 4 3
|
|
||||||
Motor MGPL EL734 lnsp18.psi.ch 4000 4 2
|
|
||||||
Motor MCVL EL734 lnsp18.psi.ch 4000 4 4
|
|
||||||
Motor MEXZ EL734 lnsp18.psi.ch 4000 5 1
|
|
||||||
|
|
||||||
#------------- Sample Table Motors
|
|
||||||
ClientPut "Initialising Sample Table Motors"
|
|
||||||
Motor SOM EL734 lnsp18.psi.ch 4000 2 2
|
|
||||||
Motor STT EL734 lnsp18.psi.ch 4000 2 1
|
|
||||||
Motor SCH EL734 lnsp18.psi.ch 4000 2 3
|
|
||||||
Motor SPH EL734 lnsp18.psi.ch 4000 2 4
|
|
||||||
Motor DG1 EL734 lnsp18.psi.ch 4000 2 5
|
|
||||||
Motor DG2 EL734 lnsp18.psi.ch 4000 2 6
|
|
||||||
Motor DG3 EL734 lnsp18.psi.ch 4000 2 7
|
|
||||||
|
|
||||||
#------------- Collimators
|
|
||||||
Motor CEX1 EL734 lnsp18.psi.ch 4000 3 1
|
|
||||||
Motor CEX2 EL734 lnsp18.psi.ch 4000 3 2
|
|
||||||
|
|
||||||
#------------- Motor Aliases
|
|
||||||
#SicsAlias CEX1 A17
|
|
||||||
#SicsAlias CEX2 A18
|
|
||||||
SicsAlias MOMU A1
|
|
||||||
SicsAlias MTVU A12
|
|
||||||
SicsAlias MTPU A13
|
|
||||||
SicsAlias MGVU A14
|
|
||||||
SicsAlias MGPU A15
|
|
||||||
SicsAlias MCVU A16
|
|
||||||
SicsAlias MOML B1
|
|
||||||
SicsAlias MTVL A22
|
|
||||||
SicsAlias MTPL A23
|
|
||||||
SicsAlias MGVL A24
|
|
||||||
SicsAlias MGPL A25
|
|
||||||
SicsAlias MCVL A26
|
|
||||||
SicsAlias MEXZ A37
|
|
||||||
SicsAlias SOM A3
|
|
||||||
SicsAlias SOM OM
|
|
||||||
SicsAlias STT A4
|
|
||||||
SicsAlias STT TH
|
|
||||||
SicsAlias SCH A10
|
|
||||||
SicsAlias SPH A20
|
|
||||||
SicsAlias SCH CH
|
|
||||||
SicsAlias SPH PH
|
|
||||||
SicsAlias DG1 A31
|
|
||||||
SicsAlias DG2 A32
|
|
||||||
SicsAlias DG3 A33
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# C O U N T E R S
|
|
||||||
MakeCounter counter EL737 lnsp18.psi.ch 4000 6
|
|
||||||
|
|
||||||
MakeO2T O2T OM TH
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# P R O C E D U R E S
|
|
||||||
MakeDrive
|
|
||||||
MakeRuenBuffer
|
|
||||||
#---------------- TestVariables for Storage
|
|
||||||
VarMake SicsDataPath Text Mugger
|
|
||||||
SicsDataPath "$home/data/"
|
|
||||||
SicsDataPath lock
|
|
||||||
VarMake SicsDataPrefix Text Mugger
|
|
||||||
SicsDataPrefix trics
|
|
||||||
SicsDataPrefix lock
|
|
||||||
VarMake SicsDataPostFix Text Mugger
|
|
||||||
SicsDataPostFix ".asc"
|
|
||||||
SicsDataPostFix lock
|
|
||||||
|
|
||||||
VarMake Adress Text User
|
|
||||||
VarMake phone Text User
|
|
||||||
VarMake fax Text User
|
|
||||||
VarMake email Text User
|
|
||||||
VarMake sample_mur Float User
|
|
||||||
|
|
||||||
MakeDataNumber SicsDataNumber "$home/data/DataNumber"
|
|
||||||
|
|
||||||
VarMake lastscancommand Text Spy
|
|
||||||
MakeScanCommand xxxscan counter $home/bin/trics.hdd recover.bin
|
|
||||||
MakePeakCenter xxxscan
|
|
||||||
|
|
||||||
|
|
||||||
source $home/bin/topsicom.tcl
|
|
||||||
set home /home/TRICS
|
|
||||||
source $home/bin/cscan.tcl
|
|
||||||
source $home/bin/log.tcl
|
|
||||||
Publish cscan User
|
|
||||||
Publish scan Spy
|
|
||||||
Publish scaninfo Spy
|
|
||||||
Publish sscan User
|
|
||||||
Publish sftime Spy
|
|
||||||
SerialInit
|
|
||||||
Publish serialport User
|
|
||||||
Publish p1 User
|
|
||||||
#------------------ 4 circle stuff
|
|
||||||
MakeHKL TH OM CH PH
|
|
||||||
HKL lambda 0.70379
|
|
||||||
HKL setub -0.1247023 0.0016176 -0.0413566 \
|
|
||||||
-0.1044479 -0.0013264 0.0493878 \
|
|
||||||
0.0007513 0.0840941 0.0015745
|
|
||||||
MakeOptimise opti counter
|
|
||||||
|
|
||||||
ClientPut "DONE initialsing TRICS"
|
|
||||||
@ -1,8 +0,0 @@
|
|||||||
for {set i 0 } { $i < 30} {incr i} {
|
|
||||||
scan clear
|
|
||||||
scan np 10
|
|
||||||
scan var a4 10. .1
|
|
||||||
scan mode timer
|
|
||||||
scan preset 1
|
|
||||||
scan run
|
|
||||||
}
|
|
||||||
88
ttest.tcl
88
ttest.tcl
@ -1,88 +0,0 @@
|
|||||||
# --------------------------------------------------------------------------
|
|
||||||
# Initialization script for a simulated TOPSI instrument
|
|
||||||
#
|
|
||||||
#
|
|
||||||
# Dr. Mark Koennecke February, 1996
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# O P T I O N S
|
|
||||||
|
|
||||||
# --------------- Initialize Tcl internals --------------------------------
|
|
||||||
set root /home/koenneck/psi/sics
|
|
||||||
|
|
||||||
# first all the server options are set
|
|
||||||
|
|
||||||
ServerOption ReadTimeOut 100
|
|
||||||
# timeout when checking for commands. In the main loop SICS checks for
|
|
||||||
# pending commands on each connection with the above timeout, has
|
|
||||||
# PERFORMANCE impact!
|
|
||||||
|
|
||||||
ServerOption AcceptTimeOut 100
|
|
||||||
# timeout when checking for connection req.
|
|
||||||
# Similar to above, but for connections
|
|
||||||
|
|
||||||
ServerOption ReadUserPasswdTimeout 500000
|
|
||||||
# time to wiat for a user/passwd to be sent from a client. Increase this
|
|
||||||
# if there is a problem connecting to a server due to network overload\
|
|
||||||
|
|
||||||
ServerOption ServerLogBaseName $root/server
|
|
||||||
# the path and base name of the internal server logfile to which all
|
|
||||||
# activity will be logged.
|
|
||||||
|
|
||||||
ServerOption ServerPort 2910
|
|
||||||
# the port number the server is going to listen at. The client MUST know
|
|
||||||
# this number in order to connect. It is in client.ini
|
|
||||||
|
|
||||||
ServerOption InterruptPort 2913
|
|
||||||
# The UDP port where the server will wait for Interrupts from clients.
|
|
||||||
# Obviously, clients wishing to interrupt need to know this number.
|
|
||||||
|
|
||||||
ServerOption DefaultTclDirectory $root/tcl
|
|
||||||
ServerOption DefaultCommandFile topsicom.tcl
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# U S E R S
|
|
||||||
|
|
||||||
# than the SICS users are specified
|
|
||||||
# Syntax: SicsUser name password userRightsCode
|
|
||||||
SicsUser Mugger Diethelm 1
|
|
||||||
SicsUser User Rosy 2
|
|
||||||
SicsUser Spy 007 3
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# S I M P L E V A R I A B L E S
|
|
||||||
|
|
||||||
# now a few general variables are created
|
|
||||||
# Syntax: VarMake name type access
|
|
||||||
# type can be one of: Text, Int, Float
|
|
||||||
#access can be one of: Internal, Mugger, user, Spy
|
|
||||||
|
|
||||||
VarMake Instrument Text Internal
|
|
||||||
Instrument "TOPSI" #initialisation
|
|
||||||
|
|
||||||
VarMake Title Text User
|
|
||||||
Title "TopsiTupsiTapsi"
|
|
||||||
VarMake User Text User
|
|
||||||
User "Daniel_the_Clementine"
|
|
||||||
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# D E V I C E S : M O T O R S
|
|
||||||
|
|
||||||
# Motor a4 EL734 LNSP22 4000 5 6
|
|
||||||
# EL734 motor with parameters: hostname PortNumber Channel MotorID
|
|
||||||
#Motor A2 EL734 lnsp22.psi.ch 4000 5 2 # Monochromator 2Theta
|
|
||||||
#Motor A3 EL734 lnsp22.psi.ch 4000 5 3 # Sample Omega
|
|
||||||
|
|
||||||
# C O U N T E R S
|
|
||||||
#MakeCounter counter EL737 lnsp22.psi.ch 4000 4
|
|
||||||
|
|
||||||
|
|
||||||
#MakeRS232Controller marcel psxtemp 3004
|
|
||||||
|
|
||||||
MakeRS232Controller pfiff psts227 3009
|
|
||||||
pfiff sendterminator 0x0
|
|
||||||
pfiff replyterminator 0x72 0x77
|
|
||||||
|
|
||||||
|
|
||||||
Publish pfiffread Spy
|
|
||||||
source pfiff.tcl
|
|
||||||
|
|
||||||
266
viscom.tcl
266
viscom.tcl
@ -1,266 +0,0 @@
|
|||||||
#!/usr/bin/wish
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
# A semi visual command line client for SICS
|
|
||||||
#
|
|
||||||
# Mark Koennnecke, December 1996
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
lappend auto_path /data/koenneck/bin/tcl
|
|
||||||
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
# Initialization Section
|
|
||||||
|
|
||||||
set INI(DefUser) Spy
|
|
||||||
set INI(DefPasswd) 007
|
|
||||||
set INI(ServerPort) 2911
|
|
||||||
set INI(InterruptPort) 2913
|
|
||||||
set INI(box) localhost
|
|
||||||
set INI(usPasswd) Rosy
|
|
||||||
set INI(muPasswd) Diethelm
|
|
||||||
set INI(socket) stdout
|
|
||||||
set INI(status) stdout
|
|
||||||
set INI(maxinput) 10
|
|
||||||
set INI(startsleep) 5000
|
|
||||||
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# Menu Commands
|
|
||||||
proc MenuExit { } {
|
|
||||||
exit
|
|
||||||
}
|
|
||||||
proc MenuUser { } {
|
|
||||||
global INI
|
|
||||||
SendCommand [format "config Rights User %s" $INI(usPasswd)]
|
|
||||||
}
|
|
||||||
proc MenuManager { } {
|
|
||||||
global INI
|
|
||||||
SendCommand [format "config Rights Mugger %s" $INI(muPasswd)]
|
|
||||||
}
|
|
||||||
proc MenuConnect { } {
|
|
||||||
StartConnection
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
# Commands used in bindings
|
|
||||||
proc TextInput {} {
|
|
||||||
global INI
|
|
||||||
set input [.input.entry get]
|
|
||||||
SendCommand $input
|
|
||||||
.input.libo.liste insert end $input
|
|
||||||
if {[ .input.libo.liste size] > $INI(maxinput) } {
|
|
||||||
.input.libo.liste delete 0
|
|
||||||
}
|
|
||||||
.input.libo.liste see end
|
|
||||||
.input.entry delete 0 end
|
|
||||||
}
|
|
||||||
proc InputBack { } {
|
|
||||||
set b [.input.entry index end]
|
|
||||||
set b [expr {$b - 1}]
|
|
||||||
.input.entry delete $b
|
|
||||||
}
|
|
||||||
proc InputSelect {} {
|
|
||||||
global INI
|
|
||||||
set input [.input.libo.liste get active]
|
|
||||||
SendCommand $input
|
|
||||||
}
|
|
||||||
proc ListEdit {} {
|
|
||||||
global INI
|
|
||||||
set input [.input.libo.liste get active]
|
|
||||||
.input.entry insert 0 $input
|
|
||||||
}
|
|
||||||
#---------------------------------------------------------------------------
|
|
||||||
# The Button Commands
|
|
||||||
proc ButtonHalt {} {
|
|
||||||
global INI
|
|
||||||
SendCommand "INT1712 3"
|
|
||||||
}
|
|
||||||
proc ButtonStop {} {
|
|
||||||
global INI
|
|
||||||
SendCommand "INT1712 2"
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
# Create the Visuals
|
|
||||||
proc MakeWindow {} {
|
|
||||||
# a frame to hold all
|
|
||||||
# the menubar
|
|
||||||
frame .mbar -relief raised -bd 2
|
|
||||||
menubutton .mbar.file -text File -underline 0 \
|
|
||||||
-menu .mbar.file.menu
|
|
||||||
menubutton .mbar.con -text Connect -underline 0 \
|
|
||||||
-menu .mbar.con.menu
|
|
||||||
menubutton .mbar.rights -text Rights -underline 0 \
|
|
||||||
-menu .mbar.rights.menu
|
|
||||||
pack .mbar.file .mbar.con .mbar.rights -side left
|
|
||||||
# file pulldown
|
|
||||||
menu .mbar.file.menu
|
|
||||||
.mbar.file.menu add command -label "Exit" -command MenuExit
|
|
||||||
# connect menu
|
|
||||||
menu .mbar.con.menu
|
|
||||||
.mbar.con.menu add command -label "Topsi" -command MenuConnect
|
|
||||||
# Rights menu pulldown
|
|
||||||
menu .mbar.rights.menu
|
|
||||||
.mbar.rights.menu add command -label "Become User" -command \
|
|
||||||
MenuUser
|
|
||||||
.mbar.rights.menu add command -label "Become Manager" -command \
|
|
||||||
MenuManager
|
|
||||||
|
|
||||||
# now the output from our SICS server
|
|
||||||
frame .output
|
|
||||||
label .output.text -text "The Sics-Server's answers:"
|
|
||||||
pack .output.text -side top
|
|
||||||
listbox .output.liste -height 13 -width 70 \
|
|
||||||
-yscrollcommand ".output.scroll set"
|
|
||||||
pack .output.liste -side left
|
|
||||||
scrollbar .output.scroll -command ".output.liste yview"
|
|
||||||
pack .output.scroll -side right -fill y
|
|
||||||
|
|
||||||
# the delimiter between output and input
|
|
||||||
frame .strich -relief flat -height 3m
|
|
||||||
.strich configure -background red
|
|
||||||
|
|
||||||
# the input stuff
|
|
||||||
frame .input
|
|
||||||
label .input.head -text "Command History"
|
|
||||||
pack .input.head -side top -fill x
|
|
||||||
frame .input.libo
|
|
||||||
listbox .input.libo.liste -height 5 -width 70 \
|
|
||||||
-yscrollcommand ".input.libo.scroll set"
|
|
||||||
pack .input.libo.liste -side left
|
|
||||||
#list box bindings
|
|
||||||
bind .input.libo.liste <Double-Button-1> InputSelect
|
|
||||||
bind .input.libo.liste <Double-Button-3> ListEdit
|
|
||||||
|
|
||||||
scrollbar .input.libo.scroll -command ".input.libo.liste yview"
|
|
||||||
pack .input.libo.scroll -side right -fill y
|
|
||||||
pack .input.libo -after .input.head
|
|
||||||
label .input.line -text "Type Command to Server"
|
|
||||||
pack .input.line -after .input.libo -fill x
|
|
||||||
entry .input.entry -width 70 -relief sunken
|
|
||||||
pack .input.entry -after .input.line
|
|
||||||
#entry bindings
|
|
||||||
bind .input.entry <KeyPress-Return> TextInput
|
|
||||||
bind .input.entry <Double-Button-1> TextInput
|
|
||||||
bind .input.entry <KeyPress-Delete> InputBack
|
|
||||||
bind .input.entry <Control-d> InputBack
|
|
||||||
# bind .input.entry <Any-KeyPress> { puts "The Keysym is %K"}
|
|
||||||
|
|
||||||
# The lower button row
|
|
||||||
frame .buttonrow
|
|
||||||
button .buttonrow.stop -text "Stop" -command ButtonStop
|
|
||||||
button .buttonrow.halt -text "Emergency Halt" -command ButtonHalt
|
|
||||||
button .buttonrow.exit -text "Exit" -command MenuExit
|
|
||||||
label .buttonrow.stat -background DarkSalmon -text "Disconnected "
|
|
||||||
pack .buttonrow.stop .buttonrow.halt .buttonrow.stat \
|
|
||||||
-side left -fill x
|
|
||||||
# the end
|
|
||||||
pack configure .mbar -expand 1
|
|
||||||
pack .mbar .output .strich .input .buttonrow -side top -fill x
|
|
||||||
wm title . "The SICS Visual Command Line Client"
|
|
||||||
}
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
# Setting up the connection to the Server
|
|
||||||
proc StartConnection {} {
|
|
||||||
global INI
|
|
||||||
global lost
|
|
||||||
# start main connection
|
|
||||||
set INI(socket) [socket $INI(box) $INI(ServerPort)]
|
|
||||||
puts $INI(socket) [format "%s %s" $INI(DefUser) $INI(DefPasswd)]
|
|
||||||
flush $INI(socket)
|
|
||||||
fconfigure $INI(socket) -blocking 0
|
|
||||||
fconfigure $INI(socket) -buffering none
|
|
||||||
fileevent $INI(socket) readable GetData
|
|
||||||
after $INI(startsleep)
|
|
||||||
# start status connection
|
|
||||||
set INI(status) [socket $INI(box) $INI(ServerPort)]
|
|
||||||
puts $INI(status) [format "%s %s" $INI(DefUser) $INI(DefPasswd)]
|
|
||||||
flush $INI(status)
|
|
||||||
fconfigure $INI(status) -blocking 0
|
|
||||||
fconfigure $INI(status) -buffering none
|
|
||||||
fileevent $INI(status) readable GetStatus
|
|
||||||
after $INI(startsleep)
|
|
||||||
after 2000 SendStatRequest
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc GetData { } {
|
|
||||||
global INI
|
|
||||||
global lost
|
|
||||||
if { [eof $INI(socket)] } {
|
|
||||||
PutOutput "Connection to server lost"
|
|
||||||
.buttonrow.stat configure -text "Disconnected"
|
|
||||||
after cancel SendStatRequest
|
|
||||||
close $INI(socket)
|
|
||||||
close $INI(status)
|
|
||||||
return
|
|
||||||
}
|
|
||||||
set buf [read $INI(socket)]
|
|
||||||
set buf [string trim $buf]
|
|
||||||
set list [split $buf \n]
|
|
||||||
foreach teil $list {
|
|
||||||
set teil [string trimright $teil]
|
|
||||||
if { [ string first status $teil] >= 0} {
|
|
||||||
set l [ split $teil = ]
|
|
||||||
.buttonrow.stat configure -text [lindex $l 1]
|
|
||||||
} else {
|
|
||||||
PutOutput $teil
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#----------------------------------------------------------------------------
|
|
||||||
proc GetStatus { } {
|
|
||||||
global INI
|
|
||||||
global lost
|
|
||||||
if { [eof $INI(status)] } {
|
|
||||||
PutOutput "Connection to server lost"
|
|
||||||
.buttonrow.stat configure -text "Disconnected"
|
|
||||||
after cancel SendStatRequest
|
|
||||||
close $INI(status)
|
|
||||||
close $INI(socket)
|
|
||||||
return
|
|
||||||
}
|
|
||||||
set buf [read $INI(status)]
|
|
||||||
set buf [string trim $buf]
|
|
||||||
set list [split $buf \n]
|
|
||||||
foreach teil $list {
|
|
||||||
set teil [string trimright $teil]
|
|
||||||
if { [ string first status $teil] >= 0} {
|
|
||||||
set l [ split $teil = ]
|
|
||||||
.buttonrow.stat configure -text [lindex $l 1]
|
|
||||||
}
|
|
||||||
}
|
|
||||||
}
|
|
||||||
#--------------------------------------------------------------------------
|
|
||||||
proc PutOutput { line } {
|
|
||||||
.output.liste insert end $line
|
|
||||||
.output.liste see end
|
|
||||||
}
|
|
||||||
|
|
||||||
proc SendCommand { text} {
|
|
||||||
global INI
|
|
||||||
global lost
|
|
||||||
if { [eof $INI(socket)] } {
|
|
||||||
PutOutput "Connection to server lost"
|
|
||||||
}
|
|
||||||
puts $INI(socket) $text
|
|
||||||
flush $INI(socket)
|
|
||||||
}
|
|
||||||
|
|
||||||
proc SendStatRequest { } {
|
|
||||||
global INI
|
|
||||||
global lost
|
|
||||||
if { [eof $INI(status)] } {
|
|
||||||
PutOutput "Connection to server lost"
|
|
||||||
}
|
|
||||||
puts $INI(status) status
|
|
||||||
flush $INI(status)
|
|
||||||
after 2000 SendStatRequest
|
|
||||||
}
|
|
||||||
|
|
||||||
proc PutOutput { line } {
|
|
||||||
.output.liste insert end $line
|
|
||||||
.output.liste see end
|
|
||||||
}
|
|
||||||
|
|
||||||
|
|
||||||
#-----------------------------------------------------------------------------
|
|
||||||
# M A I N
|
|
||||||
set lost 0
|
|
||||||
MakeWindow
|
|
||||||
vwait lost
|
|
||||||
|
|
||||||
36
volist.tcl
36
volist.tcl
@ -1,36 +0,0 @@
|
|||||||
proc omGetNum { text } {
|
|
||||||
set list [split $text =]
|
|
||||||
return [lindex $list 1]
|
|
||||||
}
|
|
||||||
|
|
||||||
omth clear
|
|
||||||
counter setmode monitor
|
|
||||||
set preset 15000
|
|
||||||
|
|
||||||
drive stt 60 om 23.
|
|
||||||
counter count $preset
|
|
||||||
set txt [counter getcounts]
|
|
||||||
set cts [omGetNum $txt]
|
|
||||||
omth add 1 $cts
|
|
||||||
|
|
||||||
drive stt 62 om 25.
|
|
||||||
counter count $preset
|
|
||||||
set txt [counter getcounts]
|
|
||||||
set cts [omGetNum $txt]
|
|
||||||
omth add 2 $cts
|
|
||||||
|
|
||||||
drive stt 63 om 26.
|
|
||||||
counter count $preset
|
|
||||||
set txt [counter getcounts]
|
|
||||||
set cts [omGetNum $txt]
|
|
||||||
omth add 3 $cts
|
|
||||||
|
|
||||||
|
|
||||||
drive stt 66 om 33.
|
|
||||||
counter count $preset
|
|
||||||
set txt [counter getcounts]
|
|
||||||
set cts [omGetNum $txt]
|
|
||||||
omth add 4 $cts
|
|
||||||
|
|
||||||
|
|
||||||
omth write volodia.lis
|
|
||||||
Reference in New Issue
Block a user