From 42500aca38b8ccad95c2b53defeb2f837a5f3c62 Mon Sep 17 00:00:00 2001 From: Douglas Clowes Date: Thu, 19 Mar 2015 11:30:51 +1100 Subject: [PATCH] Remove TCL files to match with PSI cleanup --- amorpar.tcl | 23 - amortest.tcl | 358 -------------- ati.tcl | 7 - autofile.tcl | 211 -------- backup.tcl | 137 ------ beam.tcl | 20 - beamdt.tcl | 20 - coll.tcl | 229 --------- collidertest.tcl | 79 --- cotop.tcl | 37 -- countf.tcl | 50 -- dmc.tcl | 187 ------- dmca.tcl | 174 ------- dmccom.tcl | 13 - dmcscan.tcl | 8 - dmcsim.tcl | 167 ------- fcircle.tcl | 355 -------------- fetest.tcl | 4 - ftest.tcl | 178 ------- hakle.tcl | 273 ----------- helium.tcl | 34 -- inc.tcl | 22 - inidill.tcl | 4 - itc4.tcl | 7 - nxsupport.tcl | 96 ---- object.tcl | 305 ------------ optfn.tcl | 37 -- optn.tcl | 22 - peaksearch.tcl | 499 ------------------- psitest.tcl | 9 - sans2.tcl | 665 ------------------------- sans2com.tcl | 334 ------------- sans2dis.tcl | 39 -- sansreal.tcl | 168 ------- servo.tcl | 77 --- sicsstat.tcl | 295 ------------ sicsstatus.tcl | 10 - sicstemplates.tcl | 107 ----- sinfo.tcl | 387 --------------- stest.tcl | 7 - sycamore.tcl | 219 --------- tascom.tcl | 1177 --------------------------------------------- tasregress.tcl | 104 ---- tassim.tcl | 273 ----------- tastest.tcl | 322 ------------- tclvarex.tcl | 57 --- tdir.tcl | 5 - test.tcl | 504 ------------------- testj.tcl | 7 - topsir.tcl | 129 ----- topsirr.tcl | 120 ----- transact.tcl | 20 - trics.tcl | 199 -------- tscan.tcl | 8 - ttest.tcl | 88 ---- viscom.tcl | 266 ---------- volist.tcl | 36 -- xy.tcl | 6 - 58 files changed, 9194 deletions(-) delete mode 100644 amorpar.tcl delete mode 100644 amortest.tcl delete mode 100644 ati.tcl delete mode 100644 autofile.tcl delete mode 100644 backup.tcl delete mode 100644 beam.tcl delete mode 100644 beamdt.tcl delete mode 100644 coll.tcl delete mode 100644 collidertest.tcl delete mode 100644 cotop.tcl delete mode 100644 countf.tcl delete mode 100644 dmc.tcl delete mode 100644 dmca.tcl delete mode 100644 dmccom.tcl delete mode 100644 dmcscan.tcl delete mode 100755 dmcsim.tcl delete mode 100644 fcircle.tcl delete mode 100644 fetest.tcl delete mode 100644 ftest.tcl delete mode 100644 hakle.tcl delete mode 100644 helium.tcl delete mode 100644 inc.tcl delete mode 100644 inidill.tcl delete mode 100644 itc4.tcl delete mode 100644 nxsupport.tcl delete mode 100755 object.tcl delete mode 100644 optfn.tcl delete mode 100644 optn.tcl delete mode 100644 peaksearch.tcl delete mode 100644 psitest.tcl delete mode 100644 sans2.tcl delete mode 100644 sans2com.tcl delete mode 100644 sans2dis.tcl delete mode 100644 sansreal.tcl delete mode 100644 servo.tcl delete mode 100644 sicsstat.tcl delete mode 100644 sicsstatus.tcl delete mode 100644 sicstemplates.tcl delete mode 100644 sinfo.tcl delete mode 100644 stest.tcl delete mode 100644 sycamore.tcl delete mode 100644 tascom.tcl delete mode 100644 tasregress.tcl delete mode 100644 tassim.tcl delete mode 100644 tastest.tcl delete mode 100644 tclvarex.tcl delete mode 100644 tdir.tcl delete mode 100644 test.tcl delete mode 100644 testj.tcl delete mode 100644 topsir.tcl delete mode 100644 topsirr.tcl delete mode 100644 transact.tcl delete mode 100644 trics.tcl delete mode 100644 tscan.tcl delete mode 100644 ttest.tcl delete mode 100755 viscom.tcl delete mode 100644 volist.tcl delete mode 100644 xy.tcl diff --git a/amorpar.tcl b/amorpar.tcl deleted file mode 100644 index bdd5af1e..00000000 --- a/amorpar.tcl +++ /dev/null @@ -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] -} \ No newline at end of file diff --git a/amortest.tcl b/amortest.tcl deleted file mode 100644 index b09fc1d2..00000000 --- a/amortest.tcl +++ /dev/null @@ -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 "\n" - append result "\n" - append result "\n" - append result "\n" - append result "\n" - append result "
User " [SplitReply [user]] "
Title " - append result [SplitReply [title]] "
Status " - append result [SplitReply [status]] "
Mode" - if {$mode == 1} { - append result "time-of-flight" - } else { - append result "scan mode" - } - append result "
\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] - } -} - - diff --git a/ati.tcl b/ati.tcl deleted file mode 100644 index e274d886..00000000 --- a/ati.tcl +++ /dev/null @@ -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 diff --git a/autofile.tcl b/autofile.tcl deleted file mode 100644 index 608adaa6..00000000 --- a/autofile.tcl +++ /dev/null @@ -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 {} { - -} - diff --git a/backup.tcl b/backup.tcl deleted file mode 100644 index b5dc3e50..00000000 --- a/backup.tcl +++ /dev/null @@ -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 diff --git a/beam.tcl b/beam.tcl deleted file mode 100644 index fc2baf2c..00000000 --- a/beam.tcl +++ /dev/null @@ -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 diff --git a/beamdt.tcl b/beamdt.tcl deleted file mode 100644 index 3f30ba3a..00000000 --- a/beamdt.tcl +++ /dev/null @@ -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 diff --git a/coll.tcl b/coll.tcl deleted file mode 100644 index bd6b53bc..00000000 --- a/coll.tcl +++ /dev/null @@ -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] - } - } -} - - - - - - - - diff --git a/collidertest.tcl b/collidertest.tcl deleted file mode 100644 index 8eaa0aec..00000000 --- a/collidertest.tcl +++ /dev/null @@ -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) -} diff --git a/cotop.tcl b/cotop.tcl deleted file mode 100644 index 3ab9294a..00000000 --- a/cotop.tcl +++ /dev/null @@ -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 -} diff --git a/countf.tcl b/countf.tcl deleted file mode 100644 index a627ae0a..00000000 --- a/countf.tcl +++ /dev/null @@ -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 - } -} diff --git a/dmc.tcl b/dmc.tcl deleted file mode 100644 index 84056e5c..00000000 --- a/dmc.tcl +++ /dev/null @@ -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 diff --git a/dmca.tcl b/dmca.tcl deleted file mode 100644 index c98fca3c..00000000 --- a/dmca.tcl +++ /dev/null @@ -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 diff --git a/dmccom.tcl b/dmccom.tcl deleted file mode 100644 index 6d20d388..00000000 --- a/dmccom.tcl +++ /dev/null @@ -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 -} \ No newline at end of file diff --git a/dmcscan.tcl b/dmcscan.tcl deleted file mode 100644 index c879e0e0..00000000 --- a/dmcscan.tcl +++ /dev/null @@ -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 - diff --git a/dmcsim.tcl b/dmcsim.tcl deleted file mode 100755 index d692fd06..00000000 --- a/dmcsim.tcl +++ /dev/null @@ -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 - diff --git a/fcircle.tcl b/fcircle.tcl deleted file mode 100644 index 74c2da32..00000000 --- a/fcircle.tcl +++ /dev/null @@ -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 -} \ No newline at end of file diff --git a/fetest.tcl b/fetest.tcl deleted file mode 100644 index 7eb15024..00000000 --- a/fetest.tcl +++ /dev/null @@ -1,4 +0,0 @@ - cscan a4 0. .2 10 2 -for {set i 0} { $i < 5} { incr i} { -count timer 200 -} diff --git a/ftest.tcl b/ftest.tcl deleted file mode 100644 index a1001324..00000000 --- a/ftest.tcl +++ /dev/null @@ -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 diff --git a/hakle.tcl b/hakle.tcl deleted file mode 100644 index 54164e56..00000000 --- a/hakle.tcl +++ /dev/null @@ -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 -} diff --git a/helium.tcl b/helium.tcl deleted file mode 100644 index 0c2a8dc3..00000000 --- a/helium.tcl +++ /dev/null @@ -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] - } -} diff --git a/inc.tcl b/inc.tcl deleted file mode 100644 index 90c2b88f..00000000 --- a/inc.tcl +++ /dev/null @@ -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] -} diff --git a/inidill.tcl b/inidill.tcl deleted file mode 100644 index 3e887fce..00000000 --- a/inidill.tcl +++ /dev/null @@ -1,4 +0,0 @@ -#dillution initialisation -evfactory new temp dillu lnsp19.psi.ch 4000 1 dilu.tem -temp lowerlimit 0 -temp upperlimit 5. diff --git a/itc4.tcl b/itc4.tcl deleted file mode 100644 index 6d5718d1..00000000 --- a/itc4.tcl +++ /dev/null @@ -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 diff --git a/nxsupport.tcl b/nxsupport.tcl deleted file mode 100644 index 29157c01..00000000 --- a/nxsupport.tcl +++ /dev/null @@ -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 -} diff --git a/object.tcl b/object.tcl deleted file mode 100755 index 7aa7e856..00000000 --- a/object.tcl +++ /dev/null @@ -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 \ - "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 -} diff --git a/optfn.tcl b/optfn.tcl deleted file mode 100644 index 95f3599f..00000000 --- a/optfn.tcl +++ /dev/null @@ -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 - - - diff --git a/optn.tcl b/optn.tcl deleted file mode 100644 index 9d912ae1..00000000 --- a/optn.tcl +++ /dev/null @@ -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] diff --git a/peaksearch.tcl b/peaksearch.tcl deleted file mode 100644 index d33ae393..00000000 --- a/peaksearch.tcl +++ /dev/null @@ -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" -} \ No newline at end of file diff --git a/psitest.tcl b/psitest.tcl deleted file mode 100644 index 1b8611a3..00000000 --- a/psitest.tcl +++ /dev/null @@ -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 -} diff --git a/sans2.tcl b/sans2.tcl deleted file mode 100644 index 1b12b091..00000000 --- a/sans2.tcl +++ /dev/null @@ -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 diff --git a/sans2com.tcl b/sans2com.tcl deleted file mode 100644 index c5e5f69d..00000000 --- a/sans2com.tcl +++ /dev/null @@ -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 -} diff --git a/sans2dis.tcl b/sans2dis.tcl deleted file mode 100644 index cd3fb092..00000000 --- a/sans2dis.tcl +++ /dev/null @@ -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 - diff --git a/sansreal.tcl b/sansreal.tcl deleted file mode 100644 index 65adce7c..00000000 --- a/sansreal.tcl +++ /dev/null @@ -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 diff --git a/servo.tcl b/servo.tcl deleted file mode 100644 index 7e843a4e..00000000 --- a/servo.tcl +++ /dev/null @@ -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 diff --git a/sicsstat.tcl b/sicsstat.tcl deleted file mode 100644 index 8f899f2d..00000000 --- a/sicsstat.tcl +++ /dev/null @@ -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 diff --git a/sicsstatus.tcl b/sicsstatus.tcl deleted file mode 100644 index c06b255e..00000000 --- a/sicsstatus.tcl +++ /dev/null @@ -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 diff --git a/sicstemplates.tcl b/sicstemplates.tcl deleted file mode 100644 index a5159572..00000000 --- a/sicstemplates.tcl +++ /dev/null @@ -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 \n" - append txt "#include \n" - append txt "#include \n" - append txt "#include \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 -} diff --git a/sinfo.tcl b/sinfo.tcl deleted file mode 100644 index c2d13bac..00000000 --- a/sinfo.tcl +++ /dev/null @@ -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" - } -} diff --git a/stest.tcl b/stest.tcl deleted file mode 100644 index a6269419..00000000 --- a/stest.tcl +++ /dev/null @@ -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 -} diff --git a/sycamore.tcl b/sycamore.tcl deleted file mode 100644 index 8d5dcbc1..00000000 --- a/sycamore.tcl +++ /dev/null @@ -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 - diff --git a/tascom.tcl b/tascom.tcl deleted file mode 100644 index b783a02a..00000000 --- a/tascom.tcl +++ /dev/null @@ -1,1177 +0,0 @@ -#--------------------------------------------------------------------------- -# In order to run a triple axis spectrometer, SICS has to be made to behave -# like the ancient MAD program from ILL. Some of the MAD commands had to -# be implemented in C (see tas*.c) but others can be implemented in Tcl. -# This file contains the procedures and command definitions for this syntax -# adaption from SICS to MAD. -# -# Mark Koennecke, December 2000, March 2001, April 2002 -#-------------------------------------------------------------------------- - - -#------------------------------------------------------------------------- -# Perform initialization, but only on first go - -if { [info exists tasinit] == 0 } { - set tasinit 1 - SicsAlias fileeval do User - Publish ou User - Publish out User - Publish fi User - SicsAlias fi fix User - Publish cl User - SicsAlias cl clear - Publish co User - Publish fm User - Publish fz User - Publish pr Spy - Publish se User - Publish lz Spy - Publish ll Spy - Publish lm Spy - Publish ls Spy - Publish le Spy - Publish lt Spy - Publish li Spy - Publish log User - Publish sz User - Publish sw User - Publish pa User - Publish on User - Publish off User -} - -#-------------------------------------------------------------------------- -# a list of motors, needed at various stages in this - -set tasmot { a1 a2 a3 a4 a5 a6 mcv sro ach mtl mtu stl stu atu mgl sgl \ - sgu agl atl} -#------------------------------------------------------------------------- -# some MAD variables can be directly mapped to internal SICS variables. -# Some others require special functions to be called for them to be set. -# These mappings are defined here through in a mapping array - -for {set i 0} {$i < [llength $tasmot]} { incr i } { - set mot [lindex $tasmot $i] - set tasmap(l$mot) [format "%s softlowerlim " $mot] - set tasmap(z$mot) [format "madZero %s " $mot] - set tasmap(u$mot) [format "%s softupperlim " $mot] -} -set tasmap(ss) "scatSense ss " -set tasmap(sa) "scatSense sa " -set tasmap(sm) "scatSense sm " -set tasmap(fx) "fxi " -for {set i 0} { $i < 8} { incr i} { - set cur [format "i%1.1d" $i] - set tasmap(l$cur) [format "%s lowerlimit " $cur] - set tasmap(u$cur) [format "%s upperlimit " $cur] -} -#---------------------------------------------------------------------- -# mapping array output for debugging -#set l [array names tasmap] -#foreach e $l { -# clientput [format " %s = %s" $e $tasmap($e)] -#} -#------------------------------------------------------------------------ -# quite often we need to split a SICS answer of the form x = y and -# extract the y. This is done here. - -proc tasSplit {text} { - set list [split $text =] - return [lindex $list 1] -} - -#---------------------------------------------------------------------- -# put an angle into 360 -proc circlify {val} { - set p $val - while {$p > 360.0} { - set p [expr $p - 360.] - } - while {$p < -360.0} { - set p [expr $p + 360.] - } - return $p -} -#------------------------------------------------------------------------- -# motor zero points are handled differently in SICS and MAD: -# - MAD zero's are of opposite sign to SICS -# - Setting a MAD zero point also changes the limits. -# This function takes care of these issues. - -proc madZero args { - set length [llength $args] - if { $length < 1} { - error "ERROR: expected at least motor name as a parameter to madZero" - } - set mot [lindex $args 0] - if {$length == 1 } { -#inquiry case - set zero [tasSplit [$mot softzero]] - return [format "madZero = %f " [expr -$zero]] - } else { -# a new value has been given. - set val [lindex $args 1] - set val [expr -$val] - set zero [tasSplit [$mot softzero]] - set low [tasSplit [$mot softlowerlim]] - set high [tasSplit [$mot softupperlim]] - set displacement [expr $val - $zero] - $mot softzero $val - $mot softupperlim [expr $high - $displacement] - $mot softlowerlim [expr $low - $displacement] - } -} - -#-------------------------------------------------------------------------- -# This routine throws an error if a bad value for fx is given - -proc fxi { {val -1000} } { - if {$val == -1000} { - return [format " fx = %d " [tasSplit [fx]] ] - } - if { $val != 1 && $val != 2} { - error "ERROR: Invalid value $val for parameter FX" - } else { - fx $val - } -} - -#------------------------------------------------------------------------- -# Changing the scattering sense has various consequences: -# for SM it is rejected as this requires a major rebuild of the guide hall. -# for SS only the parameter is changed. -# for SA - the parameter is changed -# - the A5 zero point is rotated by 180 degree -# - the lower software limit is set to the new zero point - -proc scatSense {par {val -1000} } { - if { [tasSplit $par] == $val } { - return - } - switch $par { - ss { - set mot a3 - } - sa { - set mot a5 - } - sm { - set mot a1 - } - default { - error "ERROR: unknown scattering sense $par" - } - } -#-------- inquiry case - if { $val == -1000 } { - return [eval $par] - } - if {$val != 1 && $val != -1 && $val != 0 } { - error "ERROR: invalid scattering sense $val" - } - switch $par { - sm { - error \ - "REJECTED: Pay 100 mil. swiss francs for a redesign of SINQ first" - } - ss { - $par $val - clientput [format " SS = %d" $val] - } - sa { - set oldzero [tasSplit [madZero $mot]] - set oldupper [tasSplit [$mot softupperlim]] - set oldlower [tasSplit [$mot softlowerlim]] - set oldsa [tasSplit [sa]] - if { $val == 0 && $oldsa == 1} { - set newzero [expr $oldzero - 90.] - set newlower [expr $oldlower - 90.] - set newupper [expr $oldupper - 90.] - } elseif {$val == 0 && $oldsa == -1} { - set newzero [expr $oldzero + 90.] - set newlower [expr $oldlower + 90.] - set newupper [expr $oldupper + 90.] - } elseif { $val == 1 && $oldsa == 0} { - set newzero [expr $oldzero + 90.] - set newlower [expr $oldlower + 90.] - set newupper [expr $oldupper + 90.] - } elseif { $val == -1 && $oldsa == 0} { - set newzero [expr $oldzero - 90.] - set newlower [expr $oldlower - 90.] - set newupper [expr $oldupper - 90.] - } elseif { $val == 1 && $oldsa == -1} { - set newzero [expr $oldzero + 180. ] - set newlower [expr $oldlower + 180 ] - set newupper [expr $oldupper + 180. ] - set newlower [circlify $newlower] - set newupper [circlify $newupper] - } elseif {$val == -1 && $oldsa == 1} { - set newzero [expr $oldzero - 180. ] - set newlower [expr $oldlower - 180. ] - set newupper [expr $oldupper - 180. ] - } else { - error "Unknown SA setting combination" - } - $par $val - madZero $mot $newzero - $mot softupperlim $newupper - $mot softlowerlim $newlower - } - } -} -#-------------------------------------------------------------------------- -# The output command - - -proc out args { - if {[llength $args] == 0 } { - output "" - } else { - output [join $args] - } -} -proc ou args { - if {[llength $args] == 0 } { - output "" - } else { - output [join $args] - } -} - -#-------------------------------------------------------------------------- -# typeATokenizer extracts tokens from a command string. Tokens can be -# either variable names or - indicating a series of variables. -# Returns the token value or END if the end of the string text is -# reached. Uses and updates a variable pos which indicates the current -# position in the string. - -proc typeATokenizer {text pos} { - upvar pos p - set l [string length $text] -#------- check for end - if {$p >= $l} { - return END - } -#-------- skip spaces - for {} {$p < $l} {incr p} { - set c [string index $text $p] - if {$c == "-" } { - incr p - return "-" - } - if { $c != " " && $c != "," } { - break - } - } - if {$p >= $l} { - return END - } -#---- extract token - set start $p -#---- proceed to next terminator - for {} {$p < $l} {incr p} { - set c [string index $text $p] - if { $c == " " || $c == "," || $c == "-" } { - break - } - } - set stop [expr $p - 1] - return [string range $text $start $stop] -} - -#--------------------------------------------------------------------------- -# The cl(ear) command for unfixing motors - -proc cl args { - global tasmot - if {[llength $args] == 0} { -#------ clear all fixed motors - foreach m $tasmot { - set ret [catch {tasSplit [$m fixed]} x] - if {$ret != 0 } { - continue - } - if { $x > 0 } { - clientput [format "%s unfixed" $m] - $m fixed -1 - } - } - return - } -#------ trying to clear individual fixed motors - set command [join $args] - set command [string tolower $command] - set pos 0 - set token [typeATokenizer $command $pos] - while {[string compare $token END] != 0 } { - if {$token == "-" } { - set l [llength $tasmot] -#------ handle a range, first find start - for {set start 0} {$start < $l} {incr start} { - set e [lindex $tasmot $start] - if { [string compare $e $last] == 0} { - incr start - break - } - } - if { $start >= $l} { - error [format "ERROR: %s is no motor" $last] - } -#---------- next token is range stop - set stop [typeATokenizer $command $pos] -#---------- now continue to loop until stop is found, thereby unfixing - for {set i $start} { $i < $l} {incr i} { - set e [lindex $tasmot $i] - set ret [catch {$e fixed -1} msg] - if {$ret != 0} { - error [format "ERROR: %s is no motor" $e] - } else { - clientput [format "%s unfixed" $e] - } - if {[string compare $e $stop] == 0 } { - break - } - } - } else { -#------ should be a single motor here - set last $token - set ret [catch {$token fixed -1} msg] - if {$ret != 0} { - error [format "ERROR: %s is no motor" $token] - } else { - clientput [format "%s unfixed" $token] - } - } -#------- do not forget to proceed - set token [typeATokenizer $command $pos] - } -} - -#------------------------------------------------------------------------ -# fi fix motor command - -proc fi args { - global tasmot - if {[llength $args] <= 0} { -#------ list all fixed motors - foreach m $tasmot { - set ret [catch {tasSplit [$m fixed ] } x] - if {$ret != 0 } { - continue - } - if { $x > 0 } { - clientput [format "%s fixed" $m] - } - } - return - } -#------ parse motors to fix - set command [join $args] - set command [string tolower $command] - set pos 0 - set token [typeATokenizer $command $pos] - while {[string compare $token END] != 0 } { - if {$token == "-" } { - set l [llength $tasmot] -#------ handle a range, first find start - for {set start 0} {$start < $l} {incr start} { - set e [lindex $tasmot $start] - if { [string compare $e $last] == 0} { - incr start - break - } - } - if { $start >= $l} { - error [format "ERROR: %s is no motor" $last] - } -#---------- next token is range stop - set stop [typeATokenizer $command $pos] -#---------- now continue to loop until stop is found, thereby fixing - for {set i $start} { $i < $l} {incr i} { - set e [lindex $tasmot $i] - set ret [catch {$e fixed 1} msg] - if {$ret != 0} { - error [format "ERROR: %s is no motor" $e] - } else { - clientput [format "%s fixed" $e] - } - if {[string compare $e $stop] == 0 } { - break - } - } - } else { -#------ should be a single motor here - set last $token - set ret [catch {$token fixed 1} msg] - if {$ret != 0} { - error [format "ERROR: %s is no motor" $token] - } else { - clientput [format "%s fixed" $token] - } - } -#------- do not forget to proceed - set token [typeATokenizer $command $pos] - } -} -#-------------------------------------------------------------------------- -# varToken returns the next token in a variable setting string. -# handles pos as in type A syntax above. - -proc varToken {text pos} { - upvar pos p - set l [string length $text] -#------- check for end - if {$p >= $l} { - return END - } -#-------- skip spaces - for {} {$p < $l} {incr p} { - set c [string index $text $p] - if { $c != " " && $c != "," && $c != "=" } { - break - } - } - if {$p >= $l} { - return END - } -#---- extract token - set start $p -#---- proceed to next terminator - for {} {$p < $l} {incr p} { - set c [string index $text $p] - if { $c == " " || $c == "," || $c == "=" } { - break - } - } - set stop [expr $p - 1] - return [string range $text $start $stop] -} - -#--------------------------------------------------------------------------- -# varSet parses a string containing MAD variable statements and sets the -# variables. Thereby it has to take care of mappings and special variables -# which have to be set by special functions. The only format allowed here -# are name value pairs. - -proc varSet { command } { - global tasmap - set pos 0 - set token [varToken $command $pos] - set value [varToken $command $pos] - while { [string compare $token END] != 0} { -#----- first check for special things like user, local, title etc - if { [string compare $token title] == 0 || \ - [string compare $token user] == 0 || \ - [string compare $token local] == 0 } { - eval $command - return - } -#----- now check for a numeric argument - set t [SICSType $value] - if { [string compare $t NUM] != 0 } { - error [format "ERROR: expected number for %s, got %s" \ - $token $value] - } -#------ now check for mapped variables - if { [info exists tasmap($token)] == 1} { - set ret [catch {eval $tasmap($token) $value} msg] - if { $ret != 0} { - error [format "ERROR: > %s < while setting %s" $msg $token] - } else { - clientput [format " %s = %s" $token $value] - } - } else { - set ret [catch {eval $token $value} msg] - if { $ret != 0 } { - error [format "ERROR: error %s while setting %s" $msg $token] - } else { - clientput [format " %s = %s" $token $value] - } - } - set token [varToken $command $pos] - set value [varToken $command $pos] - } - catch {updateqe} msg -} -#-------------------------------------------------------------------------- -# co for count is the funny MAD count procedure. Please note, that the -# count mode is automatically set through the last MN or TI variable. - -proc co args { -#------ set variables if present at command line - if { [llength $args] > 0 } { - set com [join $args] - varSet $com - } -#---- done this, now count - set f [tasSplit [counter getpreset]] - set ret [catch {eval counter count $f } msg] - if {$ret != 0} { - error $msg - } -#----- format output - set cts [tasSplit [counter getcounts]] - set m1 [tasSplit [counter getmonitor 1]] - set m2 [tasSplit [counter getmonitor 2]] - set m3 [tasSplit [counter getmonitor 3]] - return [format " Counts = %8d, M1 = %8d, M2 = %8d, M3 = %8d" \ - $cts $m1 $m2 $m3] -} - -#---------------------------------------------------------------------------- -# fm or FindMaximum: does a scan, then proceeds to find the maximum -# of the peak and drives the first scan variable to the maximum. - -proc fm args { -#------ do the scan first - append com "sc " [ join $args] - set ret [catch {eval $com} msg] - if { $ret != 0 } { - error $msg - } -# iscan simscan 15 .3 1000 -#----- calculate the center - set ret [catch {eval peak value} msg] - if { $ret != 0 } { - error $msg - } - if { [string first "WARN" $msg ] >= 0 } { - error [format "ERROR: failed to find peak: %s" $msg] - } - set val $msg -#------ find variable and drive to center - set temp [iscan getvardata 0] - set start [string first "." $temp] - incr start - set stop [string first "=" $temp] - incr stop -1 - set var [string range $temp $start $stop] - set ret [catch {eval dr $var $val} msg] - if { $ret != 0 } { - error $msg - } -} - -#------------------------------------------------------------------------ -# fz does almost the same as fm, but also sets the current position to be -# the zeropoint after driving - -proc fz args { -#------ do the scan first - append com "sc " [ join $args] - set ret [catch {eval $com} msg] - if { $ret != 0 } { - error $msg - } - iscan simscan 15 .3 1000 -#----- calculate the center - set ret [catch {eval peak value} msg] - if { $ret != 0 } { - error $msg - } - if { [string first "WARN" $msg ] >= 0 } { - error [format "ERROR: failed to find peak: %s" $msg] - } - set val $msg -#------ find variable and drive to center - set temp [iscan getvardata 0] - set start [string first "." $temp] - incr start - set stop [string first "=" $temp] - incr stop -1 - set var [string range $temp $start $stop] - set ret [catch {eval dr $var $val} msg] - if { $ret != 0 } { - error $msg - } -#------- now do zero point - set temp [eval $var hardposition] - set newZero [tasSplit $temp] - madZero [string trim $var] [expr -$newZero] -} - -#-------------------------------------------------------------------------- -# pr(int) values of variables - -proc pr args { - global tasmap - set line [join $args] - set line [string tolower $line] - set pos 0 - set token [varToken $line $pos] - while { [string compare $token END] != 0 && \ - [string compare $token end] != 0 } { -#-------- check for mapped values first - if { [info exists tasmap($token)] == 1 } { - set val [tasSplit [eval $tasmap($token)]] - clientput [format " %s = %s" $token $val] - } else { -#------ simple variables go here - set val [tasSplit [$token] ] - clientput [format " %s = %s" $token $val] - } - set token [varToken $line $pos] - } -} - -#------------------------------------------------------------------------- -# se(t) variables - -proc se args { -#------- is it the only command line case? - if {[llength $args] > 0 } { - set line [join $args] - return [varSet $line] - } else { -#------- we are prompting - while { 1== 1} { -#-------- check for error - set line [sicsprompt "SET> "] - if { [string first ERROR $line] >= 0} { - error $line - } -#-------- check for end - if { [string length $line] < 4 } { - return - } -#------- OK, evaluate the line - set ret [catch {varSet $line} msg] - if {$ret != 0} { - clientput $msg - } - } - } -} - -#--------------------------------------------------------------------------- -# lz list limits and zeros, ll is the same - -proc ll args { - return lz $args -} - -proc lz args { - global tasmap - global tasmot -#--------- do header - append outPut [format " Limits & Zeros\n"] - append outPut [format " ===============\n"] - append outPut [format " Lo(hard) Lo(soft) Posn%s" \ - " Hi(soft) Hi(hard) Zero\n"] -#--------- do motors - set count 0 - foreach mot $tasmot { - set zero [tasSplit [madZero $mot]] - set loh [tasSplit [eval $mot hardlowerlim]] - set loh [expr $loh + $zero] - set los [tasSplit [eval $mot softlowerlim]] - set pos [tasSplit [eval $mot]] - set his [tasSplit [eval $mot softupperlim]] - set hih [tasSplit [eval $mot hardupperlim]] - set hih [expr $hih + $zero] - append outPut [format "%-10s %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \ - $mot $loh $los $pos $his $hih $zero] - incr count - if { $count == 6 } { - append outPut " \n" - } - } - return $outPut -} - -#-------------------------------------------------------------------------- -# lm list machine parameters - -proc lm args { - append output " Machine Parameters\n" - append output " ==================\n" -#----------- first line - append output [format " DM DA SM SS%s\n" \ - " SA ALF1 ALF2 ALF3 ALF4"] - set v1 [tasSplit [eval DM]] - set v2 [tasSplit [eval DA]] - set v3 [tasSplit [eval SM]] - set v4 [tasSplit [eval SS]] - set v5 [tasSplit [eval SA]] - set v6 [tasSplit [eval ALF1]] - set v7 [tasSplit [eval ALF2]] - set v8 [tasSplit [eval ALF3]] - set v9 [tasSplit [eval ALF4]] - append output [format \ - " %8.4f %8.4f %9d %9d %9d %8.3f %8.3f %8.3f %8.3f\n"\ - $v1 $v2 $v3 $v4 $v5 $v6 $v7 $v8 $v9] -#--------- second line - append output [format " BET1 BET2 BET3 BET4%s\n" \ - " ETAM ETAA FX NP TI"] - set v1 [tasSplit [eval BET1]] - set v2 [tasSplit [eval BET2]] - set v3 [tasSplit [eval BET3]] - set v4 [tasSplit [eval BET4]] - set v5 [tasSplit [eval ETAM]] - set v6 [tasSplit [eval ETAA]] - set v7 [tasSplit [eval FX]] - set v8 [tasSplit [eval NP]] - set v9 [tasSplit [eval TI]] - append output [format \ - " %8.3f %8.3f %8.3f %8.3f %8.3f %8.3f %9f %9f %8.0f\n"\ - $v1 $v2 $v3 $v4 $v5 $v6 $v7 $v8 $v9] -#---------- third line - append output [format " MN IF1V IF2H HELM\n"] - set v1 [tasSplit [eval MN]] - set v2 [tasSplit [eval IF1V]] - set v3 [tasSplit [eval IF2H]] - set v4 [tasSplit [eval HELM]] - append output [format \ - " %8.0f %8.4f %8.4f %8.4f\n"\ - $v1 $v2 $v3 $v4] - return $output -} - -#--------------------------------------------------------------------------- -# ls list sample parameters -proc ls args { - append output " Sample Parameters\n" - append output " =================\n" -#----------- first line - append output [format " AS BS CS AA%s\n" \ - " BB CC ETAS"] - set v1 [tasSplit [eval AS]] - set v2 [tasSplit [eval BS]] - set v3 [tasSplit [eval CS]] - set v4 [tasSplit [eval AA]] - set v5 [tasSplit [eval BB]] - set v6 [tasSplit [eval CC]] - set v7 [tasSplit [eval ETAS]] - append output [format \ - " %8.4f %8.4f %8.4f %8.3f %8.3f %8.3f %8.3f\n"\ - $v1 $v2 $v3 $v4 $v5 $v6 $v7] -#--------- second line - append output [format " AX AY AZ BX%s\n" \ - " BY BZ"] - set v1 [tasSplit [eval AX]] - set v2 [tasSplit [eval AY]] - set v3 [tasSplit [eval AZ]] - set v4 [tasSplit [eval BX]] - set v5 [tasSplit [eval BY]] - set v6 [tasSplit [eval BZ]] - append output [format \ - " %8.3f %8.3f %8.3f %8.3f %8.3f %8.3f\n"\ - $v1 $v2 $v3 $v4 $v5 $v6] - - return $output -} - -#--------------------------------------------------------------------------- -# le --> list energy - -proc le args { - set un [swunit] - if { $un == 1} { - append output " Energy Units Thz\n" - } else { - append output " Energy Units Mev\n" - } - append output " ================\n" - append output [format " EI KI EF%s\n" \ - " KF QH QK QL"] - set v1 [tasSplit [ei]] - set v2 [tasSplit [ki]] - set v3 [tasSplit [ef]] - set v4 [tasSplit [kf]] - set v5 [tasSplit [qh]] - set v6 [tasSplit [qk]] - set v7 [tasSplit [ql]] - set val [format " %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f \n" \ - $v1 $v2 $v3 $v4 $v5 $v6 $v7] - set v1 [tasSplit [tei]] - set v2 [tasSplit [tki]] - set v3 [tasSplit [tef]] - set v4 [tasSplit [tkf]] - set v5 [tasSplit [tqh]] - set v6 [tasSplit [tqk]] - set v7 [tasSplit [tql]] - set val2 [format " %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f %9.4f \n" \ - $v1 $v2 $v3 $v4 $v5 $v6 $v7] - append output [format "POSN: %s" $val] - append output [format "TARG: %s" $val2] - append output [format " EN QM\n"] - set v1 [tasSplit [en]] - set v2 [tasSplit [qm]] - set val [format " %9.4f %9.4f\n" $v1 $v2] - set v1 [tasSplit [ten]] - set v2 [tasSplit [tqm]] - set val2 [format " %9.4f %9.4f\n" $v1 $v2] - append output [format "POSN: %s" $val] - append output [format "TARG: %s" $val2] - - return $output -} - -#----------------------------------------------------------------------- -# fmtMot formats a motors parameters in order to fit the format for -# the list targets commands - -proc fmtMot mot { - set zero [tasSplit [madZero $mot]] - set pos [tasSplit [$mot]] - set target [expr [tasSplit [eval $mot target]] + $zero] - if { [tasSplit [eval $mot fixed]] < 0} { - set fix " " - } else { - set fix "f" - } - set txt [format "%-7s%1s %7.2f %7.2f %7.2f" $mot $fix $pos $target \ - $zero] - return $txt -} -#------------------------------------------------------------------------- -# lt --> list targets - -proc lt args { - append output " Positions and Targets \n" - append output " ===================== \n" - append output [format " Posn Targ Zero %s" \ - " Posn Targ Zero\n"] - append output [format "%s | %s\n" \ - [fmtMot A1] " "] - append output [format "%s | %s\n" \ - [fmtMot A2] [fmtMot ATL]] - append output [format "%s | %s\n" \ - [fmtMot A3] [fmtMot ATU] ] - append output [format "%s | %s\n" \ - [fmtMot A4] " " ] - append output [format "%s | %s\n" \ - [fmtMot A5] [fmtMot MGL] ] - append output [format "%s | %s\n" \ - [fmtMot A6] [fmtMot SGL] ] - append output [format "%s | %s\n" \ - [fmtMot MCV] [fmtMot SGU] ] - append output [format "%s | %s\n" \ - [fmtMot SRO] " " ] - append output [format "%s | %s\n" \ - [fmtMot ACH] [fmtMot AGL] ] - append output [format "%s | %s\n" \ - [fmtMot MTL] " " ] - append output [format "%s | %s\n" \ - [fmtMot MTU] " " ] - return $output -} - -#-------------------------------------------------------------------------- -# li --> list everything - -proc li args { - clientput [lm] - clientput [ls] - clientput [lz] - clientput [lt] - clientput [le] -} - -#----------------------------------------------------------------------- -# make a new log file name for log -proc makeLog args { - set tim [sicstime] - set l [split $tim] - set l2 [split [lindex $l 1] ":"] - set nam [format "madsics-%s@%s-%s-%s.log" [lindex $l 0] \ - [lindex $l2 0] [lindex $l2 1] [lindex $l2 2]] - return $nam -} -#------------------------------------------------------------------------- -# log the logging control command - -set madlog disabled - -proc log args { - global madlog -#------ no args, just print status - if { [ llength $args] == 0 } { - if { [string compare $madlog disabled] == 0 } { - return "Logging is disabled" - } else { - return [format "Logging to %s" $madlog] - } - } -#------args, action according to keyword - set key [string tolower [lindex $args 0]] - switch $key { - new { - set madlog [makeLog] - commandlog new $madlog - } - start { - set madlog [makeLog] - commandlog new $madlog - } - close { - commandlog close - set madlog disabled - } - default { - append output "Log understands: \n" - append output "\tLog new : new logfile\n" - append output "\tLog start : start logging\n" - append output "\tLog close : stop logging\n" - return $output - } - } -} - -#-------------------------------------------------------------------------- -# sz -->setzero - -proc sz args { - global tasmot - set usage "\n Usage: \n\t sz motor newval \n" - set line [string tolower [join $args]] - set pos 0 - set mot [varToken $line $pos] - set val [varToken $line $pos] - if { [lsearch $tasmot $mot] < 0 } { - error [format "ERROR: %s is no motor\n %s" $mot $usage] - } - if { [string compare [SICStype $val] NUM ] != 0 } { - error [format "ERROR: expected number, got %s \n%s" $val $usage] - } -#-------- output, output, output......... - append output [format "Values : Lo(hard) Lo(soft) Posn%s" \ - " Target Hi(soft) Hi(hard) Zero\n"] - set zero [tasSplit [madZero $mot]] - set loh [tasSplit [eval $mot hardlowerlim]] - set loh [expr $loh + $zero] - set los [tasSplit [eval $mot softlowerlim]] - set pos [tasSplit [eval $mot]] - set his [tasSplit [eval $mot softupperlim]] - set hih [tasSplit [eval $mot hardupperlim]] - set hih [expr $hih + $zero] - set targ [expr [tasSplit [eval $mot target]] + $zero] - append output [format \ - "%-8sOld: %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \ - $mot $loh $los $pos $targ $his $hih $zero] -#-------action - madZero $mot $val - catch {updateqe} msg -#-------- more output - set zero [tasSplit [madZero $mot]] - set loh [tasSplit [eval $mot hardlowerlim]] - set loh [expr $loh + $zero] - set los [tasSplit [eval $mot softlowerlim]] - set pos [tasSplit [eval $mot]] - set his [tasSplit [eval $mot softupperlim]] - set hih [tasSplit [eval $mot hardupperlim]] - set hih [expr $hih + $zero] - set targ [expr [tasSplit [eval $mot target]] + $zero] - append output [format \ - " New: %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f %8.2f\n" \ - $loh $los $pos $targ $his $hih $zero] - return $output -} -#--------------------------------------------------------------------------- -# switches and the sw command - -#-------------------------------------------------------------------------- -# powdersw deals with the powder switch - -set powder 0 - -proc powdersw args { - global powder - if { [llength $args] > 0 } { - switch [lindex $args 0] { - on { - as 6.28 - cs 6.28 - bs 6.28 - aa 90. - bb 90. - cc 90. - a3 fixed 1 - set powder 1 - return "Q now in reverse Angstroem" - } - off { - set powder 0 - a3 fixed -1 - } - flip { - if {$powder == 1 } { - return [powdersw off] - } else { - return [powdersw on] - } - } - default { - error "ERROR: syntax error, only on, off, flip allowed" - } - } - } else { - if { $powder == 1} { - return [format " %-30s : %-5s" "Powder Mode" "on"] - } else { - return [format " %-30s : %-5s" "Powder Mode" "off"] - } - } -} -#---------------------------------------------------------------------- -# switch polarisation -proc polsw args { - if { [llength $args] > 0 } { - switch [lindex $args 0] { - on { - lpa 1 - return "Polarisation mode enabled" - } - off { - lpa 0 - set ret [catch {run i1 0} msg] - set ret [catch {run i2 0} msg] - set ret [catch {run i3 0} msg] - set ret [catch {run i4 0} msg] - set ret [catch {run i5 0} msg] - set ret [catch {run i6 0} msg] - return "Polarisation mode disabled" - } - flip { - if {[tasSplit [lpa]] == 1 } { - return [polsw off] - } else { - return [polsw on] - } - } - default { - error "ERROR: syntax error, only on, off, flip allowed" - } - } - } else { - if { [tasSplit [lpa]] == 1} { - return [format " %-30s : %-5s" "Polarisation Mode" "on"] - } else { - return [format " %-30s : %-5s" "Polarisation Mode" "off"] - } - } -} - -#----------------------------------------------------------------------- -# mapping switches to procedures handling them - -set switches(powder) powdersw -set switches(pol) polsw - -#------------------------------------------------------------------------ -# prsw prints switches -proc prsw args { - global switches - set l [array names switches] - foreach e $l { - append output [eval $switches($e)] "\n" - } - return $output -} - -#-------------------------------------------------------------------------- -# sw --> the switches command - - - -proc sw args { - global switches - set swlist [array names switches] - set maxsw [llength $swlist] -#------- no args - if { [llength $args] <= 0 } { - clientput [prsw] - set line [sicsprompt "Switch number? : "] - while { [string length $line] > 1 } { - set ret [catch {expr $line - 1} num] - if { $ret != 0 } { - error [format "ERROR: expected number, got %s" \ - $line] - } - if {$num >= $maxsw} { - error "ERROR: switch number out of bounds" - } - if { $num < 0} { - return [prsw] - } - clientput [eval $switches([lindex $swlist $num]) flip] - clientput [prsw] - set line [sicsprompt "Switch number? "] - } - } else { -#-------- direct on command line - set line [join $args] - set pos 0 - set sw [varToken $line $pos] - set op [varToken $line $pos] - while { [string compare $sw END] != 0 } { - set ret [catch {expr $sw - 1} num] - if { $ret != 0 } { - error [format "ERROR: expected number, got %s" \ - $sw] - } - if { $num >= $maxsw || $num < 0 } { - error "ERROR: switch number out of bounds" - } - clientput [eval $switches([lindex $swlist $num]) $op] - set sw [varToken $line $pos] - set op [varToken $line $pos] - } - clientput [prsw] - } -} -#--------------------------------------------------------------------------- -# pa : set polarization analysis file -#-------------------------------------------------------------------------- -proc pa args { - if {[llength $args] < 1} { - error "Usage: pa polarisation analysis file" - } - set fil [lindex $args 0] - if {[string first "." $fil] < 0} { - set fil $fil.pal - } - polfile $fil -} -#-------------------------------------------------------------------------- -# on and off for switching spin flippers -#------------------------------------------------------------------------- -proc checkarg args { - if {[llength $args] < 1} { - error "No flipper to set given" - } - set flipper [string trim [string tolower [lindex $args 0]]] - if { [string compare $flipper f1] == 0 || \ - [string compare $flipper f2] == 0} { - return $flipper - } else { - error [format "%s not a recognized flipper" $flipper] - } -} -#------------------------------------------------------------------------ -proc on args { - set flip [checkarg $args] - if { [string compare $flip f1] == 0 } { - f1 1 - set i1val [expr [tasSplit [tki]] * [tasSplit [if1h]]] - set i2val [tasSplit [if1v]] - return [dr i1 $i1val i2 $i2val] - } else { - f2 1 - set i3val [expr [tasSplit [tkf]] * [tasSplit [if2h]]] - set i4val [tasSplit [if2v]] - return [dr i3 $i3val i4 $i4val] - } -} -#------------------------------------------------------------------------- -proc off args { - set flip [checkarg $args] - if { [string compare $flip f1] == 0 } { - f1 0 - return [dr i1 .0 i2 .0] - } else { - f2 0 - return [dr i3 .0 i4 .0] - } -} diff --git a/tasregress.tcl b/tasregress.tcl deleted file mode 100644 index 5582296a..00000000 --- a/tasregress.tcl +++ /dev/null @@ -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 diff --git a/tassim.tcl b/tassim.tcl deleted file mode 100644 index b60ac3d6..00000000 --- a/tassim.tcl +++ /dev/null @@ -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 - - - - - diff --git a/tastest.tcl b/tastest.tcl deleted file mode 100644 index bbcf6018..00000000 --- a/tastest.tcl +++ /dev/null @@ -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 - - - - - diff --git a/tclvarex.tcl b/tclvarex.tcl deleted file mode 100644 index 7fc15093..00000000 --- a/tclvarex.tcl +++ /dev/null @@ -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 - diff --git a/tdir.tcl b/tdir.tcl deleted file mode 100644 index c07eb09e..00000000 --- a/tdir.tcl +++ /dev/null @@ -1,5 +0,0 @@ -for {set i 0} { $i < 3000} {incr i} { - ClientPut "Hello you" -} -ClientPut "I'am finished" -ClientPut [sicstime] diff --git a/test.tcl b/test.tcl deleted file mode 100644 index ca221667..00000000 --- a/test.tcl +++ /dev/null @@ -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] -} diff --git a/testj.tcl b/testj.tcl deleted file mode 100644 index da68ec84..00000000 --- a/testj.tcl +++ /dev/null @@ -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 \ No newline at end of file diff --git a/topsir.tcl b/topsir.tcl deleted file mode 100644 index cb5edb06..00000000 --- a/topsir.tcl +++ /dev/null @@ -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 - diff --git a/topsirr.tcl b/topsirr.tcl deleted file mode 100644 index fc872b41..00000000 --- a/topsirr.tcl +++ /dev/null @@ -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 diff --git a/transact.tcl b/transact.tcl deleted file mode 100644 index 03fbe8de..00000000 --- a/transact.tcl +++ /dev/null @@ -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; -} diff --git a/trics.tcl b/trics.tcl deleted file mode 100644 index af1402f8..00000000 --- a/trics.tcl +++ /dev/null @@ -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" diff --git a/tscan.tcl b/tscan.tcl deleted file mode 100644 index e2f0fa9d..00000000 --- a/tscan.tcl +++ /dev/null @@ -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 -} \ No newline at end of file diff --git a/ttest.tcl b/ttest.tcl deleted file mode 100644 index 6f4b0dfb..00000000 --- a/ttest.tcl +++ /dev/null @@ -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 - diff --git a/viscom.tcl b/viscom.tcl deleted file mode 100755 index ee4e652d..00000000 --- a/viscom.tcl +++ /dev/null @@ -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 InputSelect - bind .input.libo.liste 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 TextInput - bind .input.entry TextInput - bind .input.entry InputBack - bind .input.entry InputBack -# bind .input.entry { 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 - diff --git a/volist.tcl b/volist.tcl deleted file mode 100644 index ce4d945d..00000000 --- a/volist.tcl +++ /dev/null @@ -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 diff --git a/xy.tcl b/xy.tcl deleted file mode 100644 index 8b073508..00000000 --- a/xy.tcl +++ /dev/null @@ -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