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

Remove TCL files to match with PSI cleanup

Browse Source
This commit is contained in:
Douglas Clowes
2015-03-19 11:30:51 +11:00
parent a43b106c25
commit 42500aca38
58 changed files with 0 additions and 9194 deletions
Download Patch File Download Diff File Expand all files Collapse all files

23
amorpar.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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]
}
}
}

79
collidertest.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
}

8
dmcscan.tcl
View File

@ -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
View File

@ -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
View File

@ -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
}

4
fetest.tcl
View File

@ -1,4 +0,0 @@
cscan a4 0. .2 10 2
for {set i 0} { $i < 5} { incr i} {
count timer 200
}

178
ftest.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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]
}

4
inidill.tcl
View File

@ -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
View File

@ -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

96
nxsupport.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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"
}

9
psitest.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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

10
sicsstatus.tcl
View File

@ -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

107
sicstemplates.tcl
View File

@ -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
View File

@ -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"
}
}

7
stest.tcl
View File

@ -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
View File

@ -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
View File

File diff suppressed because it is too large Load Diff

104
tasregress.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -1,5 +0,0 @@
for {set i 0} { $i < 3000} {incr i} {
ClientPut "Hello you"
}
ClientPut "I'am finished"
ClientPut [sicstime]

504
test.tcl
View File

@ -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]
}

7
testj.tcl
View 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
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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"

8
tscan.tcl
View File

@ -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
View File

@ -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
View File

@ -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
View File

@ -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

6
xy.tcl
View File

@ -1,6 +0,0 @@
ixi add 1 99.98
ixi add 2 1002.
ixi add 3 77.
ixi add 4 55.3
ixi add 5 100.3
ixi add 6 26.0