From 810a3cbd94b3dde0cb0cbc03d6f2cea89ae93e37 Mon Sep 17 00:00:00 2001 From: Mark Koennecke Date: Tue, 18 Feb 2014 16:41:37 +0100 Subject: [PATCH] Cleanup of the repository before pushing to gitorious Refs #201 --- 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 ----- tcl/astrium.tcl | 527 ------- tcl/bgerror.tcl | 8 - tcl/client.tcl | 151 -- tcl/count.tcl | 54 - tcl/deltatau.tcl | 356 ----- tcl/el737sec.tcl | 314 ---- tcl/el755.tcl | 97 -- tcl/fit.tcl | 52 - tcl/ldAout.tcl | 228 --- tcl/lof.tcl | 90 -- tcl/log.tcl | 84 -- tcl/nhq202m.tcl | 145 -- tcl/nvs.tcl | 157 -- tcl/nvs20m.tcl | 163 --- tcl/parray.tcl | 29 - tcl/pfeiffer.tcl | 138 -- tcl/phytron.tcl | 302 ---- tcl/pimotor.tcl | 156 -- tcl/reflist.tcl | 79 - tcl/scan.tcl | 74 - tcl/scancom.tcl | 542 ------- tcl/secsim.tcl | 66 - tcl/sicstcldebug.tcl | 74 - tcl/simhm.tcl | 91 -- tcl/sinqhttp.tcl | 152 -- tcl/slsecho.tcl | 293 ---- tcl/stddrive.tcl | 100 -- tcl/stdin.tcl | 23 - tcl/susca.tcl | 62 - tcl/table.tcl | 317 ---- tcl/tail.tcl | 12 - tcl/topsiold.tcl | 772 ---------- tcl/wwwpulver.tcl | 43 - tclvarex.tcl | 57 - tdir.tcl | 5 - test.tcl | 504 ------- testj.tcl | 7 - tmp/all.hkl | 3013 --------------------------------------- tmp/amorset.tcl | 27 - tmp/batchedtest.tcl | 51 - tmp/bbtest.tst | 51 - tmp/btest.tst | 51 - tmp/bug.lis | 74 - tmp/hdbscan.tcl | 9 - tmp/li-reduced.ub | 25 - tmp/m2t_generator | 85 -- tmp/rafin.bck | 9 - tmp/rafin.dat | 21 - tmp/rafin.out | Bin 8467 -> 0 bytes tmp/rafin.out.bck | Bin 8467 -> 0 bytes tmp/sev.go | 3 - tmp/shell80.go | 8 - tmp/standard-reduced.go | 7 - tmp/t.go | 2 - tmp/table.res | 18 - tmp/taspstatus.tcl | 637 --------- tmp/tasubstat.tcl | 264 ---- tmp/tricsstatus.tcl | 855 ----------- 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 - 112 files changed, 20155 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 tcl/astrium.tcl delete mode 100755 tcl/bgerror.tcl delete mode 100755 tcl/client.tcl delete mode 100644 tcl/count.tcl delete mode 100644 tcl/deltatau.tcl delete mode 100644 tcl/el737sec.tcl delete mode 100644 tcl/el755.tcl delete mode 100644 tcl/fit.tcl delete mode 100644 tcl/ldAout.tcl delete mode 100644 tcl/lof.tcl delete mode 100644 tcl/log.tcl delete mode 100644 tcl/nhq202m.tcl delete mode 100644 tcl/nvs.tcl delete mode 100644 tcl/nvs20m.tcl delete mode 100644 tcl/parray.tcl delete mode 100644 tcl/pfeiffer.tcl delete mode 100644 tcl/phytron.tcl delete mode 100644 tcl/pimotor.tcl delete mode 100644 tcl/reflist.tcl delete mode 100644 tcl/scan.tcl delete mode 100644 tcl/scancom.tcl delete mode 100644 tcl/secsim.tcl delete mode 100644 tcl/sicstcldebug.tcl delete mode 100644 tcl/simhm.tcl delete mode 100644 tcl/sinqhttp.tcl delete mode 100644 tcl/slsecho.tcl delete mode 100644 tcl/stddrive.tcl delete mode 100644 tcl/stdin.tcl delete mode 100644 tcl/susca.tcl delete mode 100644 tcl/table.tcl delete mode 100644 tcl/tail.tcl delete mode 100644 tcl/topsiold.tcl delete mode 100644 tcl/wwwpulver.tcl delete mode 100644 tclvarex.tcl delete mode 100644 tdir.tcl delete mode 100644 test.tcl delete mode 100644 testj.tcl delete mode 100644 tmp/all.hkl delete mode 100644 tmp/amorset.tcl delete mode 100644 tmp/batchedtest.tcl delete mode 100644 tmp/bbtest.tst delete mode 100644 tmp/btest.tst delete mode 100644 tmp/bug.lis delete mode 100644 tmp/hdbscan.tcl delete mode 100644 tmp/li-reduced.ub delete mode 100755 tmp/m2t_generator delete mode 100644 tmp/rafin.bck delete mode 100644 tmp/rafin.dat delete mode 100644 tmp/rafin.out delete mode 100644 tmp/rafin.out.bck delete mode 100644 tmp/sev.go delete mode 100644 tmp/shell80.go delete mode 100644 tmp/standard-reduced.go delete mode 100644 tmp/t.go delete mode 100644 tmp/table.res delete mode 100644 tmp/taspstatus.tcl delete mode 100644 tmp/tasubstat.tcl delete mode 100644 tmp/tricsstatus.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 e0e73b14..00000000 --- a/object.tcl +++ /dev/null @@ -1,305 +0,0 @@ -# -# $Id: object.tcl,v 1.1 2000/02/25 16:21:41 cvs Exp $ -# -# 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/tcl/astrium.tcl b/tcl/astrium.tcl deleted file mode 100644 index 3959ae79..00000000 --- a/tcl/astrium.tcl +++ /dev/null @@ -1,527 +0,0 @@ -#-------------------------------------------------------------- -# This is a new style driver for the Astrium chopper systems in -# the new sicsobj/scriptcontext based system. Please note that -# actual implementations may differ in the number of choppers -# and the address of the chopper on the network. -# -# copyright: see file COPYRIGHT -# -# SCRIPT CHAINS: -# - reading parameters: -# astchopread - readastriumchopperpar - readastriumchopperpar - ... -# - writing -# astchopwrite - astchopwritereply -# -# Another remark: -# In order for chosta to work properly, the chopperparlist and -# chopperlonglist must be aligned. -# -# Mark Koennecke, February 2009 -# -# If something goes wrong with this, the following things ought -# to be checked: -# - Is the standard Tcl scan command been properly renamed to stscan? -# - Is a communication possible with the chopper via telnet? -# This may not be the case because of other SICS servers blocking -# things or the old driver being active and capturing the terminal -# server port in SerPortServer. Scriptcontext then fails silently. -# But may be we will fix the latter. -# - The other thing which happens is that the parameter list of -# the chopper differs in little ways between instances. -# -# Mark Koennecke, April 2009 -#-------------------------------------------------------------- -MakeSICSObj choco AstriumChopper -#------------------------------------------------------------- -proc astriumchopperputerror {txt} { - global choppers chopperparlist - foreach chopper $choppers { - foreach par $chopperparlist { - set path /sics/choco/${chopper}/${par} - hsetprop $path geterror $txt - } - } -} -#-------------------------------------------------------------- -# Paramamters look like: name value, entries for parameters are -# separated by ; -#--------------------------------------------------------------- -proc astriumsplitreply {chopper reply} { - set parlist [split [string trim $reply] ";"] - foreach par $parlist { - catch {stscan $par "%s %s" token val} count - if {[string first ERROR $count] < 0 && $count == 2} { - set val [string trim $val] - set token [string trim $token] - catch {hupdate /sics/choco/${chopper}/${token} $val} - catch {hdelprop /sics/choco/${chopper}/${token} geterror} - } else { -#-------- special fix for dphas and averl - if {[string first dphas $par] >= 0} { - set val [string range $par 5 end] - if {$val > 360} { - set val [expr $val -360.] - } - hupdate /sics/choco/${chopper}/dphas $val - hdelprop /sics/choco/${chopper}/dphas geterror - } - if {[string first averl $par] >= 0} { - set val [string range $par 5 end] - hupdate /sics/choco/${chopper}/averl $val - hdelprop /sics/choco/${chopper}/averl geterror - } - } - } -} -#------------------------------------------------------------- -# update those parameters which are dependent on the chopper -# status just read. Some of them may or may not be there, this -# is why this is protected by catch'es. -#------------------------------------------------------------- -proc astcopydependentpar {} { - global choppers - foreach chop $choppers { - set val [hval /sics/choco/${chop}/aspee] - catch {hupdate /sics/choco/${chop}/speed $val} - set val [hval /sics/choco/${chop}/nphas] - set dp [hval /sics/choco/${chop}/dphas] - set val [expr $val + $dp] - catch {hupdate /sics/choco/${chop}/phase $val} - } -} -#-------------------------------------------------------------- -proc readastriumchopperpar {} { - global choppers - set reply [sct result] - if {[string first ERR $reply] >= 0} { - astriumchopperputerror $reply - return idle - } - if {[string first "not valid" $reply] >= 0 } { - astriumchopperputerror "ERROR: chopper responded with not valid" - return idle - } - set count [sct replycount] - if {$count == -1} { - sct send @@NOSEND@@ - sct replycount 0 - hupdate /sics/choco/asyst "" - hdelprop /sics/choco/asyst geterror - return astchoppar - } else { - set oldval [hval /sics/choco/asyst] - hupdate /sics/choco/asyst "$oldval $reply" - astriumsplitreply [lindex $choppers $count] $reply - incr count - sct replycount $count - if {$count < [llength $choppers] } { - sct send @@NOSEND@@ - return astchoppar - } else { - astcopydependentpar - return idle - } - } -} -#-------------------------------------------------------------- -proc astchopread {} { - sct send "asyst 1" - sct replycount -1 - return astchoppar -} -#--------------------------------------------------------------- -proc astriumMakeChopperParameters {} { - global choppers chopperparlist - foreach chopper $choppers { - hfactory /sics/choco/${chopper} plain spy none - foreach par $chopperparlist { - set path /sics/choco/${chopper}/${par} - hfactory $path plain internal text - chocosct connect $path - } - } - hfactory /sics/choco/asyst plain user text - hsetprop /sics/choco/asyst read astchopread - hsetprop /sics/choco/asyst astchoppar readastriumchopperpar - hfactory /sics/choco/stop plain user int - chocosct poll /sics/choco/asyst 60 -#--------- This is for debugging -# chocosct poll /sics/choco/asyst 10 -} -#=================== write support ============================== -proc astchopwrite {prefix} { - set val [sct target] - sct send "$prefix $val" - sct writestart 1 - hupdate /sics/choco/stop 0 - return astchopwritereply -} -#---------------------------------------------------------------- -# Make sure to send a status request immediatly after a reply in -# order to avoid timing problems -#---------------------------------------------------------------- -proc astchopwritereply {} { - set reply [sct result] - if {[string first ERR $reply] >= 0} { - sct print $reply - hupdate /sics/choco/stop 1 - return idle - } - if {[string first "chopper error" $reply] >= 0} { - sct print "ERROR: $reply" - hupdate /sics/choco/stop 1 - return idle - } - if {[string first "not valid" $reply] >= 0 } { - sct print "ERROR: chopper responded with not valid" - hupdate /sics/choco/stop 1 - return idle - } - set state [sct writestart] - if {$state == 1} { - sct writestart 0 - sct send "asyst 1" - sct replycount -1 - return astchopwritereply - } else { - set status [readastriumchopperpar] - if {[string first idle $status] >= 0} { - return idle - } else { - return astchopwritereply - } - } -} -#-------------------------------------------------------------------- -proc astchopcompare {path1 path2 delta} { - set v1 [hval $path1] - set v2 [hval $path2] - if {abs($v1 - $v2) < $delta} { - return 1 - } else { - return 0 - } -} -#-------------------------------------------------------------------- -proc astchopcheckspeed {chopper} { - set stop [hval /sics/choco/stop] - if {$stop == 1} { - return fault - } - chocosct queue /sics/choco/asyst progress read - set tg [sct target] - set p1 /sics/choco/${chopper}/nspee - set p2 /sics/choco/${chopper}/aspee - set tst [astchopcompare $p1 $p2 50] - if {$tst == 1 } { - wait 1 - return idle - } else { - return busy - } -} -#--------------------------------------------------------------------- -proc astchopcheckphase {chopper} { - set stop [hval /sics/choco/stop] - if {$stop == 1} { - return fault - } - chocosct queue /sics/choco/asyst progress read - set p2 [hval /sics/choco/${chopper}/dphas] - if {abs($p2) < .03} { - wait 15 - return idle - } else { - return busy - } -} -#--------------------------------------------------------------------- -proc astchopcheckratio {} { - global choppers - set stop [hval /sics/choco/stop] - if {$stop == 1} { - return fault - } - set ch1 [lindex $choppers 0] - set ch2 [lindex $choppers 1] - chocosct queue /sics/choco/asyst progress read - set p1 [hval /sics/choco/${ch1}/aspee] - set p2 [hval /sics/choco/${ch2}/aspee] - set target [sct target] - if {$p2 < 10} { - return busy - } - if {abs($p1/$p2 - $target*1.) < .3} { - set tst 1 - } else { - set tst 0 - } - if {$tst == 1 } { - wait 1 - return idle - } else { - return busy - } -} -#---------------------------------------------------------------------- -proc astchopstop {} { - sct print "No real way to stop choppers but I will release" - sct send @@NOSEND@@ - hupdate /sics/choco/stop 1 - return idle -} -#--------------------------------------------------------------------- -proc astspeedread {chopper} { - set val [hval /sics/choco/${chopper}/aspee] - sct update $val - sct send @@NOSEND@@ - return idle -} -#--------------------------------------------------------------------- -proc astchopspeedlimit {chidx} { - global choppers maxspeed - set chname [lindex $choppers $chidx] - set val [sct target] - if {$val < 0 || $val > $maxspeed} { - error "Desired chopper speed out of range" - } - if {$chidx > 0} { - set state [hval /sics/choco/${chname}/state] - if {[string first async $state] < 0} { - error "Chopper in wrong state" - } - } - return OK -} -#---------------------------------------------------------------------- -proc astMakeChopperSpeed1 {var} { - global choppers - set ch [lindex $choppers 0] - set path /sics/choco/${ch}/speed - hfactory $path plain mugger float - hsetprop $path read astspeedread $ch - hsetprop $path write astchopwrite "nspee 1 " - hsetprop $path astchopwritereply astchopwritereply - chocosct write $path - hsetprop $path checklimits astchopspeedlimit 0 - hsetprop $path halt astchopstop - hsetprop $path checkstatus astchopcheckspeed $ch - hsetprop $path priv manager - makesctdriveobj $var $path DriveAdapter chocosct -} -#---------------------------------------------------------------------- -proc astMakeChopperSpeed2 {var} { - global choppers - set ch [lindex $choppers 1] - set path /sics/choco/${ch}/speed - hfactory $path plain mugger float - hsetprop $path read astspeedread $ch - hsetprop $path write astchopwrite "nspee 2 " - hsetprop $path astchopwritereply astchopwritereply - chocosct write $path - hsetprop $path checklimits astchopspeedlimit 0 - hsetprop $path halt astchopstop - hsetprop $path checkstatus astchopcheckspeed $ch - hsetprop $path priv manager - makesctdriveobj $var $path DriveAdapter chocosct -} -#----------------------------------------------------------------------- -proc astchopphaselimit {} { - set val [sct target] - if {$val < -359.9 || $val > 359.9} { - error "chopper phase out of range" - } - return OK -} -#--------------------------------------------------------------------- -proc astphaseread {chopper} { - set val [hval /sics/choco/${chopper}/aphas] - sct update $val - sct send @@NOSEND@@ - return idle -} -#----------------------------------------------------------------------- -proc astMakeChopperPhase1 {var} { - global choppers - set ch [lindex $choppers 0] - set path /sics/choco/${ch}/phase - hfactory $path plain mugger float - hsetprop $path read astphaseread $ch - hsetprop $path write astchopwrite "nphas 1 " - hsetprop $path astchopwritereply astchopwritereply - chocosct write $path - hsetprop $path checklimits astchopphaselimit - hsetprop $path halt astchopstop - hsetprop $path checkstatus astchopcheckphase $ch - hsetprop $path priv manager - makesctdriveobj $var $path DriveAdapter chocosct -} -#----------------------------------------------------------------------- -proc astMakeChopperPhase2 {var} { - global choppers - set ch [lindex $choppers 1] - set path /sics/choco/${ch}/phase - hfactory $path plain mugger float - hsetprop $path read astphaseread $ch - hsetprop $path write astchopwrite "nphas 2 " - hsetprop $path astchopwritereply astchopwritereply - chocosct write $path - hsetprop $path checklimits astchopphaselimit - hsetprop $path halt astchopstop - hsetprop $path checkstatus astchopcheckphase $ch - hsetprop $path priv manager - makesctdriveobj $var $path DriveAdapter chocosct -} -#---------------------------------------------------------------------- -proc astchopratiolimit {} { - set val [sct target] - if {$val < 1} { - error "Ratio out of range" - } - return OK -} -#----------------------------------------------------------------------- -proc astMakeChopperRatio {var} { - global choppers - set ch [lindex $choppers 1] - set path /sics/choco/${ch}/Ratio - hdel $path - hfactory $path plain mugger float - chocosct connect $path - hsetprop $path write astchopwrite "ratio 2 " - hsetprop $path astchopwritereply astchopwritereply - chocosct write $path - hsetprop $path checklimits astchopratiolimit - hsetprop $path halt astchopstop - hsetprop $path checkstatus astchopcheckratio - makesctdriveobj $var $path DriveAdapter chocosct -} -#------------------------------------------------------------------------ -proc chosta {} { - global chopperlonglist chopperparlist choppers chopperheader - set result "$chopperheader\n" - append line [format "%-20s " ""] - set count 1 - foreach ch $choppers { - append line [format "%-20s " $ch] - incr count - } - append result $line "\n" - set nchop [llength $choppers] - set len [llength $chopperlonglist] - for {set i 0} {$i < $len} {incr i} { - set line "" - set par [lindex $chopperlonglist $i] - append line [format "%-20s " $par] - for {set n 0} {$n < $nchop} {incr n} { - set chname [lindex $choppers $n] - set parname [lindex $chopperparlist $i] - set val [hval /sics/choco/${chname}/${parname}] - append line [format "%-20s " $val] - } - append result $line "\n" - } - return $result -} -#======================= Configuration Section ========================== -set amor 0 -set poldi 1 -set focus 0 - -if {$amor == 1} { - set choppers [list chopper1 chopper2] - set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra t_cho \ - durch vakum valve sumsi spver state] - set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \ - "Loss Current" Ratio Vibration Temperature "Water Flow" Vakuum \ - Valve Sumsi] - set chopperheader "AMOR Chopper Status" - makesctcontroller chocosct std psts224:3014 "\r\n" 60 -# makesctcontroller chocosct std localhost:8080 "\r\n" 60 - chocosct debug -1 - set maxspeed 5000 - set minphase 0 - astriumMakeChopperParameters - astMakeChopperSpeed1 chopperspeed - astMakeChopperPhase2 chopper2phase - Publish chosta Spy -} - -#----------------------------- POLDI ----------------------------------------- -if {$poldi == 1} { - - proc poldiastchopphaselimit {} { - set val [sct target] - if {$val < 80 || $val > 100} { - error "chopper phase out of range" - } - return OK - } -#------- - proc poldispeedwrite {} { - set val [sct target] - set l [split [config myrights] =] - set rights [string trim [lindex $l 1]] - if {$rights == 2} { - if {$val < 4990 || $val > 15000} { - clientput "ERROR: Users may only drive the chopper between 5000 - 15000 RPM" - hupdate /sics/choco/stop 1 - return idle - } - } - return [astchopwrite "nspee 1 "] - } -#----------- - set choppers [list chopper] - set chopperparlist [list amode aspee nspee nphas dphas averl ratio vibra vibax t_cho \ - flowr vakum valve sumsi spver state] - set chopperlonglist [list "Chopper Mode" "Actual Speed" "Set Speed" "Phase" "Phase Error" \ - "Loss Current" Ratio Vibration "Actual Vibration" Temperature "Water Flow" Vakuum \ - Valve Sumsi] - set chopperheader "POLDI Chopper Status" - makesctcontroller chocosct std psts240:3005 "\r\n" 60 -# makesctcontroller chocosct std localhost:8080 "\r\n" 60 - chocosct debug -1 - set maxspeed 15000 - set minphase 80 - astriumMakeChopperParameters -# astMakeChopperSpeed1 chopperspeed - - set path /sics/choco/chopper/speed - hfactory $path plain user float - hsetprop $path read astspeedread chopper - hsetprop $path write poldispeedwrite - hsetprop $path astchopwritereply astchopwritereply - chocosct write $path - hsetprop $path checklimits astchopspeedlimit 0 - hsetprop $path halt astchopstop - hsetprop $path checkstatus astchopcheckspeed chopper - hsetprop $path priv user - makesctdriveobj chopperspeed $path DriveAdapter chocosct - - astMakeChopperPhase1 chopperphase - hsetprop /sics/choco/chopper/phase checklimit poldiastchopphaselimit - Publish chosta Spy -} -#----------------------------- FOCUS ----------------------------------------------------- -if {$focus == 1} { - set choppers [list fermi disk] - set chopperparlist [list state amode aspee nspee nphas dphas averl ratio vibra t_cho \ - durch vakum valve sumsi] - set chopperlonglist [list "Chopper State" "Chopper Mode" "Actual Speed" "Set Speed" \ - "Phase" "Phase Error" \ - "Loss Current" Ratio Vibration Temperature "Water Flow" \ - Vakuum Valve Sumsi] - set chopperheader "FOCUS Chopper Status" - makesctcontroller chocosct std psts227:3008 "\r\n" 60 -# makesctcontroller chocosct std localhost:8080 "\r\n" 60 - chocosct debug 0 - set maxspeed 20000 - set minphase 0 - astriumMakeChopperParameters - astMakeChopperSpeed1 fermispeed - astMakeChopperSpeed2 diskspeed - astMakeChopperRatio ratio - astMakeChopperPhase2 phase - Publish chosta Spy -} diff --git a/tcl/bgerror.tcl b/tcl/bgerror.tcl deleted file mode 100755 index 24197522..00000000 --- a/tcl/bgerror.tcl +++ /dev/null @@ -1,8 +0,0 @@ -proc bgerror err { - global errorInfo - set info $errorInfo - - puts stdout $err - puts stdout "------------------------- StackTrace ---------------------" - puts $info -} diff --git a/tcl/client.tcl b/tcl/client.tcl deleted file mode 100755 index e7899bb1..00000000 --- a/tcl/client.tcl +++ /dev/null @@ -1,151 +0,0 @@ -#!/data/koenneck/bin/tclsh -#---------------------------------------------------------------------------- -# A command line client for SICS, written in plain Tcl. -# Just sends and reads commands from the SICServer -# -# Mark Koennecke, September 1996 -#---------------------------------------------------------------------------- -#---------- Data section -set sdata(test,host) lnsa06.psi.ch -set sdata(test,port) 2910 -set sdata(dmc,host) lnsa05.psi.ch -set sdata(dmc,port) 3006 -set sdata(topsi,host) lnsa03.psi.ch -set sdata(topsi,port) 9708 -set sdata(sans,host) lnsa07.psi.ch -set sdata(sans,port) 2915 -set sdata(user) Spy -set sdata(passwd) 007 - -set mysocket stdout -#-------------------------------------------------------------------------- -proc bgerror err { - global errorInfo - set info $errorInfo - - puts stdout $err - puts stdout "------------------------- StackTrace ---------------------" - puts $info -} - -#--------------------------------- procedures section ----------------------- -# Setting up the connection to the Server -proc StartConnection {host port} { - global mysocket - global sdata -# start main connection - set mysocket [socket $host $port] - puts $mysocket [format "%s %s" $sdata(user) $sdata(passwd)] - set ret [catch {flush $mysocket} msg] - if { $ret != 0} { - error "Server NOT running!" - } - fconfigure $mysocket -blocking 0 - fconfigure $mysocket -buffering none - fileevent $mysocket readable GetData - after 5000 -} -#---------------------------------------------------------------------------- -proc GetData { } { - global mysocket - global b - if { [eof $mysocket] } { - puts stdout "Connection to server lost" - close $mysocket - set b 1 - return - } - set buf [read $mysocket] - set buf [string trim $buf] - set list [split $buf \n] - foreach teil $list { - set teil [string trimright $teil] - puts stdout $teil - } - puts -nonewline stdout "SICS> " - flush stdout -} -#--------------------------------------------------------------------------- -proc SendCommand { text} { - global mysocket - global b - if { [eof $mysocket] } { - puts stdout "Connection to server lost" - set b 1 - } - puts $mysocket $text - flush $mysocket -} - -#---------------------------------------------------------------------------- -proc readProgA {pid} { - global readProgADone; - global b - global mysocket - - # read outputs of schemdb - set tmpbuf [gets $pid]; - if {[string first quit $tmpbuf] > -1 } { - close $mysocket - puts stdout "Closing connection to SICS server on your request..." - puts stdout "Bye, bye, have a nice day!" - set b 1 - } elseif { [string first stop $tmpbuf] > -1} { - SendCommand "INT1712 3" - } else { - SendCommand $tmpbuf - } - - set readProgADone [eof $pid]; - - if {$readProgADone} { - puts "closing..."; - catch [close $pid] aa; - if {$aa != ""} { - puts "HERE1: Error on closing"; - exit 1; - } - } -} -#-------------------------- some utility functions ------------------------- -proc MC { t n } { - set string $t - for { set i 1 } { $i < $n } { incr i } { - set string [format "%s%s" $string $t] - } - return $string -} - -#------------------------------------------------------------------------- -proc PrintHeader { } { - global instrument - puts stdout [format "%s Welcome to SICS! %s" [MC " " 30] [MC " " 30]] - puts stdout [format "%s You are connected to: %s" [MC " " 29] [MC " " 29]] - puts stdout [format "%s %s %s" [MC " " 35] $instrument [MC " " 35]] - puts stdout "SICS> " - flush stdout -} -#-------------------------------- "MAIN" ----------------------------------- - if {$argc < 1} { - puts stdout "Usage: client instrumentname" - exit 0 - } -#----------------- StartConnection - set instrument [lindex $argv 0] - set ret [catch {StartConnection $sdata($instrument,host) \ - $sdata($instrument,port)} msg ] - if {$ret != 0} { - puts stdout $msg - exit 1 - } -#----------------- print header -PrintHeader - -# set the "read" event -fileevent stdin readable {readProgA stdin}; - -#---loop till exit -set b 0 -vwait b -exit 0 - \ No newline at end of file diff --git a/tcl/count.tcl b/tcl/count.tcl deleted file mode 100644 index 0391d279..00000000 --- a/tcl/count.tcl +++ /dev/null @@ -1,54 +0,0 @@ -#-------------------------------------------------------------------------- -# A count command for DMC -# 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] - catch {temperature log clear} msg -#----- 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 a [banana preset] - set aa [SplitReply $a] - set b [banana CountMode] - set bb [SplitReply $b] - ClientPut [format " Starting counting in %s mode with a preset of %s" \ - $bb $aa] -#------- count - banana InitVal 0 - wait 1 - banana count - set ret [catch {Success} msg] -#------- StoreData - StoreData - if { $ret != 0 } { - error [format "Counting ended with error"] - } -} -#---------------- Repeat ----------------------------------------------- -proc repeat { num {mode NULL} {preset NULL} } { - for { set i 0 } { $i < $num } { incr i } { - set ret [catch {count $mode $preset} msg] - if {$ret != 0} { - error "Counting ended with error" - } - } -} diff --git a/tcl/deltatau.tcl b/tcl/deltatau.tcl deleted file mode 100644 index 59ed3f95..00000000 --- a/tcl/deltatau.tcl +++ /dev/null @@ -1,356 +0,0 @@ -#--------------------------------------------------------------- -# These are the scripts for the delta-tau PMAC motor -# controller. -# -# !!!!!!!!! Script Chains !!!!!!!!!!! -# -- For reading parameters: -# sendpmacread code -- pmacreadreply -# -- For setting standard parameters -# sendpmacwrite code -- pmacreadreply -# -- For reading limits -# sendpmaclim -- readpmaclim -# -- For reading the status -# pmacsendaxer --- pmacrcvaxerr -- pmacrcvpos -- pmacrcvstat -# This means we check for an axis error first, then update the position, -# then check the axis status itself. -# -- For setting the position -# pmacsendhardpos -- pmacrcvhardpos -- pmacrcvhardax -# This means, we send the positioning command, read the reply and read the -# axisstatus until the axis has started -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, December 2008, March 2009 -#--------------------------------------------------------------- -proc translatePMACError {key} { - set pmacerr(ERR001) "Command not allowed while executing" - set pmacerr(ERR002) "Password error" - set pmacerr(ERR003) "Unrecognized command" - set pmacerr(ERR004) "Illegal character" - set pmacerr(ERR005) "Command not allowed" - set pmacerr(ERR006) "No room in buffer for command" - set pmacerr(ERR007) "Buffer already in use" - set pmacerr(ERR008) "MACRO auxiliary communication error" - set pmacerr(ERR009) "Bad program in MCU" - set pmacerr(ERR010) "Both HW limits set" - set pmacerr(ERR011) "Previous move did not complete" - set pmacerr(ERR012) "A motor is open looped" - set pmacerr(ERR013) "A motor is not activated" - set pmacerr(ERR014) "No motors" - set pmacerr(ERR015) "No valid program in MCU" - set pmacerr(ERR016) "Bad program in MCU" - set pmacerr(ERR017) "Trying to resume after H or Q" - set pmacerr(ERR018) "Invalid operation during move" - set pmacerr(ERR019) "Illegal position change command during move" - return $pmacerr($key) -} -#------------------------------------------------------------------ -proc translateAxisError {key} { - switch [string trim $key] { - 0 {return "no error"} - 1 { return "limit violation"} - 2 - - 3 - - 4 { return "jog error"} - 5 {return "command not allowed"} - 6 {return "watchdog triggered"} - 7 {return "current limit reached"} - 8 - - 9 {return "Air cushion error"} - 10 {return "MCU lim reached"} - 11 {return "following error triggered"} - 12 {return "EMERGENCY STOP ACTIVATED"} - 13 {return "Driver electronics error"} - default { return "Unknown axis error $key"} - } -} -#--------------------------------------------------------------------- -proc evaluateAxisStatus {key} { -#----- Tcl does not like negative numbers as keys. - if {$key < 0} { - set key [expr 50 + abs($key)] - } - switch $key { - 0 - - 14 {return idle} - 1 - - 2 - - 3 - - 4 - - 5 - - 6 - - 7 - - 8 - - 9 - - 10 - - 11 {return run} - 56 {error "Controller aborted"} - 55 {error "Axis is deactivated"} - 54 {error "emergency stop activated, please release"} - 53 {error "Axis inhibited"} - 51 - - 52 {error "Incoming command is blocked"} - } -} -#----------------------------------------------------------------------- -proc checkpmacresult {} { - set data [sct result] - if {[string first ASCERR $data] >= 0} { - error $data - } - if {[string first ERR $data] >= 0} { - error [translatePMACError $data] - } - return [string trim $data] -} -#------------------------------------------------------------------------ -proc sendpmacread {code} { - sct send $code - return pmacreadreply -} -#------------------------------------------------------------------------ -proc pmacreadreply {} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - sct geterror $data - } else { - sct update $data - } - return idle -} -#---------------------------------------------------------------------- -proc sendpmaclim {code} { - sct send $code - return pmacreadlim -} -#----------------------------------------------------------------------- -proc pmacreadlim {motname} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - sct geterror $data - } else { - set scale [hval /sics/${motname}/scale_factor] - sct update [expr $data * $scale] - } - return idle -} -#------------------------------------------------------------------------ -proc sendpmacwrite {code} { - set value [sct target] - sct send "$code=$value" - return pmacwritereply -} -#------------------------------------------------------------------------ -proc pmacwritereply {} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - sct geterror $data - sct print "ERROR: $data" - } else { - set con [sct controller] - $con queue [sct] read read - } - return idle -} -#------------------------------------------------------------------------- -proc configurePMACPar {name par code sct} { - set path /sics/$name/$par - hsetprop $path read "sendpmacread $code" - hsetprop $path pmacreadreply pmacreadreply - $sct poll $path 30 - hsetprop $path write "sendpmacwrite $code" - hsetprop $path pmacwritereply pmacwritereply - $sct write $path -} -#------------------------------------------------------------------------- -proc makePMACPar {name par code sct priv} { - set path /sics/$name/$par - hfactory $path plain $priv float - configurePMACPar $name $par $code $sct -} -#========================== status functions ============================= -proc pmacsendaxerr {num} { - sct send "P${num}01" - return rcvaxerr -} -#------------------------------------------------------------------------ -proc pmacrcvaxerr {motname num} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - clientput "ERROR: $data" - sct update error - sct geterror $data - return idle - } - hupdate /sics/$motname/axiserror $data - if {$data != 0 } { - set err [translateAxisError $data] - if {[string first following $err] >= 0} { - clientput "WARNING: $err" - sct update poserror - } else { - clientput "ERROR: $err" - sct update error - } - return idle - } - hupdate /sics/$motname/axiserror $data - sct send "Q${num}10" - return rcvpos -} -#------------------------------------------------------------------------ -proc pmacrcvpos {motname num} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - clientput "ERROR: $data" - sct geterror $data - sct update error - return idle - } - hupdate /sics/$motname/hardposition $data - sct send "P${num}00" - return rcvstat -} -#------------------------------------------------------------------------ -proc pmacrcvstat {motname num sct} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - clientput "ERROR: $data" - sct update error - return idle - } - set status [catch {evaluateAxisStatus $data} msg] - if {$status != 0} { - sct update error - } else { - sct update $msg - switch $msg { - idle { - # force an update of the motor position - $sct queue /sics/$motname/hardposition progress read - } - run { - # force an update of ourselves, while running - $sct queue /sics/$motname/status progress read - } - } - } - return idle -} -#------------------------------------------------------------------------- -proc configurePMACStatus {motname num sct} { - set path /sics/$motname/status - hsetprop $path read "pmacsendaxerr $num" - hsetprop $path rcvaxerr "pmacrcvaxerr $motname $num" - hsetprop $path rcvpos "pmacrcvpos $motname $num" - hsetprop $path rcvstat "pmacrcvstat $motname $num $sct" - $sct poll $path 60 -} -#======================= setting hard position =========================== -proc pmacsendhardpos {motname num} { - hupdate /sics/$motname/status run - set value [sct target] - sct send [format "P%2.2d23=0 Q%2.2d01=%12.4f M%2.2d=1" $num $num $value $num] - return rcvhardpos -} -#------------------------------------------------------------------------- -proc pmacrcvhardpos {num} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - clientput "ERROR: $data" - sct seterror $data - return idle - } - sct send "P${num}00" - return rcvhardax -} -#------------------------------------------------------------------------ -proc pmacrcvhardax {motname num sct} { - set status [catch {checkpmacresult} data] - if {$status != 0} { - clientput "ERROR: $data" - sct seterror $data - return idle - } - set status [catch {evaluateAxisStatus $data} msg] - if {$status != 0} { - clientput "ERROR: $msg" - sct seterror $msg - return idle - } - switch $msg { - idle { - sct send "P${num}00" - return rcvhardax - } - run { - $sct queue /sics/$motname/status progress read - return idle - } - } -} -#------------------------------------------------------------------------ -proc configurePMAChardwrite {motname num sct} { - set path /sics/$motname/hardposition - hsetprop $path write "pmacsendhardpos $motname $num" - hsetprop $path rcvhardpos "pmacrcvhardpos $num" - hsetprop $path rcvhardax "pmacrcvhardax $motname $num $sct" -} -#======================= Halt ============================================= -proc pmacHalt {sct num} { - $sct send "M${num}=8" halt - return OK -} -#==================== Reference Run ======================================= -proc pmacrefrun {motorname sct num} { - set path /sics/${motorname}/status - $sct send "M${num}=9" - hupdate /sics/${motorname}/status run - set motstat run - wait 3 - while {[string compare $motstat run] == 0} { - $sct queue $path progress read - wait 1 - set motstat [string trim [hval $path]] - } - return "Done" -} -#-------------------------------------------------------------------------- -proc MakeDeltaTau {name sct num} { - MakeSecMotor $name - hsetprop /sics/${name}/hardupperlim read "sendpmaclim I${num}13" - hsetprop /sics/${name}/hardupperlim pmacreadlim "pmacreadlim $name" - $sct poll /sics/${name}/hardupperlim 180 - hsetprop /sics/${name}/hardlowerlim read "sendpmaclim I${num}14" - hsetprop /sics/${name}/hardlowerlim pmacreadlim "pmacreadlim $name" - $sct poll /sics/${name}/hardlowerlim 180 - -# configurePMACPar $name hardlowerlim "Q${num}09" $sct -# configurePMACPar $name hardupperlim "Q${num}08" $sct - - configurePMACPar $name hardposition "Q${num}10" $sct - configurePMAChardwrite $name $num $sct - hfactory /sics/$name/numinmcu plain internal int - hupdate /sics/$name/numinmcu ${num} - makePMACPar $name scale_factor "Q${num}00" $sct mugger - makePMACPar $name maxspeed "Q${num}03" $sct mugger - makePMACPar $name commandspeed "Q${num}04" $sct mugger - makePMACPar $name maxaccel "Q${num}05" $sct mugger - makePMACPar $name commandedaccel "Q${num}06" $sct mugger - makePMACPar $name offset "Q${num}07" $sct mugger - makePMACPar $name axisstatus "P${num}00" $sct internal - makePMACPar $name axiserror "P${num}01" $sct internal - makePMACPar $name poshwlimitactive "M${num}21" $sct internal - makePMACPar $name neghwlimitactive "M${num}22" $sct internal - makePMACPar $name liftaircushion "M${num}96" $sct internal - configurePMACStatus $name $num $sct - $name makescriptfunc halt "pmacHalt $sct $num" user - $name makescriptfunc refrun "pmacrefrun $name $sct $num" user - set parlist [list scale_factor hardposition maxspeed \ - commandspeed maxaccel offset axisstatus axiserror status poshwlimitactive \ - neghwlimitactive liftaircushion hardlowerlim hardupperlim] - $sct send [format "M%2.2d14=0" $num] - foreach par $parlist { - $sct queue /sics/$name/$par progress read - } -} diff --git a/tcl/el737sec.tcl b/tcl/el737sec.tcl deleted file mode 100644 index 47515450..00000000 --- a/tcl/el737sec.tcl +++ /dev/null @@ -1,314 +0,0 @@ -#----------------------------------------------------- -# This is a second generation counter driver for -# the PSI EL737 counter boxes using scriptcontext -# communication. -# -# copyright: see file COPYRIGHT -# -# Scriptchains: -# start: el737sendstart - el737cmdreply -# pause,cont, stop: el737sendcmd - el737cmdreply -# status: el737readstatus - el737status -# \ el737statval - el737statread -# values: el737readvalues - el737val -# threshold write: el737threshsend - el737threshrcv - el737cmdreply -# -# Mark Koennecke, February 2009 -#----------------------------------------------------- -proc el737error {reply} { - if {[string first ERR $reply] >= 0} { - error $reply - } - if {[string first ? $reply] < 0} { - return ok - } - if {[string first "?OV" $reply] >= 0} { - error overflow - } - if {[string first "?1" $reply] >= 0} { - error "out of range" - } - if {[string first "?2" $reply] >= 0} { - error "bad command" - } - if {[string first "?3" $reply] >= 0} { - error "bad parameter" - } - if {[string first "?4" $reply] >= 0} { - error "bad counter" - } - if {[string first "?5" $reply] >= 0} { - error "parameter missing" - } - if {[string first "?6" $reply] >= 0} { - error "to many counts" - } - return ok -} -#--------------------------------------------------- -proc el737cmdreply {} { - set reply [sct result] - set status [catch {el737error $reply} err] - if {$status != 0} { - sct geterror $err - set data [sct send] - if {[string first overflow $err] >= 0} { - clientput "WARNING: trying to fix $err on command = $data" - sct send $data - return el737cmdreply - } else { - clientput "ERROR: $err, command = $data" - } - } - return idle -} -#--------------------------------------------------- -proc sctroot {} { - set path [sct] - return [file dirname $path] -} -#---------------------------------------------------- -proc el737sendstart {} { - set obj [sctroot] - set mode [string tolower [string trim [hval $obj/mode]]] - set preset [string trim [hval $obj/preset]] - hdelprop [sct] geterror - switch $mode { - timer { - set cmd [format "TP %.2f" $preset] - } - default { - set cmd [format "MP %d" [expr int($preset)]] - } - } - sct send $cmd - set con [sct controller] - $con queue $obj/status progress read - return el737cmdreply -} -#---------------------------------------------------- -proc el737sendcmd {cmd} { - hdelprop [sct] geterror - sct send $cmd - return el737cmdreply -} -#--------------------------------------------------- -proc el737control {} { - set target [sct target] - switch $target { - 1000 {return [el737sendstart] } - 1001 {return [el737sendcmd S] } - 1002 {return [el737sendcmd PS] } - 1003 {return [el737sendcmd CO] } - default { - sct print "ERROR: bad start target $target given to control" - return idle - } - } - -} -#---------------------------------------------------- -proc el737readstatus {} { - hdelprop [sct] geterror - sct send RS - return el737status -} -#------------------------------------------------- -proc el737statval {} { - el737readvalues - return el737statread -} -#------------------------------------------------- -proc el737statread {} { - el737val - sct update idle - return idle -} -#-------------------------------------------------- -proc el737status {} { - set reply [sct result] - set status [catch {el737error $reply} err] - if {$status != 0} { - sct geterror $err - sct update error - sct print "ERROR: $err" - return idle - } - set path [sct] - set con [sct controller] - switch [string trim $reply] { - 0 { - return el737statval - } - 1 - - 2 { - sct update run - $con queue $path progress read - } - 5 - - 6 { - sct update nobeam - $con queue $path progress read - } - default { - sct update pause - $con queue $path progress read - } - } - set count [sct moncount] - if {$count >= 10} { - set root [sctroot] - $con queue $root/values progress read - sct moncount 0 - } else { - incr count - sct moncount $count - } - return idle -} -#------------------------------------------------ -proc el737readvalues {} { - hdelprop [sct] geterror - sct send RA - return el737val -} -#-------------------------------------------------- -proc swapFirst {l} { - set m1 [lindex $l 0] - set cts [lindex $l 1] - lappend res $cts $m1 - for {set i 2} {$i < [llength $l]} {incr i} { - lappend res [lindex $l $i] - } - return $res -} -#--------------------------------------------------- -# There are two types of reponses to the RA command: -# the old form with 5 values and the new one -# with 9 values -#--------------------------------------------------- -proc el737val {} { - set reply [sct result] - set status [catch {el737error $reply} err] - if {$status != 0} { - sct geterror $err - sct print "ERROR: $err" - return idle - } - set l [split $reply] - set root [sctroot] - if {[llength $l] > 5} { - set l2 [lrange $l 1 end] - set l2 [swapFirst $l2] - hupdate ${root}/values [join $l2] - set time [lindex $l 0] - hupdate ${root}/time $time - } else { - set last [expr [llength $l] - 1] - set l2 [lrange $l 0 $last] - set l2 [swapFirst $l2] - hupdate ${root}/values [join $l2] - set time [lindex $l $last] - hupdate ${root}/time $time - } - set mode [hval ${root}/mode] - switch $mode { - timer { - hupdate ${root}/control $time - } - default { - set mon [lindex $l2 1] - hupdate ${root}/control $time - } - } - return idle -} -#---------------------------------------------- -proc el737threshsend {} { - set val [string trim [sct target]] - set root [sctroot] - set cter [string trim [hval $root/thresholdcounter]] - sct send [format "DL %1.1d %f" $cter $val] - return el737threshrecv -} -#--------------------------------------------- -proc el737threshrecv {} { - set reply [sct result] - set status [catch {el737error $reply} err] - if {$status != 0} { - sct geterror $err - sct print "ERROR: $err" - } - set root [sctroot] - set cter [string trim [hval $root/thresholdcounter]] - sct send [format "DR %1.1d" $cter] - set sctcon [sct controller] - $sctcon queue [sct] progress read - return el737cmdreply -} -#--------------------------------------------- -proc el737threshread {} { - set root [sctroot] - set cter [string trim [hval $root/thresholdcounter]] - sct send [format "DL %1.1d" $cter] - return el737thresh -} -#---------------------------------------------- -proc el737thresh {} { - set reply [sct result] - set status [catch {el737error $reply} err] - if {$status != 0} { - sct geterror $err - sct print "ERROR: $err" - return idle - } - stscan $reply "%f" val - sct update $val - return idle -} -#---------------------------------------------- -proc el737func {controller path} { - $controller queue $path write -} -#============================================ -proc MakeSecEL737 {name netaddr} { - MakeSecCounter $name 8 - set conname ${name}sct - makesctcontroller $conname std $netaddr "\r" 10 - $conname send "RMT 1" - $conname send "RMT 1" - $conname send "ECHO 2" - - set path /sics/${name}/values - hsetprop $path read el737readvalues - hsetprop $path el737val el737val - $conname poll $path 60 - - set path /sics/${name}/status - hsetprop $path read el737readstatus - hsetprop $path el737status el737status - hsetprop $path el737statval el737statval - hsetprop $path el737statread el737statread - hsetprop $path moncount 0 - $conname poll $path 60 - - set path /sics/${name}/control - hsetprop $path write el737control - hsetprop $path el737cmdreply el737cmdreply - $conname write $path - - hfactory /sics/${name}/thresholdcounter plain mugger int - hsetprop /sics/${name}/thresholdcounter __save true - set path /sics/${name}/threshold - hfactory $path plain mugger float - hsetprop $path write el737threshsend - hsetprop $path el737threshrcv el737threshrcv - hsetprop $path el737cmdreply el737cmdreply - $conname write $path - hsetprop $path read el737threshread - hsetprop $path el737thresh el737thresh -# $conname poll $path 60 - - $conname debug -1 - -} diff --git a/tcl/el755.tcl b/tcl/el755.tcl deleted file mode 100644 index 0eddccf5..00000000 --- a/tcl/el755.tcl +++ /dev/null @@ -1,97 +0,0 @@ -#------------------------------------------------------------- -# This is a scriptcontext driver for the PSI EL755 magnet -# controller. -# -# scriptchains: -# read - readreply -# write - writereply - writereadback -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, November 2009 -#-------------------------------------------------------------- - -namespace eval el755 {} - -#-------------------------------------------------------------- -proc el755::read {num} { - sct send [format "I %d" $num] - return readreply -} -#-------------------------------------------------------------- -proc el755::readreply {num} { - set reply [sct result] - if {[string first ? $reply] >= 0} { - if {[string first ?OV $reply] >= 0} { - sct send [format "I %d" $num] -# clientput "EL755 did an overflow...." - return readreply - } - error $reply - } - set n [stscan $reply "%f %f" soll ist] - if {$n < 2} { - sct send [format "I %d" $num] - clientput "Invalid response $reply from EL755" - return readreply - } - sct update $ist - return idle -} -#------------------------------------------------------------------ -proc el755::write {num} { - set cur [sct target] - sct send [format "I %d %f" $num $cur] - return writereply -} -#------------------------------------------------------------------ -proc el755::writereply {num} { - set reply [sct result] - if {[string first ? $reply] >= 0} { - if {[string first ?OV $reply] >= 0} { - set cur [sct target] - sct send [format "I %d %f" $num $cur] -# clientput "EL755 did an overflow...." - return writereply - } - error $reply - } - sct send [format "I %d" $num] - return writereadback -} -#-------------------------------------------------------------------- -proc el755::writereadback {num} { - set reply [sct result] - if {[string first ? $reply] >= 0} { - if {[string first ?OV $reply] >= 0} { - set cur [sct target] - sct send [format "I %d" $num] -# clientput "EL755 did an overflow...." - return writereadback - } - error $reply - } - set n [stscan $reply "%f %f" soll ist] - if {$n < 2} { - sct send [format "I %d" $num] - clientput "Invalid response $reply from EL755" - return writereadback - } - set cur [sct target] - if {abs($cur - $soll) < .1} { - return idle - } - return el755::write $num -} -#-------------------------------------------------------------------- -proc el755::makeel755 {name num sct} { - stddrive::makestddrive $name EL755Magnet $sct - set path /sics/${name} - hsetprop $path read el755::read $num - hsetprop $path readreply el755::readreply $num - hsetprop $path write el755::write $num - hsetprop $path writereply el755::writereply $num - hsetprop $path writereadback el755::writereadback $num - $sct poll $path 60 - $sct write $path -} diff --git a/tcl/fit.tcl b/tcl/fit.tcl deleted file mode 100644 index 4fd766a6..00000000 --- a/tcl/fit.tcl +++ /dev/null @@ -1,52 +0,0 @@ -#----------------------------------------------------------------------------- -# This is an implementation for a fit command for SICS. It uses a separate -# fit program retrieved from the vast spaces of the net for this purpose. -# The scheme is as follows: Data is written to a file, the fit program is -# executed and the data retrieved at need. -# -# Mark Koennecke, October 1997 -#---------------------------------------------------------------------------- - -#----- Initialise this to match your setup -set fithome /data/koenneck/src/sics/fit -set scancom xxxscan -set IIcentervar "" - -proc fit__run { } { - global fithome - global scancom - global IIcentervar -#--------------- - set cp [$scancom getcounts] - set cp2 [split $cp =] - set Counts [lindex $cp2 1] - set fp [$scancom getvardata 0] - set fp2 [split $fp = ] - set fitpar [lindex $fp2 1] -#----- set center variable - set bg [lindex $fp2 1] - set bg2 [split $bg .] - set IIcentervar [lindex $bg2 1] - unset cp - unset cp2 - unset fp - unset fp2 - unset bg - unset bg2 -#---- write fit input file - set fd [open $fithome/sicsin.dat w] - set length [llength $Counts] - for {set i 0 } { $i < $length } { incr i} { - puts $fd [format " %f %d" [lindex $fitpar $i] \ - [lindex $Counts $i] ] - } - close $fd - -} - -proc fit args { - set l [llength $args] - if { $l < 1} { - fit__run - } -} \ No newline at end of file diff --git a/tcl/ldAout.tcl b/tcl/ldAout.tcl deleted file mode 100644 index a15999f4..00000000 --- a/tcl/ldAout.tcl +++ /dev/null @@ -1,228 +0,0 @@ -# ldAout.tcl -- -# -# This "tclldAout" procedure in this script acts as a replacement -# for the "ld" command when linking an object file that will be -# loaded dynamically into Tcl or Tk using pseudo-static linking. -# -# Parameters: -# The arguments to the script are the command line options for -# an "ld" command. -# -# Results: -# The "ld" command is parsed, and the "-o" option determines the -# module name. ".a" and ".o" options are accumulated. -# The input archives and object files are examined with the "nm" -# command to determine whether the modules initialization -# entry and safe initialization entry are present. A trivial -# C function that locates the entries is composed, compiled, and -# its .o file placed before all others in the command; then -# "ld" is executed to bind the objects together. -# -# SCCS: @(#) ldAout.tcl 1.11 96/09/17 09:02:20 -# -# Copyright (c) 1995, by General Electric Company. All rights reserved. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# -# This work was supported in part by the ARPA Manufacturing Automation -# and Design Engineering (MADE) Initiative through ARPA contract -# F33615-94-C-4400. - -proc tclLdAout {{cc {}} {shlib_suffix {}} {shlib_cflags none}} { - global env - global argv - - if {$cc==""} { - set cc $env(CC) - } - - # if only two parameters are supplied there is assumed that the - # only shlib_suffix is missing. This parameter is anyway available - # as "info sharedlibextension" too, so there is no need to transfer - # 3 parameters to the function tclLdAout. For compatibility, this - # function now accepts both 2 and 3 parameters. - - if {$shlib_suffix==""} { - set shlib_suffix $env(SHLIB_SUFFIX) - set shlib_cflags $env(SHLIB_CFLAGS) - } else { - if {$shlib_cflags=="none"} { - set shlib_cflags $shlib_suffix - set shlib_suffix [info sharedlibextension] - } - } - - # seenDotO is nonzero if a .o or .a file has been seen - - set seenDotO 0 - - # minusO is nonzero if the last command line argument was "-o". - - set minusO 0 - - # head has command line arguments up to but not including the first - # .o or .a file. tail has the rest of the arguments. - - set head {} - set tail {} - - # nmCommand is the "nm" command that lists global symbols from the - # object files. - - set nmCommand {|nm -g} - - # entryProtos is the table of _Init and _SafeInit prototypes found in the - # module. - - set entryProtos {} - - # entryPoints is the table of _Init and _SafeInit entries found in the - # module. - - set entryPoints {} - - # libraries is the list of -L and -l flags to the linker. - - set libraries {} - set libdirs {} - - # Process command line arguments - - foreach a $argv { - if {!$minusO && [regexp {\.[ao]$} $a]} { - set seenDotO 1 - lappend nmCommand $a - } - if {$minusO} { - set outputFile $a - set minusO 0 - } elseif {![string compare $a -o]} { - set minusO 1 - } - if [regexp {^-[lL]} $a] { - lappend libraries $a - if [regexp {^-L} $a] { - lappend libdirs [string range $a 2 end] - } - } elseif {$seenDotO} { - lappend tail $a - } else { - lappend head $a - } - } - lappend libdirs /lib /usr/lib - - # MIPS -- If there are corresponding G0 libraries, replace the - # ordinary ones with the G0 ones. - - set libs {} - foreach lib $libraries { - if [regexp {^-l} $lib] { - set lname [string range $lib 2 end] - foreach dir $libdirs { - if [file exists [file join $dir lib${lname}_G0.a]] { - set lname ${lname}_G0 - break - } - } - lappend libs -l$lname - } else { - lappend libs $lib - } - } - set libraries $libs - - # Extract the module name from the "-o" option - - if {![info exists outputFile]} { - error "-o option must be supplied to link a Tcl load module" - } - set m [file tail $outputFile] - set l [expr [string length $m] - [string length $shlib_suffix]] - if [string compare [string range $m $l end] $shlib_suffix] { - error "Output file does not appear to have a $shlib_suffix suffix" - } - set modName [string tolower [string range $m 0 [expr $l-1]]] - if [regexp {^lib} $modName] { - set modName [string range $modName 3 end] - } - if [regexp {[0-9\.]*(_g0)?$} $modName match] { - set modName [string range $modName 0 [expr [string length $modName]-[string length $match]-1]] - } - set modName "[string toupper [string index $modName 0]][string range $modName 1 end]" - - # Catalog initialization entry points found in the module - - set f [open $nmCommand r] - while {[gets $f l] >= 0} { - if [regexp {T[ ]*_?([A-Z][a-z0-9_]*_(Safe)?Init(__FP10Tcl_Interp)?)$} $l trash symbol] { - if {![regexp {_?([A-Z][a-z0-9_]*_(Safe)?Init)} $symbol trash s]} { - set s $symbol - } - append entryProtos {extern int } $symbol { (); } \n - append entryPoints { } \{ { "} $s {", } $symbol { } \} , \n - } - } - close $f - - if {$entryPoints==""} { - error "No entry point found in objects" - } - - # Compose a C function that resolves the initialization entry points and - # embeds the required libraries in the object code. - - set C {#include } - append C \n - append C {char TclLoadLibraries_} $modName { [] =} \n - append C { "@LIBS: } $libraries {";} \n - append C $entryProtos - append C {static struct } \{ \n - append C { char * name;} \n - append C { int (*value)();} \n - append C \} {dictionary [] = } \{ \n - append C $entryPoints - append C { 0, 0 } \n \} \; \n - append C {typedef struct Tcl_Interp Tcl_Interp;} \n - append C {typedef int Tcl_PackageInitProc (Tcl_Interp *);} \n - append C {Tcl_PackageInitProc *} \n - append C TclLoadDictionary_ $modName { (symbol)} \n - append C { char * symbol;} \n - append C {{ - int i; - for (i = 0; dictionary [i] . name != 0; ++i) { - if (!strcmp (symbol, dictionary [i] . name)) { - return dictionary [i].value; - } - } - return 0; -}} \n - - # Write the C module and compile it - - set cFile tcl$modName.c - set f [open $cFile w] - puts -nonewline $f $C - close $f - set ccCommand "$cc -c $shlib_cflags $cFile" - puts stderr $ccCommand - eval exec $ccCommand - - # Now compose and execute the ld command that packages the module - - set ldCommand ld - foreach item $head { - lappend ldCommand $item - } - lappend ldCommand tcl$modName.o - foreach item $tail { - lappend ldCommand $item - } - puts stderr $ldCommand - eval exec $ldCommand - - # Clean up working files - - exec /bin/rm $cFile [file rootname $cFile].o -} diff --git a/tcl/lof.tcl b/tcl/lof.tcl deleted file mode 100644 index fd6cc93d..00000000 --- a/tcl/lof.tcl +++ /dev/null @@ -1,90 +0,0 @@ -#------------------------------------------------------------ -# Last openened files. Lists the last n old files, giving -# a summary of each. -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, July 2009 -#------------------------------------------------------------ - -namespace eval lof {} - -set lof::instrument focus - -set lof::table(Title) /entry1/title -set lof::table(Finished) /entry1/end_time -set lof::table(Monitor) /entry1/FOCUS/counter/monitor -set lof::table(Sample) /entry1/sample/name -set lof::table(Temperature) /entry1/sample/temperature -set lof::table(Lambda) /entry1/FOCUS/monochromator/lambda - - -proc lof::getyear {} { - return [clock format [clock seconds] -format "%Y"] -} -#------------------------------------------------------------ -proc lof::makefilename {num} { - global simMode lof::instrument datahome - - set hun [expr $num / 1000] - set y [lof::getyear] - if {$simMode == 0} { - set filename [format "%s/%3.3d/%s%4.4dn%6.6d.hdf" $datahome $hun $lof::instrument $y $num] - } else { - set filename [format "/afs/psi.ch/project/sinqdata/%s/%s/%3.3d/%s%4.4dn%6.6d.hdf" \ - $y $lof::instrument $hun $lof::instrument $y $num] - } - return $filename -} -#------------------------------------------------------------ -proc lof::getcurrentnumor {} { - global simMode lof::instrument - - if {$simMode == 0} { - set txt [sicsdatanumber] - set l [split $txt =] - return [string trim [lindex $l 1]] - } else { - set y [getyear] - set filnam [format "/afs/psi.ch/project/sinqdata/%s/%s/DataNumber" \ - $y $instrument] - set in [open $filnam r] - gets $in line - close $in - return [string trim $line] - } -} -#----------------------------------------------------------- -proc lof::readfiledata {num} { - global lof::table NXACC_READ NX_CHAR - - set hdffile [lof::makefilename $num] - set nxfile [nx_open $hdffile $NXACC_READ] - set names [array names lof::table] - append result [file tail $hdffile] \n - append result "=======================================================================\n" - foreach name $names { - set status [catch {nx_openpath $nxfile $lof::table($name)} msg] - if {$status == 0} { - set data [nx_getdata $nxfile] - set type [get_nxds_type $data] - if {[string compare $type $NX_CHAR] == 0} { - set value [get_nxds_text $data] - } else { - set value [get_nxds_value $data 0] - } - append result [format "%-20s:%50s" $name $value] \n - } - } - nx_close $nxfile - return $result -} -#----------------------------------------------------------- -proc lof::lof {{num 5}} { - set numor [getcurrentnumor] - for {set n [expr $numor - $num] } {$n < $numor} {incr n} { - append result [readfiledata $n] - append result " \n" - } - return $result -} diff --git a/tcl/log.tcl b/tcl/log.tcl deleted file mode 100644 index fa70cf2a..00000000 --- a/tcl/log.tcl +++ /dev/null @@ -1,84 +0,0 @@ -#----------------------------------------------------------------------------- -# This file implements a LogBook facility for SICS. -# Usage: -# LogBook - lists the current status -# LogBook filename - sets the logbook file name -# LogBook on - starts logging, creates new file -# LogBook off - closes log file -# -# Mark Koennecke, June 1997, initially developed for SANS -# works using one procedure and an array for data. All internal procedures -# start with cli -#---------------------------------------------------------------------------- - -set cliArray(file) default.log -set cliArray(status) off -set cliArray(number) 0 -#--------------------------------------------------------------------------- -proc cliList { } { - global cliArray -# ClientPut [format " LogBook file: %s\n" $cliArray(file)] -# ClientPut [format " Logging: %s " $cliArray(status)] ] - append res [format " LogBook file: %s\n" $cliArray(file)] \ - [format " Logging: %s " $cliArray(status)] - return $res -} -#------------------------------------------------------------------------- -proc cliLogOn { } { - global cliArray - set cmd [list config File $cliArray(file)] - set ret [catch {eval $cmd} msg] - if { $ret != 0 } { - error $msg - } else { - set l [ split $msg = ] - set cliArray(number) [lindex $l 1] - set cliArray(status) on - } -} -#-------------------------------------------------------------------------- -proc cliLogOff { } { - global cliArray - set cmd [list config close $cliArray(number)] - set ret [catch {eval $cmd} msg] - if { $ret != 0 } { - error $msg - } else { - set cliArray(status) off - } -} -#------------------------------------------------------------------------- -proc logbook args { - global cliArray -#---- first case: a listing - if { [llength $args] == 0} { - return [cliList] - } -#---- there must be an argument - set argument [lindex $args 0] -#---- on/ off - if {[string compare "on" $argument] == 0} { - set ret [catch {cliLogOn} msg] - if { $ret != 0 } { - error $msg - } else { - ClientPut OK - } - } elseif {[string compare "off" $argument] == 0} { - set ret [catch {cliLogOff} msg] - if { $ret != 0 } { - error $msg - } else { - ClientPut OK - } - } elseif {[string compare "file" $argument] >= 0} { - if {[llength $args] < 1} { - error "ERROR: nor filename specified for LogBook" - } - set cliArray(file) [lindex $args 1] - } elseif {[string compare "no" $argument] == 0} { - ClientPut $cliArray(number) - } else { - error [format "ERROR: unknown argument %s to LogBook" $argument] - } -} diff --git a/tcl/nhq202m.tcl b/tcl/nhq202m.tcl deleted file mode 100644 index 9b10bd4c..00000000 --- a/tcl/nhq202m.tcl +++ /dev/null @@ -1,145 +0,0 @@ -#---------------------------------------------------------- -# This is a scriptcontext driver for a NHQ 202M high -# voltage power supply as used at the POLDI for the -# detector. This has a peculiar protocol and requires the -# charbychar protocol driver. -# -# If this responds only with ?WCN, then it is on the wrong -# channel. -# -# Mark Koennecke, April 2010 -#-------------------------------------------------------- - -namespace eval nhq202m {} - -#------------------------------------------------------- -# Sometimes numbers come in the form: polarity/mantissse/exponent -# This checks for this and converts it into a proper number -#------------------------------------------------------- -proc nhq202m::fixnumber {num} { - set c [string index $num 0] - if {[string compare $c -] == 0} { - set num [string range $num 1 end] - } - clientput $num - if {[string first - $num] > 0} { - set l [split $num -] - set man [string trimleft [lindex $l 0] 0] - set exp [string trimleft [lindex $l 1] 0] - clientput "$num, $man, $exp" - return [expr $man * pow(10,-$exp)] - } elseif { [string first + $num] > 0} { - set l [split $num +] - set man [string trimleft [lindex $l 0] 0] - set exp [string trimleft [lindex $l 1] 0] - return [expr $man * pow(10,$exp)] - } else { - return $num - } -} -#------------------------------------------------------- -proc nhq202m::sendreadcommand {command} { - sct send $command - return readreply -} -#-------------------------------------------------------- -proc nhq202m::readreply {} { - set val [sct result] - if {[string first ? $val] >= 0} { - clientput "Read Command not understood, result = $val" - } else { - sct update [nhq202m::fixnumber $val] - } - return idle -} -#-------------------------------------------------------- -proc nhq202m::sendwrite {command} { - set val [sct target] - sct send [format "%s=%d" $command $val] - return writereply -} -#------------------------------------------------------ -proc nhq202m::writereply {} { - set val [sct result] - if {[string first ? $val] >= 0} { - clientput "Write command not understood, result = $val" - } - [sct controller] queue [sct] progress read - return idle -} -#---------------------------------------------------- -proc nhq202m::startwrite {} { - hupdate [sct]/stop 0 - set num [sct numpower] - set com [format "D%1.1d" $num] - nhq202m::sendwrite $com - return setreply -} -#---------------------------------------------------- -proc nhq202m::setreply {} { - set val [sct result] - if {[string first ? $val] >= 0} { - clientput "Write command not understood, result = $val" - } - set num [sct numpower] - sct send [format "G%1.1d" $num] - return goreply -} -#---------------------------------------------------- -proc nhq202m::goreply {} { - set badcodes [list MAN ERR OFF] - set val [sct result] - if {[string first ? $val] >= 0} { - clientput "Write command not understood, result = $val" - } - set l [split $val =] - set code [string trim [lindex $l 1]] - if {[lsearch $badcodes $code] >= 0} { - hupdate [sct]/stop 1 - error "Bad code in $val, probably front panel switches fucked up" - } - return idle -} -#---------------------------------------------------- -proc nhq202m::makehv {name sct num} { - makesctdriveobj $name float mugger NHQ202M $sct - hfactory /sics/${name}/tolerance plain mugger int - hset /sics/${name}/tolerance 2 - hfactory /sics/${name}/upperlimit plain mugger int - hset /sics/${name}/upperlimit 4000 - hfactory /sics/${name}/lowerlimit plain mugger int - hset /sics/${name}/lowerlimit 0 - hfactory /sics/${name}/stop plain mugger int - hset /sics/${name}/stop 0 - - hsetprop /sics/${name} checklimits stddrive::stdcheck $name - hsetprop /sics/${name} checkstatus stddrive::stdstatus $name - hsetprop /sics/${name} halt stddrive::stop $name - - hsetprop /sics/${name} read nhq202m::sendreadcommand [format "U%1.1d" $num] - hsetprop /sics/${name} readreply nhq202m::readreply - hsetprop /sics/${name} numpower $num - hsetprop /sics/${name} write nhq202m::startwrite - hsetprop /sics/${name} setreply nhq202m::setreply - hsetprop /sics/${name} goreply nhq202m::goreply - $sct write /sics/${name} - $sct poll /sics/${name} 180 - $sct queue /sics/${name} progress read - - hfactory /sics/${name}/ramp plain mugger int - hsetprop /sics/${name}/ramp read nhq202m::sendreadcommand [format "V%1.1d" $num] - hsetprop /sics/${name}/ramp readreply nhq202m::readreply - hsetprop /sics/${name}/ramp write nhq202m::sendwrite [format "V%1.1d" $num] - hsetprop /sics/${name}/ramp writereply nhq202m::writereply - $sct poll /sics/${name}/ramp 180 - $sct write /sics/${name}/ramp - $sct queue /sics/${name}/ramp progress read - - - hfactory /sics/${name}/current plain mugger int - hsetprop /sics/${name}/current read nhq202m::sendreadcommand [format "N%1.1d" $num] - hsetprop /sics/${name}/current readreply nhq202m::readreply - $sct poll /sics/${name}/current 180 - $sct queue /sics/${name}/current progress read - -} diff --git a/tcl/nvs.tcl b/tcl/nvs.tcl deleted file mode 100644 index 6bbc3a3e..00000000 --- a/tcl/nvs.tcl +++ /dev/null @@ -1,157 +0,0 @@ -#------------------------------------------------------------------------- -# This is a scriptcontext based driver for the NVS at SANS2. This NVS has -# the nasty feauture that its terminators are command dependent. -# -# Mark Koennecke, April 2009 -#----------------------------------------------------------------------- -makesctcontroller nvssct varterm psts229.psi.ch:3007 \n 30 -#makesctcontroller nvssct varterm localhost:8080 \n 30 -nvssct send "\\:REM\n" -nvssct debug -1 -MakeSecNVS nvs tilt nvssct -#---------------------------------------------------------------------------------- -# handle parameters first: Most are in the list. MODE is treated special, as an -# anchor for finding the status part of the reply and as the polled node used for -# updating the parameter list. Date, time and com mode are omitted. -#----------------------------------------------------------------------------------- -set nvsparlist [list R_SPEED A_SPEED P_LOSS R_CURRENT T_ROT T_INL T_OUT F_RATE A_VAC \ - V_OSC V_BCU Hz] - -foreach par $nvsparlist { - hfactory /sics/nvs/${par} plain internal float - nvssct connect /sics/nvs/${par} -} -#----------------------------------------------------------------- -proc nvsstatus {} { - sct send "\n:???\n" - return nvsstatusreply -} -#---------------------------------------------------------------- -# We purposely disregard the geterror mechanism here: it is better to -# have an old value rather then no value -#----------------------------------------------------------------- -proc nvsstatusreply {} { - global nvsparlist - set reply [sct result] - if {[string first ERR $reply] >= 0 \ - || [string first ASCERR $reply] >= 0} { - clientput "ERROR: $reply while reading NVS, parameter NOT updated" - return idle - } - set idx [string first MODE: $reply] - if {$idx < 0} { - clientput "Invalid status reponse $reply received from NVS" - return idle - } - set reply [string range $reply $idx end] - set parlist [split $reply /] - foreach pair $parlist { - set l [split $pair :] - set par [string trim [lindex $l 0]] - set value [string trim [lindex $l 1]] - if {[lsearch $nvsparlist $par] >= 0 || [string first MODE $par] >= 0} { - catch {hupdate /sics/nvs/${par} $value} msg - } - } - set speed [hval /sics/nvs/A_SPEED] - hupdate /sics/nvs $speed - return idle -} -#------------------------------------------------------------------------------- -set path /sics/nvs/MODE -hfactory $path plain internal text -hsetprop $path read nvsstatus -hsetprop $path nvsstatusreply nvsstatusreply -nvssct poll $path 60 -#================================================================================= -# This section cares for driving the NVS. Please note that there are two modes: -# at low speeds the NVS must be started before over 3000 RPM, a new value can be set. -# If ths NVS is already at speed, this step can be saved. -# Also we have to check for limits and forbidden speed regions -#-------------------------------------------------------------------------------- -set nvsrange [list -20 28800] -set nvsforbidden [list {3600 4500} {7800 10500} {21500 23500}] -#-------------------------------------------------------------------------------- -proc nvscheck {} { - global nvsrange nvsforbidden - set target [sct target] - set min [lindex $nvsrange 0] - set max [lindex $nvsrange 1] - if {$target < $min || $target > $max} { - error "$target is out of range" - } - foreach range $nvsforbidden { - set min [lindex $range 0] - set max [lindex $range 1] - if {$target > $min && $target < $max} { - error "$target is in forbidden region" - } - } - return OK -} -#-------------------------------------------------------------------------------- -# Halting for a NVS is interpreted as: leave at current speed -#-------------------------------------------------------------------------------- -proc nvshalt {} { - set current [hval /sics/nvs] - set send [format "\r:SDR %d\n" [expr int($current)]] - return nvsreply -} -#--------------------------------------------------------------------------------- -proc nvsreply {} { - set reply [sct result] - if {[string first ERR $reply] >= 0 \ - || [string first ASCERR $reply] >= 0} { - clientput "ERROR: $reply while driving NVS" - } - return idle -} -#-------------------------------------------------------------------------------- -# checking status -#-------------------------------------------------------------------------------- -proc nvscheckstatus {} { - set mode [sct runmode] - if {[string first start $mode] >= 0} { - return idle - } - set target [sct target] - set actual [hval /sics/nvs/A_SPEED] - if {abs($target - $actual) < 5} { - wait 20 - return idle - } - nvssct queue /sics/nvs/MODE progress read - return busy -} -#-------------------------------------------------------------------------------- -proc nvswrite {} { - set target [sct target] - set actual [hval /sics/nvs/A_SPEED] - if {$target < 50 } { - sct send "\r:HAL\n" - sct runmode halt - return nvsreply - } - if {$actual >= 3000} { - sct send [format "\r:SDR %d\n" [expr int($target)]] - sct runmode normal - } else { - sct send "\r:SST\n" - clientput "NVS started, check manually when done" - sct runmode start - } - return nvsreply -} -#--------------------------------------------------------------------------------- -hsetprop /sics/nvs checklimits nvscheck -hsetprop /sics/nvs checkstatus nvscheckstatus -hsetprop /sics/nvs halt nvshalt -hsetprop /sics/nvs nvsreply nvsreply -hsetprop /sics/nvs write nvswrite -hsetprop /sics/nvs runmode normal -nvssct write /sics/nvs - -nvssct queue /sics/nvs/MODE progress read -nvs tilt - - diff --git a/tcl/nvs20m.tcl b/tcl/nvs20m.tcl deleted file mode 100644 index 855987c8..00000000 --- a/tcl/nvs20m.tcl +++ /dev/null @@ -1,163 +0,0 @@ -#------------------------------------------------------------------------- -# This is a scriptcontext based driver for the NVS at SANS. -# -# script chains: -# -# - status reading: sitting at the Status node -# nvststatus - nvsstatusreply -# - driving: -# nvswrite - nvsreply -# -# Mark Koennecke, May 2009 -#----------------------------------------------------------------------- -makesctcontroller nvssct std psts223.psi.ch:3006 \n 30 -#makesctcontroller nvssct std localhost:8080 \n 30 -nvssct send "REM\n" -nvssct debug -1 -MakeSecNVS nvs tilt nvssct -#---------------------------------------------------------------------------------- -# handle parameters first: Most are in the list. MODE is treated special, as an -# anchor for finding the status part of the reply and as the polled node used for -# updating the parameter list. Date, time and com mode are omitted. -#----------------------------------------------------------------------------------- -set nvsparlist [list S_DREH I_DREH P_VERL STROM T_ROT T_VOR T_RUECK DURCHFL VAKUUM \ - BESCHL BCU Hz] - -foreach par $nvsparlist { - hfactory /sics/nvs/${par} plain internal float - nvssct connect /sics/nvs/${par} -} -#----------------------------------------------------------------- -proc nvsstatus {} { - sct send "???\n" - return nvsstatusreply -} -#---------------------------------------------------------------- -# We purposely disregard the geterror mechanism here: it is better to -# have an old value rather then no value -#----------------------------------------------------------------- -proc nvsstatusreply {} { - global nvsparlist - set reply [sct result] - if {[string first ERR $reply] >= 0 \ - || [string first ASCERR $reply] >= 0} { - clientput "ERROR: $reply while reading NVS, parameter NOT updated" - return idle - } - set idx [string first Status: $reply] - if {$idx < 0} { - clientput "Invalid status reponse $reply received from NVS" - return idle - } - set reply [string range $reply $idx end] - set parlist [split $reply /] - foreach pair $parlist { - set l [split $pair :] - set par [string trim [lindex $l 0]] - set value [string trim [lindex $l 1]] - if {[lsearch $nvsparlist $par] >= 0 || [string first Status $par] >= 0} { - catch {hupdate /sics/nvs/${par} $value} msg - } - } - set speed [hval /sics/nvs/I_DREH] - hupdate /sics/nvs $speed - return idle -} -#------------------------------------------------------------------------------- -set path /sics/nvs/Status -hfactory $path plain internal text -hsetprop $path read nvsstatus -hsetprop $path nvsstatusreply nvsstatusreply -nvssct poll $path 60 -#================================================================================= -# This section cares for driving the NVS. Please note that there are two modes: -# at low speeds the NVS must be started before over 3000 RPM, a new value can be set. -# If ths NVS is already at speed, this step can be saved. -# Also we have to check for limits and forbidden speed regions -#-------------------------------------------------------------------------------- -set nvsrange [list -20 28800] -set nvsforbidden [list {3600 4600} {7600 9600} {1 3599} ] -#-------------------------------------------------------------------------------- -proc nvscheck {} { - global nvsrange nvsforbidden - set target [sct target] - set min [lindex $nvsrange 0] - set max [lindex $nvsrange 1] - if {$target < $min || $target > $max} { - error "$target is out of range" - } - foreach range $nvsforbidden { - set min [lindex $range 0] - set max [lindex $range 1] - if {$target > $min && $target < $max} { - error "$target is in forbidden region" - } - } - return OK -} -#-------------------------------------------------------------------------------- -# Halting for a NVS is interpreted as: leave at current speed -#-------------------------------------------------------------------------------- -proc nvshalt {} { - set current [hval /sics/nvs] - set send [format "SDR %d\n" [expr int($current)]] - return nvsreply -} -#--------------------------------------------------------------------------------- -proc nvsreply {} { - set reply [sct result] - if {[string first ERR $reply] >= 0 \ - || [string first ASCERR $reply] >= 0} { - clientput "ERROR: $reply while driving NVS" - } - return idle -} -#-------------------------------------------------------------------------------- -# checking status -#-------------------------------------------------------------------------------- -proc nvscheckstatus {} { - set mode [sct runmode] - if {[string first start $mode] >= 0} { - return idle - } - set target [sct target] - set actual [hval /sics/nvs/I_DREH] - if {abs($target - $actual) < 5} { - wait 20 - return idle - } - nvssct queue /sics/nvs/Status progress read - return busy -} -#-------------------------------------------------------------------------------- -proc nvswrite {} { - set target [sct target] - set actual [hval /sics/nvs/I_DREH] - if {$target < 50 } { - sct send "HAL\n" - sct runmode halt - return nvsreply - } - if {$actual >= 3000} { - sct send [format "SDR %d\n" [expr int($target)]] - sct runmode normal - } else { - sct send "SST\n" - clientput "NVS started, check manually when done" - sct runmode start - } - return nvsreply -} -#--------------------------------------------------------------------------------- -hsetprop /sics/nvs checklimits nvscheck -hsetprop /sics/nvs checkstatus nvscheckstatus -hsetprop /sics/nvs halt nvshalt -hsetprop /sics/nvs nvsreply nvsreply -hsetprop /sics/nvs write nvswrite -hsetprop /sics/nvs runmode normal -nvssct write /sics/nvs - -nvssct queue /sics/nvs/Status progress read -nvs tilt - - diff --git a/tcl/parray.tcl b/tcl/parray.tcl deleted file mode 100644 index 430e7ff8..00000000 --- a/tcl/parray.tcl +++ /dev/null @@ -1,29 +0,0 @@ -# parray: -# Print the contents of a global array on stdout. -# -# SCCS: @(#) parray.tcl 1.9 96/02/16 08:56:44 -# -# Copyright (c) 1991-1993 The Regents of the University of California. -# Copyright (c) 1994 Sun Microsystems, Inc. -# -# See the file "license.terms" for information on usage and redistribution -# of this file, and for a DISCLAIMER OF ALL WARRANTIES. -# - -proc parray {a {pattern *}} { - upvar 1 $a array - if ![array exists array] { - error "\"$a\" isn't an array" - } - set maxl 0 - foreach name [lsort [array names array $pattern]] { - if {[string length $name] > $maxl} { - set maxl [string length $name] - } - } - set maxl [expr {$maxl + [string length $a] + 2}] - foreach name [lsort [array names array $pattern]] { - set nameString [format %s(%s) $a $name] - puts stdout [format "%-*s = %s" $maxl $nameString $array($name)] - } -} diff --git a/tcl/pfeiffer.tcl b/tcl/pfeiffer.tcl deleted file mode 100644 index 6143b752..00000000 --- a/tcl/pfeiffer.tcl +++ /dev/null @@ -1,138 +0,0 @@ -#--------------------------------------------------------- -# This is a new asynchronous driver for the Pfeiffer -# Vacuum measurement device. This driver has been redone -# in order to better integrate it into the Hipadaba tree -# at FOCUS. -# -# The pfeiffer device is somewhat shitty in that it cannot -# be switched on all the time. What is implemented now is -# this: the looser has to switch the thing on via the state -# field. After that values are read any 2 minutes. After 20 -# minutes the thing switches itself off again. -# -# Then there is a funny protocol. A normal command is easy: -# Host: command -# Pfeiffer: or -# It gets involved when a parameter is requested. Then it looks -# like this: -# Host: command -# Pfeiffer: or -# Host: -# Pfeiffer: something,value -# -# The script chains: -# pfiffstate - pfiffstatereply -# pfiffreadsensor - pfiffenq - pfiffreply -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, March 2009 -#--------------------------------------------------------- -MakeSICSObj pfiff Vacuum -#makesctcontroller pfiffsct pfeiffer localhost:8080 -makesctcontroller pfiffsct pfeiffer $ts:3009 -#pfiffsct debug -1 -set pfiffpar [list Antitrumpet Be-filter Flightpath Sample-Chamber] - -#----------------------------------------------------- -proc pfiffstate {} { - set val [sct target] - if {[string compare $val on] == 0} { - sct send "SEN ,2,2,2,2,0,0" - sct utime devon - } else { - sct send "SEN ,1,1,1,1,0,0" - } - return pfiffstatereply -} -#---------------------------------------------------- -proc pfiffstatereply {} { - sct update [sct target] - return idle -} -#------------------------------------------------------ -# This tests for the state being off -# This also tests if the device has been on for more -# then 20 minutes. If so it is switched off -#------------------------------------------------------ -proc pfiffreadsensor {num} { - set test [hval /sics/pfiff/state] - if {[string compare $test off] == 0} { - sct update "sensor off" - return idle - } - set time [hgetpropval /sics/pfiff/state devon] - if {[clock seconds] > $time + 20*60} { - hset /sics/pfiff/state off - return idle - } - if {$num < 5} { - sct send [format "PR%1.1d" $num] - return pfiffenq - } else { - return idle - } -} -#------------------------------------------------------- -proc pfiffenq {} { - sct send "" - return pfiffreply -} -#------------------------------------------------------- -proc pfiffreply {} { - set reply [sct result] - if {[string first ERR $reply] >= 0 || - [string first ASCER $reply] >= 0} { - sct geterror $reply - return idle - } - set l [split $reply ,] - sct update [lindex $l 1] - hdelprop [sct] geterror - return idle -} -#-------------------------------------------------------- -proc pfiffidle {} { - return idle -} -#--------------------------------------------------------- -set count 1 -foreach p $pfiffpar { - hfactory /sics/pfiff/$p plain internal text - hsetprop /sics/pfiff/$p read "pfiffreadsensor $count" - hsetprop /sics/pfiff/$p pfiffenq pfiffenq - hsetprop /sics/pfiff/$p pfiffreply pfiffreply - pfiffsct poll /sics/pfiff/$p 120 - incr count -} - -hfactory /sics/pfiff/state plain spy text -hupdate /sics/pfiff/state off -hsetprop /sics/pfiff/state values on,off -hsetprop /sics/pfiff/state write pfiffstate -hsetprop /sics/pfiff/state pfiffstatereply pfiffstatereply -pfiffsct write /sics/pfiff/state -#------------------------------------------------------ -proc pfiffread {num} { - global pfiffpar - set par [lindex $pfiffpar [expr $num -1]] - return [hval /sics/pfiff/$par] -} -#-------------------------------------------------------- -proc vac {} { - global pfiffpar - set test [hval /sics/pfiff/state] - if {[string first off $test] >= 0} { - hset /sics/pfiff/state on - foreach p $pfiffpar { - pfiffsct queue /sics/pfiff/$p progress read - } - return "Switched Pfeiffer on, try to read again in a couple of seconds" - } - append result "Antitrumpet : " [pfiffread 1] "\n" - append result "Berylium filter : " [pfiffread 2] "\n" - append result "Flightpath : " [pfiffread 3] "\n" - append result "Sample chamber : " [pfiffread 4] "\n" - return $result -} -Publish vac User diff --git a/tcl/phytron.tcl b/tcl/phytron.tcl deleted file mode 100644 index 60f77e2b..00000000 --- a/tcl/phytron.tcl +++ /dev/null @@ -1,302 +0,0 @@ -#------------------------------------------------------------------ -# This is driver for the combination Phytron MCC-2 Motor Controller -# and SICS using the scriptcontext asynchronous I/O system. The -# MCC-2 has a funny protocl as that messages are enclosed into -# data sequences. This protocol is handled by the -# C-language phytron protocol handler. Per default, the MCC-2 is -# configured to use 57600 baud. I have configured it to use 9600 -# baud and it ought to remember this. The command to change this -# 0IC1S9600, the command to read this is 0IC1R. -# -# So, if this thing does not work on a serial port then the solution is -# to set the terminal server to 57600 and try again. And set the baud rate -# or leave it. -# -# There are surely many ways to use the MCC-2. It supports two axes, X and Y. -# All examples below are given for X only. This driver uses it in -# this way: -# -# Nothing works properly without a reference run. The reference run is done -# in the following way: -# 1) Send it into the negative limit switch with 0X0- -# 2) Set the mechanical position with 0XP20Swert to the negative limit -# 3) Set the encoder position with 0XP22Swert to the negative limit -# -# Position ever afterwards with 0XAwert, read encoder with 0XP22R -# -# While driving 0X=H return ACKN, else ACKE -# -# Stopping goes via 0XSN -# -# copyright: see file COPYRIGHT -# -# Script chains: -# -# - reading position: -# readpos - posrcv -# -# - writing postion: -# setpos - setrcv -# -# - reading status: -# sendstatus - rcvstatus - statpos -# -# - reading speed: -# readspeed - rcvspeed -# -# - setting speed: -# writespeed - rcvwspeed - rcvspeed -# -# Mark Koennecke, June 2009 -# -# Added code to switch a brake on for schneider_m2 -# -# Mark Koennecke, September 2009 -# -# Added code to support the speed parameter -# -# Mark Koennecke, December 2009 -# TODO: speed still has to be tested: 02-12-2009 -#------------------------------------------------------------------------- - -namespace eval phytron {} - -#----------------------------------------------------------------------- -proc phytron::check {} { - set data [sct result] - if {[string first AscErr $data] >= 0} { - error $data - } - return $data -} -#------------------------------------------------------------------------ -proc phytron::readpos {axis} { - sct send "0${axis}P22R" - return posrcv -} -#------------------------------------------------------------------------ -proc phytron::posrcv {} { - set data [phytron::check] - set pos [string range $data 3 end] - sct update $pos - return idle -} -#------------------------------------------------------------------------ -proc phytron::setpos {axis name} { - set val [sct target] - sct send "0${axis}A$val" - hupdate /sics/${name}/status run - return setrcv -} -#------------------------------------------------------------------------ -proc phytron::setrcv {controller name} { - set data [phytron::check] - if {[string first NACK $data] >= 0} { - error "Invalid command" - } - $controller queue /sics/${name}/status progress read - return idle -} -#------------------------------------------------------------------------- -proc phytron::sendstatus {axis} { - sct send "0${axis}=H" - return rcvstatus -} -#------------------------------------------------------------------------- -proc phytron::rcvstatus {axis controller} { - set status [catch {phytron::check} data] - if {$status != 0} { - sct update error - clientput $error - } - if {[string first ACKN $data] >= 0} { - sct update run - $controller queue [sct] progress read - } - if {[string first ACKE $data] >= 0} { - phytron::readpos $axis - return posrcv - } - return idle -} -#------------------------------------------------------------------------- -proc phytron::statpos {axis name} { - set data [phytron::check] - set pos [string range $data 3 end] - hupdate /sics/${name}/hardposition $pos - sct send "0${axis}=I+" - return statposlim -} -#------------------------------------------------------------------------ -proc phytron::statposlim {axis} { - set data [phytron::check] - if {[string first ACKE $data] >= 0} { - sct update error - clientput "Hit positive limit switch" - return idle - } - sct send "0${axis}=I-" - return statneglim -} -#------------------------------------------------------------------------ -proc phytron::statneglim {axis} { - set data [phytron::check] - if {[string first ACKE $data] >= 0} { - sct update error - clientput "Hit negative limit switch" - return idle - } - sct send "0${axis}=E" - return statend -} -#------------------------------------------------------------------------ -proc phytron::statend {axis} { - set data [phytron::check] - if {[string first ACKE $data] >= 0} { - sct update error - clientput "Electronics error" - return idle - } - sct update idle - return idle -} -#------------------------------------------------------------------------ -proc phytron::readspeed {axis} { - sct send "0${axis}P14R" - return rcvspeed -} -#------------------------------------------------------------------------ -proc phytron::rcvspeed {} { - set data [phytron::check] - set speed [string range $data 3 end] - sct update $speed - return idle -} -#------------------------------------------------------------------------ -proc phytron::writespeed {axis} { - set val [sct target] - sct send "0${axis}P14S$val" - return rcvwspeed -} -#------------------------------------------------------------------------ -proc phytron::rcvwspeed {axis} { - set data [phytron::check] - if {[string first NACK $data] >= 0} { - error "Invalid command" - } - return [phytron::readspeed $axis] -} -#------------------------------------------------------------------------- -proc phytron::halt {controller axis} { - $controller send "0${axis}SN" - return Done -} -#-------------------------------------------------------------------------- -proc phytron::refrun {name controller axis lowlim} { - set path /sics/${name}/status - $controller send "0${axis}0-" - hupdate $path run - set motstat run - wait 3 - while {[string compare $motstat run] == 0} { - $controller queue $path progress read - wait 1 - set motstat [string trim [hval $path]] - } - $controller transact "0${axis}P20S$lowlim" - $controller transact "0${axis}P22S$lowlim" - return Done -} -#------------------------------------------------------------------------- -proc phytron::defpos {controller axis value} { - $controller transact "0${axis}P20S$value" - $controller transact "0${axis}P22S$value" - return Done -} -#-------------------------------------------------------------------------- -proc phytron::make {name axis controller lowlim upperlim} { - MakeSecMotor $name - - hdel /sics/${name}/hardupperlim - hdel /sics/${name}/hardlowerlim - hfactory /sics/${name}/hardupperlim plain internal float - hfactory /sics/${name}/hardlowerlim plain internal float - $name hardlowerlim $lowlim - $name softlowerlim $lowlim - $name hardupperlim $upperlim - $name softupperlim $upperlim - - hsetprop /sics/${name}/hardposition read phytron::readpos $axis - hsetprop /sics/${name}/hardposition posrcv phytron::posrcv - $controller poll /sics/${name}/hardposition 60 - - hsetprop /sics/${name}/hardposition write phytron::setpos $axis $name - hsetprop /sics/${name}/hardposition setrcv phytron::setrcv $controller $name - $controller write /sics/${name}/hardposition - - hsetprop /sics/${name}/status read phytron::sendstatus $axis - hsetprop /sics/${name}/status rcvstatus phytron::rcvstatus $axis $controller - hsetprop /sics/${name}/status posrcv phytron::statpos $axis $name - hsetprop /sics/${name}/status statposlim phytron::statposlim $axis - hsetprop /sics/${name}/status statneglim phytron::statneglim $axis - hsetprop /sics/${name}/status statend phytron::statend $axis - $controller poll /sics/${name}/status 60 - - hfactory /sics/${name}/speed plain user float - hsetprop /sics/${name}/speed read "phytron::readspeed $axis" - hsetprop /sics/${name}/speed rcvspeed "phytron::rcvspeed" - hsetprop /sics/${name}/speed write "phytron::writespeed $axis" - hsetprop /sics/${name}/speed rcvwspeed "phytron::rcvwspeed $axis" - $controller poll /sics/${name}/speed 60 - $controller write /sics/${name}/speed - - $name makescriptfunc halt "phytron::halt $controller $axis" user - - $name makescriptfunc refrun "phytron::refrun $name $controller $axis $lowlim" user - - $name makescriptfunc sethardpos "phytron::defpos $controller $axis" user - hfactory /sics/${name}/sethardpos/value plain user float - - hupdate /sics/${name}/status idle - $controller queue /sics/${name}/hardposition progress read - $controller queue /sics/${name}/speed progress read -} -#=============================================================================================== -# At MORPHEUS there is a special table where one motor needs a brake. This requires a digital I/O -# to be disabled before driving and enabled after driving. The code below adds this feature to -# a phytron motor -#----------------------------------------------------------------------------------------------- -proc phytron::openset {out} { - sct send [format "0A%dS" $out] - return openans -} -#---------------------------------------------------------------------------------------------- -proc phytron::openans {axis name} { - after 100 - return [phytron::setpos $axis $name] -} -#---------------------------------------------------------------------------------------------- -proc phytron::outsend {axis out} { - set data [phytron::check] - if {[string first ACKE $data] >= 0} { - sct update error - clientput "Electronics error" - return idle - } - sct send [format "0A%dR" $out] - return outend -} -#---------------------------------------------------------------------------------------------- -proc phytron::outend {} { - sct update idle - return idle -} -#---------------------------------------------------------------------------------------------- -proc phytron::configureM2 {motor axis out} { - set path /sics/${motor} - hsetprop $path/hardposition write phytron::openset $out - hsetprop $path/hardposition openans phytron::openans $axis $motor - - hsetprop $path/status statend phytron::outsend $axis $out - hsetprop $path/status outend phytron::outend -} diff --git a/tcl/pimotor.tcl b/tcl/pimotor.tcl deleted file mode 100644 index d7ddf5ea..00000000 --- a/tcl/pimotor.tcl +++ /dev/null @@ -1,156 +0,0 @@ -#---------------------------------------------------- -# This is a scriptcontext motor driver for the -# prehistoric Physik Instrumente DC-406 DC motor -# controller. -# -# copyright: see file COPYRIGHT -# -# Scriptchains: -# - read - readreply -# - write - writerepy -# - sendstatus - statusreply - statuspos -# - speedread - readreply -# - writespeed - speedreply -# - writenull - speedreply -# -# Mark Koennecke, Neovember 2009, after the -# C original from 1998 -#----------------------------------------------------- - -namespace eval pimotor {} -#---------------------------------------------------- -proc pimotor::read {num} { - sct send [format "%1.1dTP" $num] - return readreply -} -#---------------------------------------------------- -proc pimotor::readreply {} { - set result [sct result] - if {[string first ? $result] >= 0} { - error $result - } - set val [string range $result 3 end] - sct update $val - return idle -} -#---------------------------------------------------- -proc pimotor::write {num name} { - set ival [expr int([sct target])] - sct send [format "%1.1dMA%10.10d{0}" $num $ival] - hupdate /sics/${name}/status run - return writereply -} -#---------------------------------------------------- -proc pimotor::writereply {} { -# the DC-406 does not reply on this, so we have for sure a -# timeout here which we ignore. We do nothing else, as we -# need a little wait anyway to get the motor to start -# before starting to check status. - wait 2 - set con [sct controller] - $con queue /sics/${name}/status progress read - return idle -} -#----------------------------------------------------- -proc pimotor::sendstatus {num} { - sct send [format "%1.1dTV" $num] - return statusreply -} -#------------------------------------------------------ -proc pimotor::statusreply {num} { - set result [sct result] - if {[string first ? $result] >= 0} { - sct update error - error $result - } - set val [string range $result 3 end] - if {abs($val) > 0} { - sct update run - [sct controller] queue sct progress read - } else { - pimotor::read $num - return statuspos - } - return idle -} -#------------------------------------------------------ -proc pimotor::statuspos {name} { - set result [sct result] - if {[string first ? $result] >= 0} { - error $result - } - set val [string range $result 3 end] - hupdate /sics/${name} $val - return idle -} -#------------------------------------------------------- -proc pimotor::readspeed {num} { - sct send [format "%1.1dTY" $num] - return readreply -} -#-------------------------------------------------------- -proc pimotor::writespeed {num} { - sct send [format "%1.1dSV%7.7d{0}" $num [sct target]] - return speedreply -} -#---------------------------------------------------- -proc pimotor::emptyreply {} { - return idle -} -#----------------------------------------------------- -proc pimotor::writenull {controller num} { - $controller send [format "%1.1dDH{0}" $num] - return Done -} -#------------------------------------------------------ -proc pimotor::writeon {controller num} { - $controller send [format "%1.1dMN{0}" $num] - return Done -} -#------------------------------------------------------ -proc pimotor::halt {controller num} { - $controller send [format "%1.1dAB{0}" $num] - return Done -} -#------------------------------------------------------ -proc pimotor::makepimotor {name num sct lowlim upperlim} { - MakeSecMotor $name - - hdel /sics/${name}/hardupperlim - hdel /sics/${name}/hardlowerlim - hfactory /sics/${name}/hardupperlim plain internal float - hfactory /sics/${name}/hardlowerlim plain internal float - $name hardlowerlim $lowlim - $name softlowerlim $lowlim - $name hardupperlim $upperlim - $name softupperlim $upperlim - - hsetprop /sics/${name}/hardposition read pimotor::read $num - hsetprop /sics/${name}/hardposition readreply pimotor::readreply - $sct poll /sics/${name} 60 - - hsetprop /sics/${name}/hardposition write pimotor::write $num $name - hsetprop /sics/${name}/hardposition writereply pimotor::writereply - $sct write /sics/${name}/hardposition - - hsetprop /sics/${name}/status read pimotor::sendstatus $num - hsetprop /sics/${name}/status statusreply pimotor::statusreply $num - hsetprop /sics/${name}/status statuspos pimotor::statuspos $name - $sct poll /sics/${name}/status 60 - - hfactory /sics/${name}/speed plain user int - hsetprop /sics/${name}/speed read pimotor::speedread $num - hsetprop /sics/${name}/speed readreply pimotor::readreply - $sct poll /sics/${name}/speed 120 - - hsetprop /sics/${name}/speed write pimotor::writespeed $num - hsetprop /sics/${name}/speed speedreply pimotor::speedreply - $sct write /sics/${name}/speed - - $name makescriptfunc halt "pimotor::halt $sct $num" user - $name makescriptfunc on "pimotor::writeon $sct $num" user - $name makescriptfunc home "pimotor::writenull $sct $num" user - - hupdate /sics/${name}/status idle - $sct queue /sics/${name}/hardposition progress read -} diff --git a/tcl/reflist.tcl b/tcl/reflist.tcl deleted file mode 100644 index c39caf37..00000000 --- a/tcl/reflist.tcl +++ /dev/null @@ -1,79 +0,0 @@ -#--------------------------------------------------------------------------- -# The first step when doing a four circle experiment is to search -# reflections manually. When some have been found a UB-matrix calculation -# can be tried. In between it is necessary to keep a list of peak positons -# found and to write them to file. This is exactly what this is for. -# -# Mark Koennecke, October 1998 -#--------------------------------------------------------------------------- - -#----- where data files shall go by default -set prefix ./ - -#-------------------------------------------------------------------------- -proc iiGetNum { text } { - set list [split $text =] - return [lindex $list 1] -} - -#------------ clear everything -proc iiinit {} { - global iiref - set iiref(np) 0 - set iiref(OM) "" - set iiref(TH) "" - set iiref(CH) "" - set iiref(PH) "" - set iiref(title) "" -} -#------- run this once when loading in order to empty space -iiinit -#------------------- store -proc iistore {} { - global iiref - incr iiref(np) - lappend iiref(OM) [iiGetNum [OM]] - lappend iiref(TH) [iiGetNum [TH]] - lappend iiref(CH) [iiGetNum [CH]] - lappend iiref(PH) [iiGetNum [PH]] - lappend iiref(title) [iiGetNum [title]] -} -#------------- write to file -proc iiwrite {fil} { - global iiref - global prefix - set fd [open $prefix/$fil w] - for {set i 0} {$i < $iiref(np)} { incr i } { - set om [lindex $iiref(OM) $i] - set th [lindex $iiref(TH) $i] - set ch [lindex $iiref(CH) $i] - set ph [lindex $iiref(PH) $i] - set tt [lindex $iiref(title) $i] - puts $fd [format "%8.2f %8.2f %8.2f %8.2f %d %s" $th $om $ch $ph $i $tt] - } - close $fd -} -#------------------- the actual control implementation function -proc rliste args { - if {[llength $args] < 1} { - error "ERROR: keyword expected to rliste" - } - switch [lindex $args 0] { - "clear" { - iiinit - return - } - "store" { - iistore - } - "write" { - if { [llength $args] < 2 } { - error "ERROR: expected filename after write" - } - iiwrite [lindex $args 1] - } - default { - error "ERROR: keyword [lindex $args 0] not recognized" - } - } -} diff --git a/tcl/scan.tcl b/tcl/scan.tcl deleted file mode 100644 index fff4af29..00000000 --- a/tcl/scan.tcl +++ /dev/null @@ -1,74 +0,0 @@ -#---------------------------------------------------------------------------- -# A simple scan command for DMC. This allows scanning a motor against the -# monitors. This is useful for adjusting DMC. No fancy file writing is done. -# This code relies on (and checks for) the LogBook being active. -# -# Mark Koennecke, Juli 1997 -#--------------------------------------------------------------------------- - -#----- internal: check LogBook is on. -proc scan:CheckLog { } { - set text [LogBook] - if { [string match Log*:*on $text] } { - return 1 - } else { - return 0 - } -} -#------ internal: get Monitor value -proc scan:monitor { num } { - set reply [counter GetMonitor $num] - set l [split $reply =] - return [lindex $l 1] -} - -#------ actual scan command -proc scan { motor start step n {mode NULL } { preset NULL } } { -#----- check for existence of LogBook -# set ret [scan:CheckLog] -# if { $ret != 1 } { -# ClientPut "ERROR: logging must be active for scan" -# ClientPut $ret -# return -# } -#----- is motor reallly countable ? - set ret [SICSType $motor] - if { [string compare $ret "DRIV"] != 0 } { - ClientPut [format "ERROR: %s not drivable" $motor] - return - } -#----- 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 - } -#------- write output header - ClientPut [format "%10.10s Monitor0 Monitor1" $motor] - -#------ the scan loop - for { set i 0} { $i < $n } { incr i } { -#--------- drive - set pos [expr $start + $i * $step] - set ret [catch "drive $motor $pos" msg] - if { $ret != 0 } { - ClientPut "ERROR: driving motor" - ClientPut $msg - } -#---------- count - banana count - Success -#---------- create output - set m0 [scan:monitor 0] - set m1 [scan:monitor 1] - ClientPut [format "%10.2f %11.11d %11.11d" $pos $m0 $m1] - } - ClientPut "Scan finished !" -} diff --git a/tcl/scancom.tcl b/tcl/scancom.tcl deleted file mode 100644 index f4919172..00000000 --- a/tcl/scancom.tcl +++ /dev/null @@ -1,542 +0,0 @@ -#-------------------------------------------------------------------------- -# general scan command wrappers for TOPSI and the like. -# New version using the object.tcl system from sntl instead of obTcl which -# caused a lot of trouble with tcl8.0 -# -# Requires the built in scan command xxxscan. -# -# Mark Koennecke, February 2000 -#-------------------------------------------------------------------------- - -#---------- adapt to the local settings -set home /data/koenneck/src - -source $home/sics/object.tcl - -set datapath $home/tmp -set recoverfil $home/tmp/recover.bin - -#-------------------------- some utility functions ------------------------- -proc MC { t n } { - set string $t - for { set i 1 } { $i < $n } { incr i } { - set string [format "%s%s" $string $t] - } - return $string -} -#-------------------------------------------------------------------------- -proc GetNum { text } { - set list [split $text =] - return [lindex $list 1] -} -#--------------------------------------------------------------------------- - - -#************** Definition of scan class ********************************** - -object_class ScanCommand { - member Mode Monitor - member NP 1 - member counter counter - member NoVar 0 - member Preset 10000 - member File default.dat - member pinterest "" - member Channel 0 - member Active 0 - member Recover 0 - member scanvars - member scanstart - member scanstep - member pinterest - - method var {name start step} { - # check for activity - if {$slot(Active)} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - # check parameters - set t [SICSType $name] - if { [string compare $t DRIV] != 0 } { - ClientPut [format "ERROR: %s is not drivable" $name] error - return 0 - } - set t [SICSType $start] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $start] error - return 0 - } - set t [SICSType $step] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $step] error - return 0 - } -# install the variable - set i $slot(NoVar) - incr slot(NoVar) - lappend slot(scanvars) $name - lappend slot(scanstart) $start - lappend slot(scanstep) $step - $self SendInterest pinterest ScanVarChange - ClientPut OK - } - - method info {} { - if { $slot(NoVar) < 1 } { - return "0,1,NONE,0.,0.,default.dat" - } - append result $slot(NP) "," $slot(NoVar) - for {set i 0} { $i < $slot(NoVar) } { incr i} { - append result "," [lindex $slot(scanvars) $i] - } - append result "," [lindex $slot(scanstart) 0] "," \ - [lindex $slot(scanstep) 0] - set r1 [xxxscan getfile] - set l1 [split $r1 "="] - append result "," [lindex $l1 1] - return $result - } - - method getvars {} { - set list "" - lappend list $slot(scanvars) - return [format "scan.Vars = %s -END-" $list] - } - - method xaxis {} { - if { $slot(NoVar) <= 0} { -#---- default Answer - set t [format "%s.xaxis = %f %f" $self 0 1] - } else { - set t [format "%s.xaxis = %f %f" $self [lindex $slot(scanstart) 0] \ - [lindex $slot(scanstep) 0] ] - } - ClientPut $t - } - - method cinterest {} { - xxxscan interest - } - - method uuinterest {} { - xxxscan uuinterest - } - - method pinterest {} { - set nam [GetNum [config MyName]] - lappend $slot(pinterest) $nam - } - - method SendInterest { type text } { -#------ check list first - set l1 $slot($type) - set l2 "" - foreach e $l1 { - set b [string trim $e] - set g [string trim $b "{}"] - set ret [SICSType $g] - if { [string first COM $ret] >= 0 } { - lappend l2 $e - } - } -#-------- update scan data and write - set slot($type) $l2 - foreach e $l2 { - set b [string trim $e] - $b put $text - } - } - - method mode { {NewVal NULL} } { - if { [string compare $NewVal NULL] == 0 } { - set val [format "%s.Mode = %s" $self $slot(Mode)] - ClientPut $val - return $val - } else { -# check for activity - if {$slot(Active)} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - set tmp [string tolower $NewVal] - set NewVal $tmp - if { ([string compare $NewVal "timer"] == 0) || \ - ([string compare $NewVal monitor] ==0) } { - set slot(Mode) $NewVal - ClientPut OK - } else { - ClientPut [format "ERROR: %s not recognized as ScanMode" $NewVal] - } - } - } - - method np { { NewVal NULL } } { - if { [string compare $NewVal NULL] == 0 } { - set val [format "%s.NP = %d" $self $slot(NP)] - ClientPut $val - return $val - } else { -# check for activity - if {$slot(Active)} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - set t [SICSType $NewVal] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number" $NewVal] error - return - } - set slot(NP) $NewVal - ClientPut OK - } - } - - method preset { {NewVal NULL} } { - if { [string compare $NewVal NULL] == 0 } { - set val [format "%s.Preset = %f" $self $slot(Preset)] - ClientPut $val - return $val - } else { -# check for activity - if {$slot(Active)} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - set t [SICSType $NewVal] - if { [string compare $t NUM] != 0} { - ClientPut [format "ERROR: %s is no number" $NewVal] error - return - } - set slot(Preset) $NewVal - ClientPut OK - } - } - - method file {} { - return [xxxscan file] - } - - method setchannel {num} { - set ret [catch {xxxscan setchannel $num} msg] - if { $ret == 0} { - set slot(Channel) $num - } else { - return $msg - } - } - - method list { } { - ClientPut [format "%s.Preset = %f" $self $slot(Preset)] - ClientPut [format "%s.Mode = %s" $self $slot(Mode)] - ClientPut [format "%s.File = %s" $self $slot(File)] - ClientPut [format "%s.NP = %d" $self $slot(NP)] - ClientPut [format "%s.Channel = %d" $self $slot(Channel)] - ClientPut "ScanVariables:" - for { set i 0 } {$i < $slot(NoVar) } { incr i } { - ClientPut [format " %s %f %f" [lindex $slot(scanvars) $i] \ - [lindex $slot(scanstart) $i] \ - [lindex $slot(scanstep) $i] ] - } - } - - method clear {} { -# check for activity - if {$slot(Active)} { - ClientPut "ERROR: cannot clear running scan" error - return - } - - set slot(NP) 0 - set slot(NoVar) 0 - set slot(scanvars) "" - set slot(scanstart) "" - set slot(scanstep) "" - $self SendInterest pinterest ScanVarChange - xxxscan clear - ClientPut OK - } - - method getcounts {} { - return [xxxscan getcounts] - } - - method run { } { -# start with error checking - if { $slot(NP) < 1 } { - ClientPut "ERROR: Insufficient Number of ScanPoints" - return - } - if { $slot(NoVar) < 1 } { - ClientPut "ERROR: No variables to scan given!" - return - } -#------- check for activity - if {$slot(Active)} { - ClientPut "ERROR: Scan already in progress" error - return - } - xxxscan clear - for {set i 0 } { $i < $slot(NoVar)} {incr i} { - set ret [catch {xxxscan add [lindex $slot(scanvars) $i] \ - [lindex $slot(scanstart) $i] [lindex $slot(scanstep) $i]} msg] - if {$ret != 0} { - set slot(Active) 0 - error $msg - } - } - set slot(Active) 1 - set ret [catch \ - {xxxscan run $slot(NP) $slot(Mode) $slot(Preset)} msg] - set slot(Active) 0 - if {$ret != 0 } { - error $msg - } else { - return "Scan Finished" - } - } - - method recover {} { - set slot(Active) 1 - catch {xxxscan recover} msg - set slot(Active) 0 - return "Scan Finished" - } - - method forceclear {} { - set slot(Active) 0 - } -} -#---- end of ScanCommand definition - -#********************** initialisation of module commands to SICS ********** - -set ret [catch {scan list} msg] -#if {$ret != 0} { - object_new ScanCommand scan - Publish scan Spy - VarMake lastscancommand Text User - Publish scancounts Spy - Publish textstatus Spy - Publish cscan User - Publish sscan User - Publish sftime Spy - Publish scaninfo Spy - Publish wwwsics Spy -#} - -#************************************************************************* - -#===================== Helper commands for status display work ============ -# a new user command which allows status clients to read the counts in a scan -# This is just to circumvent the user protection on scan -proc scancounts { } { - set status [ catch {scan getcounts} result] - if { $status == 0 } { - return $result - } else { - return "scan.Counts= 0" - } -} -#--------------------------------------------------------------------------- -# This is just another utilility function which helps in implementing the -# status display client -proc textstatus { } { - set text [status] - return [format "Status = %s" $text] -} -#--------------------------------------------------------------------------- -# Dumps time in a useful format -proc sftime {} { - return [format "sicstime = %s" [sicstime]] -} -#------------------------------------------------------------------------- -# Utility function which gives scan parameters as an easily parsable -# comma separated list for java status client -proc scaninfo {} { - set result [scan info] - set r1 [sample] - set inf [string first = $r1] - if {$inf > 0} { - incr inf - set sa [string range $r1 $inf end] - } else { - set sa Unknown - } - regsub -all , $sa " " sam - append result "," $sam - append result "," [sicstime] - set r1 [lastscancommand] - set l1 [split $r1 "="] - append result "," [lindex $l1 1] - return [format "scaninfo = %s" $result] -} -#---------------------------------------------------------------------- -# wwwsics is a procedure which formats the most important status -# information for the WWW-status. -proc wwwsics {} { -#----- get all the data we need - set user [GetNum [user]] - set sample [GetNum [sample]] - set tit [GetNum [title]] - set ret [catch {lambda} msg] - if {$ret != 0 } { - set lam Undetermined - } else { - set lam [GetNum $msg] - } - set lscan [GetNum [lastscancommand]] - set svar [GetNum [scan getvars]] - set ind [string last -END- $svar] - if { $ind > 2 } { - set svar [string range $svar 0 $ind] - } else { - set svar " " - } - set res [scan info] - set l [split $res ,] - set fil [lindex $l 5] - set run [GetNum [sicsdatanumber]] - set stat [GetNum [status]] -#------- html format the reply - append result "" - append result - append result - append result - append result - append result - append result - append result - append result - append result - append result
Run Number $run
Title $tit
User $user
Sample $sample
wavelength $lam
Status $stat
Scan Variables $svar
File $fil
Last Scan Command $lscan
- return $result -} -#===================== Syntactical sugar around scan =================== -# center scan. A convenience scan for the one and only Daniel Clemens -# at TOPSI. Scans around a given center point. Requires the scan command -# for TOPSI to work. -# -# another convenience scan: -# sscan var1 start end var1 start end .... np preset -# scans var1, var2 from start to end with np steps and a preset of preset -# -# Mark Koennecke, August, 22, 1997 -#----------------------------------------------------------------------------- -proc cscan { var center delta np preset } { -#------ start with some argument checking - set t [SICSType $var] - if { [string compare $t DRIV] != 0 } { - ClientPut [format "ERROR: %s is NOT drivable!" $var] - return - } - set t [SICSType $center] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $center] - return - } - set t [SICSType $delta] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $delta] - return - } - set t [SICSType $np] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $np] - return - } - set t [SICSType $preset] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $preset] - return - } -#-------- store command in lastscancommand - set txt [format "cscan %s %s %s %s %s" $var $center \ - $delta $np $preset] - catch {lastscancommand $txt} -#-------- set standard parameters - scan clear - scan preset $preset - scan np [expr $np*2 + 1] -#--------- calculate start - set start [expr $center - $np * $delta] - set ret [catch {scan var $var $start $delta} msg] - if { $ret != 0} { - ClientPut $msg - return - } -#---------- start scan - set ret [catch {scan run} msg] - if {$ret != 0} { - error $msg - } -} -#--------------------------------------------------------------------------- -proc sscan args { - scan clear -#------- check arguments: the last two must be preset and np! - set l [llength $args] - if { $l < 5} { - ClientPut "ERROR: Insufficient number of arguments to sscan" - return - } - set preset [lindex $args [expr $l - 1]] - set np [lindex $args [expr $l - 2]] - set t [SICSType $preset] - ClientPut $t - ClientPut [string first $t "NUM"] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: expected number for preset, got %s" \ - $preset] - return - } - set t [SICSType $np] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: expected number for np, got %s" \ - $np] - return - } - scan preset $preset - scan np $np -#--------- do variables - set nvar [expr ($l - 2) / 3] - for { set i 0 } { $i < $nvar} { incr i } { - set var [lindex $args [expr $i * 3]] - set t [SICSType $var] - if {[string compare $t DRIV] != 0} { - ClientPut [format "ERROR: %s is not drivable" $var] - return - } - set start [lindex $args [expr ($i * 3) + 1]] - set t [SICSType $start] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: expected number for start, got %s" \ - $start] - return - } - set end [lindex $args [expr ($i * 3) + 2]] - set t [SICSType $end] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: expected number for end, got %s" \ - $end] - return - } -#--------- do scan parameters - set step [expr double($end - $start)/double($np)] - set ret [catch {scan var $var $start $step} msg] - if { $ret != 0} { - ClientPut $msg - return - } - } -#------------- set lastcommand text - set txt [format "sscan %s" [join $args]] - catch {lastscancommand $txt} -#------------- start scan - set ret [catch {scan run} msg] - if {$ret != 0} { - error $msg - } -} - - diff --git a/tcl/secsim.tcl b/tcl/secsim.tcl deleted file mode 100644 index 498ddb92..00000000 --- a/tcl/secsim.tcl +++ /dev/null @@ -1,66 +0,0 @@ -#--------------------------------------------------------------- -# This is a second generation simulation motor. -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, December 2008 -#---------------------------------------------------------------- -proc simhardset {motname newval} { - hset /sics/$motname/starttime [clock sec] -} -#-------------------------------------------------------------- -proc simhardget {motname} { - set stat [hval /sics/$motname/status] - set val [hval /sics/$motname/targetposition] - if {[string first run $stat] >= 0 \ - || [string first error $stat] >= 0 } { - return [expr $val -.777] - } else { - return $val - } -} -#------------------------------------------------------------- -proc simhardfaultget {motname} { - set val [hval /sics/$motname/targetposition] - return [expr $val - .5] -} -#-------------------------------------------------------------- -proc simstatusget {motname} { - set start [hval /sics/$motname/starttime] - if {$start < 0} { - return error - } - set delay [hval /sics/$motname/delay] - if {[clock sec] > $start + $delay} { - return idle - } else { - return run - } -} -#------------------------------------------------------------- -proc simstatusfault {motname } { - clientput "ERROR: I am feeling faulty!" - return error -} -#-------------------------------------------------------------- -proc simhalt {motname} { - hset /sics/$motname/starttime -100 -} -#--------------------------------------------------------------- -proc MakeSecSim {name lower upper delay} { - MakeSecMotor $name - hfactory /sics/$name/delay plain user text - hfactory /sics/$name/starttime plain user int - hset /sics/$name/delay $delay - hdel /sics/$name/hardposition - hfactory /sics/$name/hardposition script "simhardget $name" "simhardset $name" float -# hfactory /sics/$name/hardposition script "simhardfaultget $name" "simhardset $name" float - hdel /sics/$name/status - hfactory /sics/$name/status script "simstatusget $name" hdbReadOnly text -# hfactory /sics/$name/status script "simstatusfault $name" hdbReadOnly text - $name makescriptfunc halt "simhalt $name" user - hupdate /sics/$name/hardupperlim $upper - hupdate /sics/$name/softupperlim $upper - hupdate /sics/$name/hardlowerlim $lower - hupdate /sics/$name/softlowerlim $lower -} diff --git a/tcl/sicstcldebug.tcl b/tcl/sicstcldebug.tcl deleted file mode 100644 index 1139e8fc..00000000 --- a/tcl/sicstcldebug.tcl +++ /dev/null @@ -1,74 +0,0 @@ -#------------------------------------------------------------------ -# This is a helper file in order to debug SICS Tcl scripts. The idea -# is that a connection to a SICS interpreter at localhost:2911 is opened. -# Then unknown is reimplemented to send unknown commands (which must be -# SICS commands) to the SICS interpreter for evaluation. This is done -# with transact in order to figure out when SICS finished processing. -# Thus is should be possible to debug SICS Tcl scripts in a normal -# standalone interpreter without the overhead of restarting SICS -# all the time. It may even be possible to use one of the normal -# Tcl debuggers then.... -# -# Mark Koennecke, February 2006 -# -# Revamped for use in testing SICS instruments. -# Mark Koennecke, November 2006 -#------------------------------------------------------------------ -set host(amor) amor.psi.ch -set host(dmc) dmc.psi.ch -set host(focus) focus.psi.ch -set host(hrpt) hrpt.psi.ch -set host(mars) mars.psi.ch -set host(morpheus) morpheus.psi.ch -set host(narziss) narziss.psi.ch -set host(poldi) poldi.psi.ch -set host(rita2) rita2.psi.ch -set host(sans) sans.psi.ch -set host(sansli) sans2.psi.ch -set host(tasp) tasp.psi.ch -set host(trics) trics.psi.ch -set host(local) localhost - -#------------------------------------------------------------------- -# initialize the socket before debugging. If local == 1, then a -# connection to localhost is built -#------------------------------------------------------------------ -proc initSicsDebug {instrument} { - global socke host - catch {close $socke} - set status [catch {set compi $host($instrument)} msg] - if {$status != 0} { - error "Host for $instrument not found" - } - set socke [socket $compi 2911] - gets $socke - puts $socke "Spy 007" - flush $socke - gets $socke -} -#---------------------------------------------------------------- -proc sicscommand args { - global socke - append com "transact " [join $args] - puts stdout "Sending: $com" - puts $socke $com - flush $socke - set reply "" - while {1} { - set line [gets $socke] - if {[string first TRANSACTIONFINISHED $line] >= 0} { - return $reply - } else { - append reply $line "\n" - } - } -} -#------------------------------------------------------------------ -proc unknown args { - return [sicscommand $args] -} -#------------------------------------------------------------------ -proc clientput args { - puts stdout [join $args] -} -#------------------------------------------------------------------ diff --git a/tcl/simhm.tcl b/tcl/simhm.tcl deleted file mode 100644 index 8785d093..00000000 --- a/tcl/simhm.tcl +++ /dev/null @@ -1,91 +0,0 @@ -#----------------------------------------------------- -# This is a simulation driver for the second -# generation histogram memory. It provides -# for a fill value which is used to initialize -# data. -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, January 2010 -#----------------------------------------------------- -namespace eval simhm {} -#----------------------------------------------------- -proc simhm::getcontrol {name} { - return -9999.99 -} -#---------------------------------------------------- -proc simhm::setcontrol {name val} { - switch $val { - 1000 { - hset /sics/${name}/internalstatus run - set pp [hval /sics/${name}/preset] - hset /sics/${name}/finishtime [expr $pp + [clock seconds]] - return idle - } - 1001 { - hset /sics/${name}/internalstatus error - return idle - } - 1002 { - hset /sics/${name}/internalstatus pause - return idle - } - 1003 { - hset /sics/${name}/internalstatus run - return idle - } - 1005 { - return idle - } - default { - clientput "ERROR: bad start target $target given to control" - return idle - } - } -} -#---------------------------------------------------- -proc simhm::getstatus {name} { - set status [string trim [hval /sics/${name}/internalstatus]] - if {[string first run $status] >= 0} { - set fin [string trim [hval /sics/${name}/finishtime]] - if {[clock seconds] > $fin} { - hset /sics/${name}/internalstatus idle - set val [string trim [hval /sics/${name}/initval]] - $name set $val - set second [string trim [hval /sics/${name}/secondbank]] - if {[string compare $second NULL] != 0} { - harray /sics/${name}/${second} init $val - } - } - } - return $status -} -#----------------------------------------------------- -proc simhm::MakeSimHM {name rank {tof NULL} } { - MakeSecHM $name $rank $tof - hfactory /sics/${name}/initval plain user int - hset /sics/${name}/initval 0 - - hfactory /sics/${name}/finishtime plain user int - hfactory /sics/${name}/internalstatus plain user text - hupdate /sics/${name}/internalstatus idle - - hdel /sics/${name}/control - hfactory /sics/${name}/control script \ - "simhm::getcontrol $name" "simhm::setcontrol $name" float - hsetprop /sics/${name}/control priv user - - hdel /sics/${name}/status - hfactory /sics/${name}/status script \ - "simhm::getstatus $name" hdbReadOnly text - hsetprop /sics/${name}/control priv user - hupdate /sics/${name}/status idle - - hfactory /sics/${name}/secondbank plain user text - hupdate /sics/${name}/secondbank NULL -} -#------------------------------------------------------ -proc simhm::makeSecond {name bankname length} { - hfactory /sics/${name}/${bankname} plain user intvarar $length - hupdate /sics/${name}/secondbank $bankname -} diff --git a/tcl/sinqhttp.tcl b/tcl/sinqhttp.tcl deleted file mode 100644 index 15177d94..00000000 --- a/tcl/sinqhttp.tcl +++ /dev/null @@ -1,152 +0,0 @@ -#-------------------------------------------------------- -# This is an asynchronous scriptcontext driven driver for -# the SINQ style http based histogram memory. -# -# script chains: -# -- control -# hmhttpcontrol - hmhttpreply -# -- data -# hmhttpdata - hmhttpreply -# -- status -# hmhttpstatus - hmhttpevalstatus -- hmhttpstatusdata -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, May 2009 -# -# You will need to override hmhttpevalstatus to implement -# an update of the detector data -# -# Mark Koennecke, April 2010 -#--------------------------------------------------------- -proc hmhttpsend {url} { - sct send $url - return hmhttpreply -} -#-------------------------------------------------------- -proc hmhttptest {data} { - if {[string first ASCERR $data] >= 0} { - error $data - } - if {[string first ERROR $data] >= 0} { - error $data - } - return $data -} -#-------------------------------------------------------- -proc hmhttpreply {} { - set reply [sct result] - set status [catch {hmhttptest $reply} data] - if {$status != 0} { - sct geterror $data - clientput $data - } else { - hdelprop [sct] geterror - } - return idle -} -#--------------------------------------------------------- -proc hmhttpcontrol {} { - set target [sct target] - switch $target { - 1000 { - set ret [hmhttpsend "/admin/startdaq.egi"] - set path [file dirname [sct]] - [sct controller] queue $path/status progress read - return $ret - } - 1001 {return [hmhttpsend "/admin/stopdaq.egi"] } - 1002 {return [hmhttpsend "/admin/pausedaq.egi"] } - 1003 {return [hmhttpsend "/admin/continuedaq.egi"]} - 1005 { - set path [file dirname [sct]] - set script [hval $path/initscript] - set confdata [eval $script] - return [hmhttpsend "post:/admin/configure.egi:$confdata"] - } - default { - sct print "ERROR: bad start target $target given to control" - return idle - } - } -} -#--------------------------------------------------------- -proc hmhttpdata {name} { - set len [hval /sics/${name}/datalength] - set path "/sics/${name}/data" - set com [format "node:%s:/admin/readhmdata.egi?bank=0&start=0&end=%d" $path $len] - sct send $com - return hmhttpdatareply -} -#-------------------------------------------------------- -proc hmhttpdatareply {} { - set status [catch {hmhttpreply} txt] - if {$status == 0} { - set path [file dirname [sct]] - hdelprop $path/data geterror - } - return idle -} -#-------------------------------------------------------- -proc hmhttpstatus {} { - sct send /admin/textstatus.egi - return hmhttpevalstatus -} -#------------------------------------------------------- -proc hmhttpstatusdata {} { - catch {hmhttpdatareply} - sct update idle - return idle -} -#--------------------------------------------------------- -proc hmhttpevalstatus {name} { - set reply [sct result] - set status [catch {hmhttptest $reply} data] - if {$status != 0} { - sct geterror $data - clientput $data - sct update error - return idle - } - hdelprop [sct] geterror - set lines [split $data \n] - foreach line $lines { - set ld [split $line :] - sct [string trim [lindex $ld 0]] [string trim [lindex $ld 1]] - } - set daq [sct DAQ] - set old [hval [sct]] - if {$daq == 1} { - sct update run - [sct controller] queue [sct] progress read - return idle - } else { - if {[string compare $old idle] != 0} { - hmhttpdata $name - return hmhttpstatusdata - } else { - return idle - } - } -} -#--------------------------------------------------------- -proc MakeHTTPHM {name rank host initscript {tof NULL} } { - sicsdatafactory new ${name}transfer - makesctcontroller ${name}sct sinqhttpopt $host ${name}transfer 600 spy 007 - MakeSecHM $name $rank $tof - hsetprop /sics/${name}/control write hmhttpcontrol - hsetprop /sics/${name}/control hmhttpreply hmhttpreply - ${name}sct write /sics/${name}/control - - hsetprop /sics/${name}/data read hmhttpdata $name - hsetprop /sics/${name}/data hmhttpdatareply hmhttpdatareply - ${name}sct poll /sics/${name}/data 120 - - hsetprop /sics/${name}/status read hmhttpstatus - hsetprop /sics/${name}/status hmhttpevalstatus hmhttpevalstatus $name - hsetprop /sics/${name}/status hmhttpstatusdata hmhttpstatusdata - ${name}sct poll /sics/${name}/status 60 - - hfactory /sics/${name}/initscript plain mugger text - hset /sics/${name}/initscript $initscript -} diff --git a/tcl/slsecho.tcl b/tcl/slsecho.tcl deleted file mode 100644 index 98056666..00000000 --- a/tcl/slsecho.tcl +++ /dev/null @@ -1,293 +0,0 @@ -#-------------------------------------------------------------- -# This is a scriptcontext based driver for the SLS magnet -# controllers interfaced via the new shiny, silvery TCP/IP -# interface box. -# -# Mark Koennecke, March 2010 -#--------------------------------------------------------------- -namespace eval slsecho {} - - -proc slsecho::sendread {num} { - sct send "$num:r:0x9c:0:read" - return readreply -} -#--------------------------------------------------------------- -proc slsecho::readreply {} { - set reply [sct result] - set l [split $reply :] -# set v [lindex $l 1] -# clientput "Received $reply, val = $v" - sct update [lindex $l 1] - return idle -} -#-------------------------------------------------------------- -proc slsecho::sendwrite {num} { - set val [sct target] - hupdate [sct]/stop 0 -# sct send "$num:w:0x90:$val:write" - sct send "$num:s:0x9c:$val:write" - return readreply -} -#-------------------------------------------------------------- -proc slsecho::writereply {} { - set path [sct] - set root [file dirname $path] - [sct controller] queue $root/error progress read - return idle -} -#-------------------------------------------------------------- -proc slsecho::readupper {num} { - sct send "$num:r:0x76:0:read" - return readreply -} -#-------------------------------------------------------------- -proc slsecho::readlower {num} { - sct send "$num:r:0x77:0:read" - return readreply -} -#-------------------------------------------------------------- -proc slsecho::readonoff {num} { - sct send "$num:r:0x24:0:none" - return onoffreply -} -#--------------------------------------------------------------- -proc slsecho::onoffreply {} { - set reply [sct result] - set l [split $reply :] - set val [lindex $l 1] - if {$val == 1} { - sct update on - } else { - sct update off - } - return idle -} -#--------------------------------------------------------------- -proc slsecho::writeonoff {num} { - set val [sct target] - if {[string compare $val on] == 0} { - set val 1 - } elseif {[string compare $val off] == 0} { - set val 0 - } else { - clientput "ERROR: Invalid target $val requested, only on/off" - return idle - } - sct send "$num:w:0x3c:$val:none" - [sct controller] queue [sct] progress read - return writereply -} -#-------------------------------------------------------------- -proc slsecho::readerror {num} { - sct send "$num:r:0x29:0:none" - return errorreply -} -#-------------------------------------------------------------- -proc slsecho::errorreply {} { - global slsecho::error - set reply [sct result] - set l [split $reply :] - set val [lindex $l 1] - set key [format "0x%x" [expr int($val)]] - clientput "$key" - clientput "$slsecho::error($key)" - sct update $slsecho::error($key) - return idle -} -#--------------------------------------------------------------- -proc slsecho::makeslsecho {name num sct} { - makesctdriveobj $name float user SLSEchoMagnet $sct - hfactory /sics/${name}/tolerance plain internal float - hset /sics/${name}/tolerance .1 - hfactory /sics/${name}/upperlimit plain internal float - hset /sics/${name}/upperlimit 10 - hfactory /sics/${name}/lowerlimit plain internal float - hset /sics/${name}/lowerlimit -10 - hfactory /sics/${name}/stop plain user int - hset /sics/${name}/stop 0 - - hsetprop /sics/${name} checklimits stddrive::stdcheck $name - hsetprop /sics/${name} checkstatus stddrive::stdstatus $name - hsetprop /sics/${name} halt stddrive::stop $name - - set path /sics/${name} - hsetprop $path read slsecho::sendread $num - hsetprop $path readreply slsecho::readreply - $sct poll $path 10 - hsetprop $path write slsecho::sendwrite $num - hsetprop $path writereply slsecho::writereply - $sct write $path - - hsetprop /sics/${name}/upperlimit read slsecho::readupper $num - hsetprop /sics/${name}/upperlimit readreply slsecho::readreply - $sct poll /sics/${name}/upperlimit 60 - - hsetprop /sics/${name}/lowerlimit read slsecho::readlower $num - hsetprop /sics/${name}/lowerlimit readreply slsecho::readreply - $sct poll /sics/${name}/lowerlimit 60 - - hfactory /sics/${name}/onoff plain user text - hsetprop /sics/${name}/onoff read slsecho::readonoff $num - hsetprop /sics/${name}/onoff onoffreply slsecho::onoffreply - $sct poll /sics/${name}/onoff 60 - hsetprop /sics/${name}/onoff write slsecho::writeonoff $num - hsetprop /sics/${name}/onoff writereply slsecho::writereply - $sct write /sics/${name}/onoff - - hfactory /sics/${name}/error plain internal text - hsetprop /sics/${name}/error read slsecho::readerror $num - hsetprop /sics/${name}/error errorreply slsecho::errorreply - $sct poll /sics/${name}/error 10 - -#----------------- update everything - hset /sics/${name}/onoff on - $sct queue /sics/${name} progress read - $sct queue /sics/${name}/upperlimit progress read - $sct queue /sics/${name}/lowerlimit progress read - $sct queue /sics/${name}/onoff progress read - $sct queue /sics/${name}/error progress read -} - -#------------------------------------------------------------------------------------------------ -# error codes -#------------------------------------------------------------------------------------------------- - set slsecho::error(0x0) "NO" - set slsecho::error(0x1) "DEVICE_STATE_ERROR" - set slsecho::error(0x2) "DEVICE_SUPERVISOR_DISABLED" - set slsecho::error(0x3) "COMMAND_ABORT" - set slsecho::error(0x4) "DATA_NOT_STORED" - set slsecho::error(0x5) "ERROR_ERASING_FLASH" - set slsecho::error(0x6) "COMMUNICATION_BREAK" - set slsecho::error(0x7) "INTERNAL_COMMUNICATION_ERROR" - set slsecho::error(0x8) "MASTER_CARD_ERROR" - set slsecho::error(0x9) "INTERNAL_BUFFER_FULL" - set slsecho::error(0xa) "WRONG_SECTOR" - set slsecho::error(0xb) "DATA_NOT_COPIED" - set slsecho::error(0xc) "WRONG_DOWNLOAD_PARAMETERS" - set slsecho::error(0xd) "DEVICE_PARAMETRIZATION_ERROR" - set slsecho::error(0x10) "TIMEOUT_DC_LINK_VOLTAGE" - set slsecho::error(0x11) "TIMEOUT_AUXILIARY_RELAY_ON" - set slsecho::error(0x12) "TIMEOUT_AUXILIARY_RELAY_OFF" - set slsecho::error(0x13) "TIMEOUT_MAIN_RELAY_ON" - set slsecho::error(0x14) "TIMEOUT_MAIN_RELAY_OFF" - set slsecho::error(0x15) "TIMEOUT_DATA_DOWNLOAD" - set slsecho::error(0x20) "INTERLOCK" - set slsecho::error(0x21) "MASTER_SWITCH" - set slsecho::error(0x22) "MAGNET_INTERLOCK" - set slsecho::error(0x23) "TEMPERATURE_TRANSFORMER" - set slsecho::error(0x24) "TEMPERATURE_RECTIFIER" - set slsecho::error(0x25) "TEMPERATURE_CONVERTER" - set slsecho::error(0x26) "CURRENT_TRANSDUCER" - set slsecho::error(0x27) "TEMPERATURE_POLARITY_SWITCH" - set slsecho::error(0x28) "POWER_SEMICONDUCTOR" - set slsecho::error(0x29) "MAIN_RELAY" - set slsecho::error(0x2a) "AD_CONVERTER_CARD" - set slsecho::error(0x2b) "POLARITY_SWITCH" - set slsecho::error(0x2c) "AUXILIARY_RELAY" - set slsecho::error(0x2d) "MASTER_SWITCH_T1" - set slsecho::error(0x2e) "MASTER_SWITCH_T2" - set slsecho::error(0x2f) "TEMPERATURE_MAGNET" - set slsecho::error(0x30) "WATER_MAGNET" - set slsecho::error(0x31) "WATER_RACK" - set slsecho::error(0x40) "LOAD_CURRENT_TOO_HIGH" - set slsecho::error(0x41) "DC_LINK_VOLTAGE_TOO_LOW" - set slsecho::error(0x42) "DC_LINK_VOLTAGE_TOO_HIGH" - set slsecho::error(0x43) "LOAD_VOLTAGE_TOO_HIGH" - set slsecho::error(0x44) "LOAD_CURRENT_RIPPLE_TOO_HIGH" - set slsecho::error(0x45) "DC_LINK_ISOLATION_NOT_OK" - set slsecho::error(0x46) "LOAD_ISOLATION_NOT_OK" - set slsecho::error(0x47) "LOAD_IMPEDANCE_OUT_OF_RANGE" - set slsecho::error(0x48) "SHUT_OFF_CURRENT_TOO_HIGH" - set slsecho::error(0x49) "LOAD_DC_CURRENT_TOO_HIGH" - set slsecho::error(0x4a) "CURRENT_I1A1_TOO_HIGH" - set slsecho::error(0x4b) "CURRENT_I1B1_TOO_HIGH" - set slsecho::error(0x4c) "CURRENT_I1A2_TOO_HIGH" - set slsecho::error(0x4d) "CURRENT_I1B2_TOO_HIGH" - set slsecho::error(0x4e) "CURRENT_I2A1_TOO_HIGH" - set slsecho::error(0x4f) "CURRENT_I2B1_TOO_HIGH" - set slsecho::error(0x50) "CURRENT_I2A2_TOO_HIGH" - set slsecho::error(0x51) "CURRENT_I2B2_TOO_HIGH" - set slsecho::error(0x52) "CURRENT_I3P_TOO_HIGH" - set slsecho::error(0x53) "CURRENT_I3N_TOO_HIGH" - set slsecho::error(0x54) "CURRENT_IE_TOO_HIGH" - set slsecho::error(0x55) "VOLTAGE_U1A_TOO_LOW" - set slsecho::error(0x56) "VOLTAGE_U1B_TOO_LOW" - set slsecho::error(0x57) "DIFF_CURRENT_I1A1_I1A2_TOO_HIGH" - set slsecho::error(0x58) "DIFF_CURRENT_I1B1_I1B2_TOO_HIGH" - set slsecho::error(0x59) "DIFF_CURRENT_I2A1_I2A2_TOO_HIGH" - set slsecho::error(0x5a) "DIFF_CURRENT_I2B1_I2B2_TOO_HIGH" - set slsecho::error(0x5b) "DIFF_CURRENT_I3P_I3N_TOO_HIGH" - set slsecho::error(0x5c) "CURRENT_I1A_TOO_HIGH" - set slsecho::error(0x5d) "CURRENT_I1B_TOO_HIGH" - set slsecho::error(0x5e) "CURRENT_I3A1_TOO_HIGH" - set slsecho::error(0x5f) "CURRENT_I3B1_TOO_HIGH" - set slsecho::error(0x60) "CURRENT_I3A2_TOO_HIGH" - set slsecho::error(0x61) "CURRENT_I3B2_TOO_HIGH" - set slsecho::error(0x62) "CURRENT_I4_TOO_HIGH" - set slsecho::error(0x63) "CURRENT_I5_TOO_HIGH" - set slsecho::error(0x64) "DIFF_CURRENT_I3A1_I3A2_TOO_HIGH" - set slsecho::error(0x65) "DIFF_CURRENT_I3B1_I3B2_TOO_HIGH" - set slsecho::error(0x66) "DIFF_CURRENT_I4_I5_TOO_HIGH" - set slsecho::error(0x67) "VOLTAGE_U3A_TOO_LOW" - set slsecho::error(0x68) "VOLTAGE_U3B_TOO_LOW" - set slsecho::error(0x69) "VOLTAGE_U1_TOO_LOW" - set slsecho::error(0x6a) "VOLTAGE_U3A_TOO_HIGH" - set slsecho::error(0x6b) "VOLTAGE_U3B_TOO_HIGH" - set slsecho::error(0x6c) "SPEED_ERROR_TOO_HIGH" - set slsecho::error(0x70) "MAIN_RELAY_A" - set slsecho::error(0x71) "MAIN_RELAY_B" - set slsecho::error(0x72) "POWER_SWITCH_A" - set slsecho::error(0x73) "POWER_SWITCH_B" - set slsecho::error(0x74) "MONITOR_TRAFO_A" - set slsecho::error(0x75) "MONITOR_TRAFO_B" - set slsecho::error(0x76) "TEMPERATURE_RECTIFIER_A" - set slsecho::error(0x77) "TEMPERATURE_RECTIFIER_B" - set slsecho::error(0x78) "TEMPERATURE_CONVERTER_A" - set slsecho::error(0x79) "TEMPERATURE_CONVERTER_B" - set slsecho::error(0x7a) "TEMPERATURE_CONVERTER_A1" - set slsecho::error(0x7b) "TEMPERATURE_CONVERTER_B1" - set slsecho::error(0x7c) "TEMPERATURE_CONVERTER_A2" - set slsecho::error(0x7d) "TEMPERATURE_CONVERTER_B2" - set slsecho::error(0x7e) "TEMPERATURE_TRANSFORMER_A" - set slsecho::error(0x7f) "TEMPERATURE_TRANSFORMER_B" - set slsecho::error(0x80) "WATER_RECTIFIER_A" - set slsecho::error(0x81) "WATER_RECTIFIER_B" - set slsecho::error(0x82) "WATER_CONVERTER_A" - set slsecho::error(0x83) "WATER_CONVERTER_B" - set slsecho::error(0x84) "WATER_CONVERTER_A1" - set slsecho::error(0x85) "WATER_CONVERTER_B1" - set slsecho::error(0x86) "WATER_CONVERTER_A2" - set slsecho::error(0x87) "WATER_CONVERTER_B2" - set slsecho::error(0x88) "WATER_TRANSFORMER_A" - set slsecho::error(0x89) "WATER_TRANSFORMER_B" - set slsecho::error(0x8a) "DOOR_A" - set slsecho::error(0x8b) "DOOR_B" - set slsecho::error(0x8c) "DOOR_C" - set slsecho::error(0x8d) "POWER_SEMICONDUCTOR_CONVERTER_A" - set slsecho::error(0x8e) "POWER_SEMICONDUCTOR_CONVERTER_B" - set slsecho::error(0x8f) "POWER_SEMICONDUCTOR_CONVERTER_A1" - set slsecho::error(0x90) "POWER_SEMICONDUCTOR_CONVERTER_B1" - set slsecho::error(0x91) "POWER_SEMICONDUCTOR_CONVERTER_A2" - set slsecho::error(0x92) "POWER_SEMICONDUCTOR_CONVERTER_B2" - set slsecho::error(0x93) "CURRENT_TRANSDUCER_I3P" - set slsecho::error(0x94) "CURRENT_TRANSDUCER_I3N" - set slsecho::error(0x95) "MAGNET_INTERLOCK_1" - set slsecho::error(0x96) "MAGNET_INTERLOCK_2" - set slsecho::error(0x97) "VENTILATOR" - set slsecho::error(0x98) "EMERGENCY_SWITCH" - set slsecho::error(0x99) "CAPACITOR_DISCHARGE_A_ON" - set slsecho::error(0x9a) "CAPACITOR_DISCHARGE_B_ON" - set slsecho::error(0x9b) "CURRENT_TRANSDUCER_I4" - set slsecho::error(0x9c) "CURRENT_TRANSDUCER_I5" - set slsecho::error(0xb0) "TIMEOUT_DC_LINK_VOLTAGE_PART_A" - set slsecho::error(0xb1) "TIMEOUT_DC_LINK_VOLTAGE_PART_B" - set slsecho::error(0xb2) "TIMEOUT_AUXILIARY_RELAY_A_ON" - set slsecho::error(0xb3) "TIMEOUT_AUXILIARY_RELAY_B_ON" - set slsecho::error(0xb4) "TIMEOUT_AUXILIARY_RELAY_A_OFF" - set slsecho::error(0xb5) "TIMEOUT_AUXILIARY_RELAY_B_OFF" - set slsecho::error(0xb6) "TIMEOUT_MAIN_RELAY_A_ON" - set slsecho::error(0xb7) "TIMEOUT_MAIN_RELAY_B_ON" - set slsecho::error(0xb8) "TIMEOUT_MAIN_RELAY_A_OFF" - set slsecho::error(0xb9) "TIMEOUT_MAIN_RELAY_B_OFF" - diff --git a/tcl/stddrive.tcl b/tcl/stddrive.tcl deleted file mode 100644 index 0528c3cf..00000000 --- a/tcl/stddrive.tcl +++ /dev/null @@ -1,100 +0,0 @@ -#------------------------------------------------------ -# This is some code for a standard drivable object in -# the scriptcontext system. It implements an empty -# object which throws errors when accessed. Users -# of such an object can override it to do -# something more acceptable. This object also -# provides for basic limit checking and status -# checking. It can serve as a basis for creating -# new drivable objects, for instance environment -# control devices. A possible user has as the -# first thing in a write script to set the target -# node to the desired value. -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, November 2009 -#-------------------------------------------------------- - -namespace eval stddrive {} - -proc stddrive::stdcheck {name} { - set val [sct target] - set upper [hval /sics/${name}/upperlimit] - set lower [hval /sics/${name}/lowerlimit] - if {$val < $lower || $val > $upper} { - error "$val is out of range $lower - $upper for $name" - } - return OK -} -#------------------------------------------------------- -proc stddrive::stdstatus {name} { - set test [catch {sct geterror} errortxt] - if {$test == 0} { - return fault - } - set stop [hval /sics/${name}/stop] - if {$stop == 1} { - return fault - } - set target [sct target] - set tol [hval /sics/${name}/tolerance] - set is [hval /sics/${name}] - if {abs($target - $is) < $tol} { - return idle - } else { - [sct controller] queue /sics/${name} progress read - return busy - } -} -#------------------------------------------------------- -proc stddrive::stop {name} { - hset /sics/${name}/stop 1 - return idle -} -#------------------------------------------------------- -proc stddrive::deread {} { - sct update -9999.99 - return idle -} -#-------------------------------------------------------- -proc stddrive::dewrite {name} { -# hset /sics/${name}/stop 1 - error "$name is not configured, cannot drive" -} -#-------------------------------------------------------- -proc stddrive::deconfigure {name} { - set allowed [list upperlimit lowerlimit tolerance stop] - set nodelist [split [hlist /sics/${name}] \n] - foreach node $nodelist { - if {[string length $node] < 1} { - continue - } - if {[lsearch -exact $allowed [string trim $node]] < 0} { - clientput "Deleting $node" - hdel /sics/${name}/${node} - } - } - hsetprop /sics/${name} read stddrive::deread - hsetprop /sics/${name} write stddrive::dewrite $name -} -#-------------------------------------------------------- -proc stddrive::makestddrive {name sicsclass sct} { - makesctdriveobj $name float user $sicsclass $sct - hfactory /sics/${name}/tolerance plain user float - hset /sics/${name}/tolerance 2.0 - hfactory /sics/${name}/upperlimit plain user float - hset /sics/${name}/upperlimit 300 - hfactory /sics/${name}/lowerlimit plain user float - hset /sics/${name}/lowerlimit 10 - hfactory /sics/${name}/stop plain user int - hset /sics/${name}/stop 0 - - hsetprop /sics/${name} checklimits stddrive::stdcheck $name - hsetprop /sics/${name} checkstatus stddrive::stdstatus $name - hsetprop /sics/${name} halt stddrive::stop $name - deconfigure $name - $sct write /sics/${name} - $sct poll /sics/${name} 60 - hupdate /sics/${name} -9999.99 -} diff --git a/tcl/stdin.tcl b/tcl/stdin.tcl deleted file mode 100644 index 2a0e8d18..00000000 --- a/tcl/stdin.tcl +++ /dev/null @@ -1,23 +0,0 @@ - -proc readProgA {pid} { - global readProgADone; - - # read outputs of schemdb - set tmpbuf [gets $pid]; - puts "received $tmpbuf\n"; - - set readProgADone [eof $pid]; - - if {$readProgADone} { - puts "closing..."; - catch [close $pid] aa; - if {$aa != ""} { - puts "HERE1: Error on closing"; - exit 1; - } - } -} - -# set the "read" event -fileevent stdin readable {readProgA stdin}; - diff --git a/tcl/susca.tcl b/tcl/susca.tcl deleted file mode 100644 index 2cf2876b..00000000 --- a/tcl/susca.tcl +++ /dev/null @@ -1,62 +0,0 @@ -#---------------------------------------------------------------------------- -# suchscan : a very fast scan. A motor is set to run, the counter is started -# and the counter read as fast as possible. Current motor position and -# counts are printed. For quick and dirty location of peaks. -# -# Mark Koennecke, October 1998 -#--------------------------------------------------------------------------- - -proc scGetNum { text } { - set list [split $text =] - return [lindex $list 1] -} - - -# set the counter name -set ctr counter - -#----------- check if var still driving -proc runtest {var } { - set t [listexe] - if {[string first $var $t] >= 0} { - return 1 - } else { - return 0 - } -} -#-------------------------- the actual susca -proc susca args { - global ctr - if {[llength $args] < 4} { - ClientPut "USAGE: susca var start length time" - error "ERROR: Insufficient number of arguments to susca" - } -#------ drive to start position - set var [lindex $args 0] - set start [lindex $args 1] - set end [lindex $args 2] - set ctime [lindex $args 3] - set ret [catch {drive $var $start} msg] - if {$ret != 0 } { - error "ERROR: $msg" - } - set last 0 -#------- start counter - $ctr setmode timer - $ctr countnb $ctime -#-------- start motor - set ret [catch {run $var $end} msg] - if {$ret != 0 } { - error "ERROR: $msg" - } -#------ scan loop - while {[runtest $var] == 1} { - set ct [scGetNum [$ctr getcounts]] - set ncts [expr abs($ct - $last)] - set last $ct - set vp [scGetNum [$var]] - ClientPut [format "%8.2f %12.2f" $vp $ncts] - } - ClientPut "OK" -} - diff --git a/tcl/table.tcl b/tcl/table.tcl deleted file mode 100644 index dba5878a..00000000 --- a/tcl/table.tcl +++ /dev/null @@ -1,317 +0,0 @@ -#---------------------------------------------------------------------- -# Support functions for table processing in SICS -# -# This includes a CSV processing module from someone else. See below. -# -# copyright: see file COPYRIGHT -# -# Mark Koennecke, November 2008 -#---------------------------------------------------------------------- -if { [info exists __tableheader] == 0 } { - set __tableheader NULL - Publish tableexe User - Publish loop User -} -#===================================================================== -# Csv tcl package version 2.0 -# A tcl library to deal with CSV (comma separated value) -# files, generated and readable by some DOS/Windows programs -# Contain two functions: -# csv2list string ?separator? -# and -# list2csv list ?separator? -# which converts line from CSV file to list and vice versa. -# -# Both functions have optional "separator argument" becouse some silly -# Windows -# program might use semicomon as delimiter in COMMA separated values -# file. -# -# Copyright (c) SoftWeyr, 1997-99 -# Many thanks to Robert Seeger -# for beta-testing and fixing my misprints -# This file is distributed under GNU Library Public License. Visit -# http://www.gnu.org/copyleft/gpl.html -# for details. - -# -# Convert line, read from CSV file into proper TCL list -# Commas inside quoted strings are not considered list delimiters, -# Double quotes inside quoted strings are converted to single quotes -# Double quotes are stripped out and replaced with correct Tcl quoting -# - -proc csv2list {str {separator ","}} { - #build a regexp> - set regexp [subst -nocommands \ - {^[ \t\r\n]*("(([^"]|"")*)"|[^"$separator \t\r]*)}] - set regexp1 [subst -nocommands {$regexp[ \t\r\n]*$separator\(.*)$}] - set regexp2 [subst -nocommands {$regexp[ \t\r\n]*\$}] - set list {} - while {[regexp $regexp1 $str junk1 unquoted quoted\ - junk2 str]} { - if {[string length $quoted]||$unquoted=="\"\""} { - regsub -all {""} $quoted \" unquoted - } - lappend list $unquoted - } - if {[regexp $regexp2 $str junk unquoted quoted]} { - if {[string length $quoted]||$unquoted=="\"\""} { - regsub -all {""} $quoted \" unquoted - } - lappend list $unquoted - if {[uplevel info exist csvtail]} { - uplevel set csvtail {""} - } - } else { - if {[uplevel info exist csvtail]} { - uplevel [list set csvtail $str] - } else { - return -code error -errorcode {CSV 1 "CSV parse error"}\ - "CSV parse error: unparsed tail \"$str\"" - } - } - return $list -} - -proc list2csv {list {separator ","}} { - set l {} - foreach elem $list { - if {[string match {} $elem]|| - [regexp {^[+-]?([0-9]+|([0-9]+\.?[0-9]*|\.[0-9]+)([eE][+-]?[0-9]+)?)$}\ - $elem]} { - lappend l $elem - } else { - regsub -all {"} $elem {""} selem - lappend l "\"$selem\"" - } - } - return [join $l $separator] -} - -proc csvfile {f {separator ","}} { - set csvtail "" - set list {} - set buffer {} - while {[gets $f line]>=0} { - if {[string length $csvtail]} { - set line "$csvtail\n$line" - } elseif {![string length $line]} { - lappend list {} - continue - } - set rec [csv2list $line $separator] - set buffer [concat $buffer $rec] - if {![ string length $csvtail]} { - lappend list $buffer - set buffer {} - } - } - if {[string length $csvtail]} { - return -code error -errorcode {CSV 2 "Multiline parse error"}\ - "CSV file parse error" - } - return $list -} - -proc csvstring {str {separator ","}} { - set csvtail "" - set list {} - set buffer {} - foreach line [split $str "\n"] { - if {[string length $csvtail]} { - set line "$csvtail\n$line" - } elseif {![string length $line]} { - lappend list {} - continue - } - set rec [csv2list $line $separator] - set buffer [concat $buffer $rec] - if {![ string length $csvtail]} { - lappend list $buffer - set buffer {} - } - } - if {[string length $cvstail]} { - return -code error -errorcode {CSV 2 "Multiline parse error"}\ - "CSV string parse error" - } - return $list -} - -package provide Csv 2.1 -#======================================================================== -# The plan here is such: operations which happen fast or immediatly are -# done at once. Count commands or anything given as command is appended -# to a list for later execution. The idea is that this contains the -# actual measuring payload of the row. -# Drivables are immediatly started. -# After processing the rows, there is a success to wait for motors to arrive -# Then the commands for later execution are run. This frees the user of the -# the necessity to have the count or whatever command as the last thing in the row -#-------------------------------------------------------------------------------- -proc testinterrupt {} { - set int [getint] - if {[string first continue $int] < 0} { - error "Interrupted" - } -} -#-------------------------------------------------------------------------------- -proc processtablerow {line} { - global __tableheader - set parlist [csv2list $line] - for {set i 0} {$i < [llength $__tableheader]} {incr i} { - set type [lindex $__tableheader $i] - set data [lindex $parlist $i] -#--------- first process special types - switch $type { - monitor { - lappend laterExe "count monitor $data" - continue - } - timer { - lappend laterExe "count timer $data" - continue - } - compar { - append command [join [lrange $parlist $i end]] - lappend laterExe $command - break - } - command { - lappend laterExe $data - continue - } - batch { - lappend laterExe "exe $data" - continue - } - } -#----------- now look for drivables - set test [sicstype $type] - if {[string compare $test DRIV] == 0} { - set status [catch {run $type $data} msg] - if {$status != 0} { - clientput "ERROR: $msg for $type with $data" - } - continue - } -#------------- now look for special objects - set objtype [sicsdescriptor $type] - switch $objtype { - SicsVariable - - MulMot - - Macro { - set status [catch {eval $type $data} msg] - if {$status != 0} { - clientput "ERROR: $msg for $type with $data" - } - continue - } - default { - clientput "Skipping non recognized column $type with data $data" - } - } - } - set status [catch {success} msg] - if {$status != 0} { - clientput "ERROR: $msg while waiting for motors to arrive" - } - testinterrupt - foreach command $laterExe { - eval $command - testinterrupt - } -} -#------------------------------------------------------------------------ -proc tableexe {tablefile} { - global __tableheader - if {[string first NULL $__tableheader] < 0} { - error "Tableexe already running, terminated" - } - set fullfile [SplitReply [exe fullpath $tablefile]] - set in [open $fullfile r] - gets $in header - set __tableheader [csv2list $header] - while {[gets $in line] > 0} { - set status [catch {processtablerow $line} msg] - if {$status != 0} { - set int [getint] - if {[string first continue $int] < 0} { - break - } else { - clientput "ERROR: $msg while processing row" - } - } - } - close $in - set __tableheader NULL - return "Done processing table" -} -#--------------------------------------------------------------------------- -proc loop args { - clientput $args - if {[llength $args] < 2} { - error \ -"Usage: loop \n\t number of repetions\n\t any SICS command" - } - set len [lindex $args 0] - set command [lrange $args 1 end] - for {set i 1} {$i <= $len} {incr i} { - clientput "Repetition $i of $len" - set status [catch {eval [join $command]} msg] - if {$status != 0} { - clientput "ERROR: $msg while processing loop command" - } - testinterrupt - } -} -#============================================================================== -# This is an old attempt -#============================================================================= -proc __tablescan__ args { - global __tableheader - - set idx [lsearch $__tableheader monitor] - if {$idx >= 0} { - set preset [lindex $args $idx] - set mode monitor - } - set idx [lsearch $__tableheader timer] - if {$idx >= 0} { - set preset [lindex $args $idx] - set mode timer - } - - set idx [lsearch $__tableheader scanvar] - if {$idx >= 0} { - set var [lindex $args $idx] - } else { - error "ERROR: No scan variable in table" - } - - set idx [lsearch $__tableheader scanstart] - if {$idx >= 0} { - set start [lindex $args $idx] - } else { - error "ERROR: No scan start in table" - } - - set idx [lsearch $__tableheader scanend] - if {$idx >= 0} { - set end [lindex $args $idx] - } else { - error "ERROR: No scan end in table" - } - - set idx [lsearch $__tableheader scanstep] - if {$idx >= 0} { - set step [lindex $args $idx] - } else { - error "ERROR: No scan step in table" - } - - set np [expr abs($end - $start)/$step] - xxxscan var $var $start $step - xxxscan run $np $mode $preset -} diff --git a/tcl/tail.tcl b/tcl/tail.tcl deleted file mode 100644 index 992f7e7a..00000000 --- a/tcl/tail.tcl +++ /dev/null @@ -1,12 +0,0 @@ -#-------------------------------------------------------------------------- -# Implementation of the SICS tail command. This uses the unix sicstail -# command which is defined for the instrument user. -# -# Mark Koennecke, June 1999 -#------------------------------------------------------------------------- - -proc tail { {n 20} } { - set txt [exec sicstail $n] - ClientPut $txt - return -} diff --git a/tcl/topsiold.tcl b/tcl/topsiold.tcl deleted file mode 100644 index b0047b11..00000000 --- a/tcl/topsiold.tcl +++ /dev/null @@ -1,772 +0,0 @@ -#---------------------------------------------------------------------------- -# Scan command implementation for TOPSI -# Test version, Mark Koennecke, February 1997 -#---------------------------------------------------------------------------- -set home /data/koenneck/src/sics/tcl -set datapath /data/koenneck/src/sics/tmp -set recoverfil /data/koenneck/src/sics/recover.dat - -bpOn - -source $home/utils.tcl -source $home/base.tcl -source $home/inherit.tcl -source $home/obtcl.tcl -#-------------------------- some utility functions ------------------------- -proc MC { t n } { - set string $t - for { set i 1 } { $i < $n } { incr i } { - set string [format "%s%s" $string $t] - } - return $string -} -#-------------------------------------------------------------------------- -proc GetNum { text } { - set list [split $text =] - return [lindex $list 1] -} -#-------------------------- String list for writing ------------------------ -class DataSet -DataSet method init { } { - instvar N - instvar Data - next - set Data(0) " Bla" - set N 0 -} - -DataSet method add { text } { - instvar N - instvar Data - set Data($N) $text - incr N -} - -DataSet method ins { text i } { - instvar Data - instvar N - if { $i >= $N } { - set N [expr $i + 1] - } else { - unset Data($i) - } - set Data($i) $text -} -DataSet method put { file } { - instvar Data - instvar N - - for { set i 0 } { $i < $N } { incr i } { - puts $file $Data($i) - } -} - -DataSet method clear { } { - instvar Data - instvar N - unset Data - set Data(0) "Bla" - set N 0 -} -DataSet method GetN { } { - instvar N - return $N -} - -#--------------------------------------------------------------------------- -# scan class initialization -class ScanCommand - -ScanCommand method init { counter } { - instvar ScanData - instvar [DataSet new Data] - instvar Active - instvar Recover - next - set ScanData(Mode) Timer - set ScanData(NP) 1 - set ScanData(counter) $counter - set ScanData(NoVar) 0 - set ScanData(Preset) 10. - set ScanData(File) Default.dat - set ScanData(Counts) " " - set ScanData(cinterest) " " - set ScanData(pinterest) " " - set Active 0 - set Recover 0 -} -#-------------add scan variables--------------------------------------------- -ScanCommand method var { name start step } { - instvar ScanData - instvar ScanVar - instvar Active -# check for activity - if {$Active} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } -# check parameters - set t [SICSType $name] - if { [string compare $t DRIV] != 0 } { - ClientPut [format "ERROR: %s is not drivable" $name] error - return 0 - } - set t [SICSType $start] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $start] error - return 0 - } - set t [SICSType $step] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $step] error - return 0 - } -# install the variable - set i $ScanData(NoVar) - set ScanData(NoVar) [incr ScanData(NoVar)] - set ScanVar($i,Var) $name - set ScanVar($i,Start) $start - set ScanVar($i,Step) $step - set ScanVar($i,Value) " " - $self SendInterest pinterest ScanVarChange - ClientPut OK -} -#---------------------- getvars ------------------------------------------ -ScanCommand method getvars {} { - instvar ScanData - instvar ScanVar - set list "" - for {set i 0} { $i < $ScanData(NoVar) } { incr i} { - lappend list $ScanVar($i,Var) - } - return [format "scan.Vars = %s -END-" $list] -} -#------------------------------------------------------------------------ -ScanCommand method xaxis {} { - instvar ScanData - instvar ScanVar - if { $ScanData(NoVar) <= 0} { -#---- default Answer - set t [format "%s.xaxis = %f %f" $self 0 1] - } else { - set t [format "%s.xaxis = %f %f" $self $ScanVar(0,Start) \ - $ScanVar(0,Step)] - } - ClientPut $t -} -#--------------------- modvar -------------------------------------------- -ScanCommand method modvar {name start step } { - instvar ScanData - instvar ScanVar - for {set i 0} { $i < $ScanData(NoVar) } { incr i} { - if { [string compare $name $ScanVar($i,Var)] == 0} { - set t [SICSType $start] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $start] error - return 0 - } - set t [SICSType $step] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number!" $step] error - return 0 - } -#-------- do it - set ScanVar($i,Start) $start - set ScanVar($i,Step) $step - return OK - } - } - error [format "Scan Variable %s NOT found" $name] -} -#----------------- interests ---------------------------------------------- -ScanCommand method cinterest {} { - instvar ScanData - set nam [GetNum [config MyName]] - lappend ScanData(cinterest) $nam -} -#-------------------------------------------------------------------------- -ScanCommand method pinterest {} { - instvar ScanData - set nam [GetNum [config MyName]] - lappend ScanData(pinterest) $nam -} -#------------------------------------------------------------------------- -ScanCommand method SendInterest { type text } { - instvar ScanData -#------ check list first - set l1 $ScanData($type) - set l2 "" - foreach e $l1 { - set b [string trim $e] - set g [string trim $b "{}"] - set ret [SICSType $g] - if { [string first COM $ret] >= 0 } { - lappend l2 $e - } - } -#-------- update scan data and write - set ScanData($type) $l2 - foreach e $l2 { - set b [string trim $e] - $b put $text - } -} -#---------------- Change Mode ---------------------------------------------- -ScanCommand method Mode { {NewVal NULL } } { - instvar ScanData - instvar Active - if { [string compare $NewVal NULL] == 0 } { - set val [format "%.Mode = %s" $self $ScanData(Mode)] - ClientPut $val - return $val - } else { -# check for activity - if {$Active} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - if { ([string compare $NewVal "Timer"] == 0) || \ - ([string compare $NewVal Monitor] ==0) } { - set ScanData(Mode) $NewVal - ClientPut OK - } else { - ClientPut [format "ERROR: %s not recognized as ScanMode" $NewVal] - } - } -} -#----------------------------- NP ------------------------------------------- -ScanCommand method NP { { NewVal NULL } } { - instvar ScanData - instvar Active - if { [string compare $NewVal NULL] == 0 } { - set val [format "%s.NP = %d" $self $ScanData(NP)] - ClientPut $val - return $val - } else { -# check for activity - if {$Active} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - set t [SICSType $NewVal] - if { [string compare $t NUM] != 0 } { - ClientPut [format "ERROR: %s is no number" $NewVal] error - return - } - set ScanData(NP) $NewVal - ClientPut OK - } -} -#------------------------------ Preset ------------------------------------ -ScanCommand method Preset { {NewVal NULL} } { - instvar ScanData - instvar Active - if { [string compare $NewVal NULL] == 0 } { - set val [format "%s.Preset = %f" $self $ScanData(Preset)] - ClientPut $val - return $val - } else { -# check for activity - if {$Active} { - ClientPut "ERROR: cannot change parameters while scanning" error - return - } - set ScanData(Preset) $NewVal - set t [SICSType $NewVal] - if { [string compare $t NUM] != 0} { - ClientPut [format "ERROR: %s is no number" $NewVal] error - return - } - ClientPut OK - } -} -#------------------------------ File ------------------------------------ -ScanCommand method File { {NewVal NULL} } { - instvar ScanData - if { [string compare $NewVal NULL] == 0 } { - set val [format "%s.File = %s" $self $ScanData(File)] - ClientPut $val - return $val - } else { - set ScanData(File) $NewVal - ClientPut OK - } -} -#--------------------------- Count --------------------------------------- -# These and the commands below are for use in recovery only -ScanCommand method RecoCount { val } { - instvar Recover - instvar ScanData - if { ! $Recover } { - ClientPut \ - "ERROR: This command may only be used in Recovery Operations" \ - error - return - } - set ScanData(Counts) $val -} -#--------------------------- monitor ------------------------------------- -ScanCommand method RecoMonitor { val } { - instvar Recover - instvar ScanData - if { ! $Recover } { - ClientPut \ - "ERROR: This command may only be used in Recovery Operations" \ - error - return - } - set ScanData(Monitor) $val -} -#--------------------------- var ------------------------------------- -ScanCommand method RecoVar { var val } { - instvar Recover - instvar ScanData - instvar ScanVar - if { ! $Recover } { - ClientPut \ - "ERROR: This command may only be used in Recovery Operations" \ - error - return - } - set ScanVar($var,Value) $val -} -#--------------------------- WriteRecover -------------------------------- -ScanCommand method WriteRecover { } { - instvar ScanData - instvar ScanVar - global recoverfil - - set fd [open $recoverfil w] - puts $fd [format "%s Preset %s " $self $ScanData(Preset)] - puts $fd [format "%s Mode %s " $self $ScanData(Mode)] - puts $fd [format "%s NP %s " $self $ScanData(NP)] - puts $fd [format "%s File %s " $self $ScanData(File)] - for { set i 0 } { $i < $ScanData(NoVar) } { incr i } { - puts $fd [format "%s var %s %s %s" $self $ScanVar($i,Var) \ - $ScanVar($i,Start) $ScanVar($i,Step)] - puts $fd [format "%s RecoVar %d %s" $self $i [list $ScanVar($i,Value)]] - } - puts $fd [format "%s RecoCount %s" $self [list $ScanData(Counts)]] - puts $fd [format "%s RecoMonitor %s" $self [list $ScanData(Monitor)]] - close $fd -} -#-------------------------- list ------------------------------------------ -ScanCommand method list { } { - instvar ScanData - instvar ScanVar - ClientPut [format "%s.Preset = %f" $self $ScanData(Preset)] - ClientPut [format "%s.Mode = %s" $self $ScanData(Mode)] - ClientPut [format "%s.File = %s" $self $ScanData(File)] - ClientPut [format "%s.NP = %d" $self $ScanData(NP)] - ClientPut "ScanVariables:" - for { set i 0 } {$i < $ScanData(NoVar) } { incr i } { - ClientPut [format " %s %f %f" $ScanVar($i,Var) $ScanVar($i,Start) \ - $ScanVar($i,Step)] - } -} -#--------------------------------- clear --------------------------------- -ScanCommand method clear { } { - instvar ScanData - instvar ScanVar - instvar Data - instvar Active -# check for activity - if {$Active} { - ClientPut "ERROR: cannot clear running scan" error - return - } - - set ScanData(NP) 0 - set ScanData(NoVar) 0 - set ScanData(Counts) " " - set ScanData(Monitor) " " - Data clear - $self SendInterest pinterest ScanVarChange - ClientPut OK -} -#--------------------------- Store Initial data ----------------------------- -ScanCommand method SaveHeader { } { - instvar Data - instvar ScanData - instvar ScanVar - Data clear -# administrative header - Data add [format "%s TOPSI Data File %s" [MC * 30] \ - [MC * 30]] - Data add [Title] - Data add [User] - Data add [format "File created: %s" [sicstime]] - Data add [MC * 75] - Data add [format " %s Setting %s " [MC * 30] [MC * 30]] -# settings of instrument variables - Data add [format "%s Monochromator %s" [MC - 30] [MC - 30]] - Data add [lambda] - Data add [MTL position] - Data add [MTU position] - Data add [MGU position] -# diaphragm should go here -# sample info - Data add [format "%s Sample %s" [MC - 30] [MC - 30]] - Data add [STL position] - Data add [STU position] - Data add [SGL position] - Data add [SGU position] - Data add [MC * 75] -# counter info - Data add [format "CountMode = %s" $ScanData(Mode)] - Data add [format "Count Preset = %s" $ScanData(Preset)] - Data add [MC * 75] - Data add [format "%s DATA %s" [MC * 30] [MC * 30]] - set val "Variables scanned: " - for { set i 0 } { $i < $ScanData(NoVar) } { incr i} { - append val " " $ScanVar($i,Var) - } - Data add "$val" - append t [LeftAlign NP 5] - append t [LeftAlign Counts 12] - for { set i 0 } { $i < $ScanData(NoVar) } { incr i} { - append t [LeftAlign $ScanVar($i,Var) 10] - } - Data add $t - set ScanData(Ptr) [Data GetN] -} -#----------------------------------------------------------------------------- -ScanCommand method ConfigureDevices { } { - instvar ScanData - $ScanData(counter) SetMode $ScanData(Mode) - $ScanData(counter) SetPreset $ScanData(Preset) -} -#---------------------------------------------------------------------------- -ScanCommand method StoreScanPoint { } { - instvar ScanData - instvar Data - instvar ScanVar - lappend ScanData(Counts) [GetNum [$ScanData(counter) GetCounts]] - lappend ScanData(Monitor) [GetNum [$ScanData(counter) GetMonitor 1]] -#------------ get Scan Var Values - for { set i 0 } { $i < $ScanData(NoVar) } { incr i } { - lappend ScanVar($i,Value) [GetNum [$ScanVar($i,Var) position]] - } - set iFile $ScanData(Ptr) -#------------ write it - set length [llength $ScanData(Counts)] - for { set i 0 } { $i < $length} { incr i} { - set t " " - append t [LeftAlign $i 5] - append t [LeftAlign [lindex $ScanData(Counts) $i ] 12] - for { set ii 0 } { $ii < $ScanData(NoVar) } { incr ii} { - append t [LeftAlign [lindex $ScanVar($ii,Value) $i] 10] - } - Data ins $t $iFile - incr iFile - } - set fd [open $ScanData(File) w] - Data put $fd - close $fd -} -#-------------------------------------------------------------------------- -ScanCommand method GetCounts { } { - instvar ScanData - #------- get data available - set length [llength $ScanData(Counts)] - for { set i 0 } { $i < $length } { incr i} { - lappend result [lindex $ScanData(Counts) $i] - } - #------ put zero in those which are not yet measured - if { $length < $ScanData(NP) } { - for { set i $length } { $i < $ScanData(NP) } { incr i } { - lappend result 0 - } - } - return "scan.Counts= $result" -} -#--------------------------------------------------------------------------- -ScanCommand method EndScan { } { - instvar Data - instvar ScanData - instvar ScanVar - Data add [format "%s End of Data %s" [MC * 30] [MC * 30]] - set fd [open $ScanData(File) w] - Data put $fd - close $fd -} -#------------------------------------------------------------------------- -ScanCommand method EvalInt { } { - set int [GetInt] - ClientPut [format "Interrupt %s detected" $int] - switch -exact $int { - continue { - return OK - } - abortop { - SetInt continue - return SKIP - } - abortscan { - SetInt continue - return ABORT - } - default { - return ABORT - } - } -} -#-------------------------------------------------------------------------- -ScanCommand method DriveTo { iNP } { - instvar ScanData - instvar ScanVar - set command "drive " - for { set i 0 } { $i < $ScanData(NoVar) } { incr i } { - set ScanVar($i,NewVal) [expr $ScanVar($i,Start) + $iNP * \ - $ScanVar($i,Step)] -# append ScanVar($i,Value) " " $ScanVar($i,NewVal) - append command " " $ScanVar($i,Var) " " $ScanVar($i,NewVal) - } - set ret [catch {eval $command } msg ] - if { $ret != 0 } { - ClientPut $msg error - return [$self EvalInt] - } - return OK -} -#------------------------------------------------------------------------ -ScanCommand method CheckScanBounds { } { - instvar ScanData - instvar ScanVar - for { set i 0} { $i < $ScanData(NP) } { incr i } { - for { set ii 0 } { $ii < $ScanData(NoVar) } { incr ii } { - set NewVal [expr $ScanVar($ii,Start) + $i*$ScanVar($ii,Step)] - set iRet [catch {SICSBounds $ScanVar($ii,Var) $NewVal} msg] - if { $iRet != 0 } { - ClientPut $msg error - return 0 - } - } - } - return 1 -} -#------------------------------------------------------------------------- -ScanCommand method Count { } { - instvar ScanData - set command $ScanData(counter) - append command " Count " - append command $ScanData(Preset) - set ret [catch {eval $command } msg ] - if { $ret != 0 } { - ClientPut $msg error - return [$self EvalInt] - } - return OK -} -#------------------------------------------------------------------------- -proc LeftAlign { text iField } { - set item $text - append item [MC " " $iField] - return [string range $item 0 $iField] -} -#------------------------------------------------------------------------- -ScanCommand method ScanStatusHeader { } { - instvar ScanData - instvar ScanVar - append t [LeftAlign NP 5] - append t [LeftAlign Counts 12] - for { set i 0 } { $i < $ScanData(NoVar) } { incr i} { - append t [LeftAlign $ScanVar($i,Var) 10] - } - ClientPut $t status -} -#------------------------------------------------------------------------ -ScanCommand method ProgressReport { i } { - instvar ScanData - instvar ScanVar - $self ScanStatusHeader - append t [LeftAlign $i 5] - append t [LeftAlign [lindex $ScanData(Counts) $i ] 12] - for { set i 0 } { $i < $ScanData(NoVar) } { incr i} { - append t [LeftAlign $ScanVar($i,NewVal) 10] - } - ClientPut $t status -} -#------------------------------------------------------------------------- -ScanCommand method MakeFile { } { - global datapath - instvar ScanData - SicsDataNumber incr - set num1 [SicsDataNumber] - set num [GetNum $num1] - set fil [ format "%s/topsi%4.4d%2.2d.dat" $datapath $num 97] - set ScanData(File) $fil -} - -#-------------------------------------------------------------------------- -ScanCommand method run { } { - instvar ScanData - instvar Data - instvar ScanVar - instvar Active -# start with error checking - if { $ScanData(NP) < 1 } { - ClientPut "ERROR: Insufficient Number of ScanPoints" - return - } - if { $ScanData(NoVar) < 1 } { - ClientPut "ERROR: No variables to scan given!" - return - } -#------- check for activity - if {$Active} { - ClientPut "ERROR: Scan already in progress" error - return - } -#------- check Bounds - if { [$self CheckScanBounds] != 1 } { - return - } - -# clean data space from relicts of previous scans - Data clear - set ScanData(Counts) " " - set ScanData(Monitor) " " - for {set i 0} { $i < $ScanData(NoVar) } { incr i } { - set ScanVar($i,Value) " " - } - -# configure and save data header - $self ConfigureDevices - $self MakeFile - $self SaveHeader - ClientPut [format "Writing %s" $ScanData(File)] - - -# the actual scan loop - SetStatus Scanning - $self SendInterest cinterest NewScan - set Active 1 - for { set i 0 } { $i < $ScanData(NP) } { incr i } { -#---- driving - set ret [$self DriveTo $i] - switch -exact $ret { - OK { } - SKIP { continue } - ABORT { ClientPut "\nERROR: Scan Aborted at drive" - SetStatus Eager - set Active 0 - error "Abort" - } - } -#---- counting - set ret [$self Count] - switch -exact $ret { - OK { } - SKIP { continue } - ABORT { ClientPut "\nERROR: Scan Aborted at counting" - SetStatus Eager - set Active 0 - error "Abort" - } - } -#--- save data - $self StoreScanPoint - $self WriteRecover -#--- invoke interests - $self SendInterest cinterest [$self GetCounts] -#--- Status Report - $self ProgressReport $i - } -#---- final processing - $self EndScan - ClientPut "OK" - SetStatus Eager - set Active 0 -} -#-------------------------------------------------------------------------- -ScanCommand method Recover { } { - instvar ScanData - instvar Data - instvar ScanVar - instvar Active - instvar Recover - global recoverfil - -# ---- read Recover Information - set Recover 1 - $self clear - source $recoverfil - -# configure and save data header - $self ConfigureDevices - $self SaveHeader - -# Write scan start info - $self ScanStatusHeader - -# --- figure out where we are - set Recover 0 - set pos [llength $ScanData(Counts)] - -# ----------------------the actual scan loop - set OldStat [status] - SetStatus Scanning - set Active 1 - for { set i $pos } { $i < $ScanData(NP) } { incr i } { -#---- driving - set ret [$self DriveTo $i] - switch -exact $ret { - OK { } - SKIP { continue } - ABORT { ClientPut "\nERROR: Scan Aborted" - SetStatus $OldStat - set Active 0 - return - } - } -#---- counting - set ret [$self Count] - switch -exact $ret { - OK { } - SKIP { continue } - ABORT { ClientPut "\nERROR: Scan Aborted" - SetStatus $OldStat - set Active 0 - return - } - } -#--- save data - $self StoreScanPoint - $self WriteRecover -#--- Status Report - $self ProgressReport $i - } -#---- final processing - $self EndScan - ClientPut "OK" - SetStatus $OldStat - set Active 0 - -} -#--------------------------------------------------------------------------- -# finally initialise the scan command -ScanCommand new scan counter -#--------------------------------------------------------------------------- -# a new user command which allows status clients to read the counts in a scan -# This is just to circumvent the user protection on scan -proc ScanCounts { } { - set status [ catch {scan GetCounts} result] - if { $status == 0 } { - return $result - } else { - return "scan.Counts= 0" - } -} -#--------------------------------------------------------------------------- -# This is just another utilility function which helps in implementing the -# status display client -proc TextStatus { } { - set text [status] - return [format "Status = %s" $text] -} -#--------------------------------------------------------------------------- -# Dumps time in a useful format -proc sftime {} { - return [format "sicstime = %s" [sicstime]] -} diff --git a/tcl/wwwpulver.tcl b/tcl/wwwpulver.tcl deleted file mode 100644 index 407eee1b..00000000 --- a/tcl/wwwpulver.tcl +++ /dev/null @@ -1,43 +0,0 @@ -#------------------------------------------------------------------------ -# This implements the wwwsics command which generates a listing of -# important experiment parameters in html format for the SICS WWW Status -# application. This version is for the powder diffractometers DMC and -# HRPT. -# -# Mark Koennecke, March 2000 -#------------------------------------------------------------------------ -proc wwwsics {} { -#----- get all the data we need - set user [GetNum [user]] - set sample [GetNum [sample]] - set tit [GetNum [title]] - set ret [catch {lambda} msg] - if {$ret != 0 } { - set lam Undetermined - } else { - set lam [GetNum $msg] - } - set ret [catch {temperature} msg] - if {$ret != 0 } { - set tem Undetermined - } else { - set tem [GetNum $msg] - } - set run [GetNum [sicsdatanumber]] - catch {incr run} msg - set stat [GetNum [status]] -#------- html format the reply - append result "" - append result - append result - append result - append result - append result - append result - append result - append result
Run Number $run
Title $tit
User $user
Sample $sample
wavelength $lam
Sample Temperature $tem
Status $stat
- return $result -} - -#------------ install command -catch {Publish wwwsics Spy} msg 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/tmp/all.hkl b/tmp/all.hkl deleted file mode 100644 index 5722e582..00000000 --- a/tmp/all.hkl +++ /dev/null @@ -1,3013 +0,0 @@ - -7 -7 -21 - -7 -7 -18 - -7 -7 -15 - -7 -7 -12 - -7 -7 -9 - -7 -7 -6 - -7 -7 -3 - -7 -7 0 - -7 -7 3 - -7 -7 6 - -7 -7 9 - -7 -7 12 - -7 -7 15 - -7 -7 18 - -7 -7 21 - -7 -6 -19 - -7 -6 -16 - -7 -6 -13 - -7 -6 -10 - -7 -6 -7 - -7 -6 -4 - -7 -6 -1 - -7 -6 2 - -7 -6 5 - -7 -6 8 - -7 -6 11 - -7 -6 14 - -7 -6 17 - -7 -6 20 - -7 -5 -20 - -7 -5 -17 - -7 -5 -14 - -7 -5 -11 - -7 -5 -8 - -7 -5 -5 - -7 -5 -2 - -7 -5 1 - -7 -5 4 - -7 -5 7 - -7 -5 10 - -7 -5 13 - -7 -5 16 - -7 -5 19 - -7 -4 -21 - -7 -4 -18 - -7 -4 -15 - -7 -4 -12 - -7 -4 -9 - -7 -4 -6 - -7 -4 -3 - -7 -4 0 - -7 -4 3 - -7 -4 6 - -7 -4 9 - -7 -4 12 - -7 -4 15 - -7 -4 18 - -7 -4 21 - -7 -3 -19 - -7 -3 -16 - -7 -3 -13 - -7 -3 -10 - -7 -3 -7 - -7 -3 -4 - -7 -3 -1 - -7 -3 2 - -7 -3 5 - -7 -3 8 - -7 -3 11 - -7 -3 14 - -7 -3 17 - -7 -3 20 - -7 -2 -20 - -7 -2 -17 - -7 -2 -14 - -7 -2 -11 - -7 -2 -8 - -7 -2 -5 - -7 -2 -2 - -7 -2 1 - -7 -2 4 - -7 -2 7 - -7 -2 10 - -7 -2 13 - -7 -2 16 - -7 -2 19 - -7 -1 -21 - -7 -1 -18 - -7 -1 -15 - -7 -1 -12 - -7 -1 -9 - -7 -1 -6 - -7 -1 -3 - -7 -1 0 - -7 -1 3 - -7 -1 6 - -7 -1 9 - -7 -1 12 - -7 -1 15 - -7 -1 18 - -7 -1 21 - -7 0 -16 - -7 0 -10 - -7 0 -4 - -7 0 2 - -7 0 8 - -7 0 14 - -7 0 20 - -7 1 -20 - -7 1 -17 - -7 1 -14 - -7 1 -11 - -7 1 -8 - -7 1 -5 - -7 1 -2 - -7 1 1 - -7 1 4 - -7 1 7 - -7 1 10 - -7 1 13 - -7 1 16 - -7 1 19 - -7 2 -21 - -7 2 -18 - -7 2 -15 - -7 2 -12 - -7 2 -9 - -7 2 -6 - -7 2 -3 - -7 2 0 - -7 2 3 - -7 2 6 - -7 2 9 - -7 2 12 - -7 2 15 - -7 2 18 - -7 2 21 - -7 3 -19 - -7 3 -16 - -7 3 -13 - -7 3 -10 - -7 3 -7 - -7 3 -4 - -7 3 -1 - -7 3 2 - -7 3 5 - -7 3 8 - -7 3 11 - -7 3 14 - -7 3 17 - -7 3 20 - -7 4 -20 - -7 4 -17 - -7 4 -14 - -7 4 -11 - -7 4 -8 - -7 4 -5 - -7 4 -2 - -7 4 1 - -7 4 4 - -7 4 7 - -7 4 10 - -7 4 13 - -7 4 16 - -7 4 19 - -7 5 -21 - -7 5 -18 - -7 5 -15 - -7 5 -12 - -7 5 -9 - -7 5 -6 - -7 5 -3 - -7 5 0 - -7 5 3 - -7 5 6 - -7 5 9 - -7 5 12 - -7 5 15 - -7 5 18 - -7 5 21 - -7 6 -19 - -7 6 -16 - -7 6 -13 - -7 6 -10 - -7 6 -7 - -7 6 -4 - -7 6 -1 - -7 6 2 - -7 6 5 - -7 6 8 - -7 6 11 - -7 6 14 - -7 6 17 - -7 6 20 - -7 7 -20 - -7 7 -17 - -7 7 -14 - -7 7 -11 - -7 7 -8 - -7 7 -5 - -7 7 -2 - -7 7 1 - -7 7 4 - -7 7 7 - -7 7 10 - -7 7 13 - -7 7 16 - -7 7 19 - -6 -7 -20 - -6 -7 -17 - -6 -7 -14 - -6 -7 -11 - -6 -7 -8 - -6 -7 -5 - -6 -7 -2 - -6 -7 1 - -6 -7 4 - -6 -7 7 - -6 -7 10 - -6 -7 13 - -6 -7 16 - -6 -7 19 - -6 -6 -21 - -6 -6 -18 - -6 -6 -15 - -6 -6 -12 - -6 -6 -9 - -6 -6 -6 - -6 -6 -3 - -6 -6 0 - -6 -6 3 - -6 -6 6 - -6 -6 9 - -6 -6 12 - -6 -6 15 - -6 -6 18 - -6 -6 21 - -6 -5 -19 - -6 -5 -16 - -6 -5 -13 - -6 -5 -10 - -6 -5 -7 - -6 -5 -4 - -6 -5 -1 - -6 -5 2 - -6 -5 5 - -6 -5 8 - -6 -5 11 - -6 -5 14 - -6 -5 17 - -6 -5 20 - -6 -4 -20 - -6 -4 -17 - -6 -4 -14 - -6 -4 -11 - -6 -4 -8 - -6 -4 -5 - -6 -4 -2 - -6 -4 1 - -6 -4 4 - -6 -4 7 - -6 -4 10 - -6 -4 13 - -6 -4 16 - -6 -4 19 - -6 -3 -21 - -6 -3 -18 - -6 -3 -15 - -6 -3 -12 - -6 -3 -9 - -6 -3 -6 - -6 -3 -3 - -6 -3 0 - -6 -3 3 - -6 -3 6 - -6 -3 9 - -6 -3 12 - -6 -3 15 - -6 -3 18 - -6 -3 21 - -6 -2 -19 - -6 -2 -16 - -6 -2 -13 - -6 -2 -10 - -6 -2 -7 - -6 -2 -4 - -6 -2 -1 - -6 -2 2 - -6 -2 5 - -6 -2 8 - -6 -2 11 - -6 -2 14 - -6 -2 17 - -6 -2 20 - -6 -1 -20 - -6 -1 -17 - -6 -1 -14 - -6 -1 -11 - -6 -1 -8 - -6 -1 -5 - -6 -1 -2 - -6 -1 1 - -6 -1 4 - -6 -1 7 - -6 -1 10 - -6 -1 13 - -6 -1 16 - -6 -1 19 - -6 0 -18 - -6 0 -12 - -6 0 -6 - -6 0 0 - -6 0 6 - -6 0 12 - -6 0 18 - -6 1 -19 - -6 1 -16 - -6 1 -13 - -6 1 -10 - -6 1 -7 - -6 1 -4 - -6 1 -1 - -6 1 2 - -6 1 5 - -6 1 8 - -6 1 11 - -6 1 14 - -6 1 17 - -6 1 20 - -6 2 -20 - -6 2 -17 - -6 2 -14 - -6 2 -11 - -6 2 -8 - -6 2 -5 - -6 2 -2 - -6 2 1 - -6 2 4 - -6 2 7 - -6 2 10 - -6 2 13 - -6 2 16 - -6 2 19 - -6 3 -21 - -6 3 -18 - -6 3 -15 - -6 3 -12 - -6 3 -9 - -6 3 -6 - -6 3 -3 - -6 3 0 - -6 3 3 - -6 3 6 - -6 3 9 - -6 3 12 - -6 3 15 - -6 3 18 - -6 3 21 - -6 4 -19 - -6 4 -16 - -6 4 -13 - -6 4 -10 - -6 4 -7 - -6 4 -4 - -6 4 -1 - -6 4 2 - -6 4 5 - -6 4 8 - -6 4 11 - -6 4 14 - -6 4 17 - -6 4 20 - -6 5 -20 - -6 5 -17 - -6 5 -14 - -6 5 -11 - -6 5 -8 - -6 5 -5 - -6 5 -2 - -6 5 1 - -6 5 4 - -6 5 7 - -6 5 10 - -6 5 13 - -6 5 16 - -6 5 19 - -6 6 -21 - -6 6 -18 - -6 6 -15 - -6 6 -12 - -6 6 -9 - -6 6 -6 - -6 6 -3 - -6 6 0 - -6 6 3 - -6 6 6 - -6 6 9 - -6 6 12 - -6 6 15 - -6 6 18 - -6 6 21 - -6 7 -19 - -6 7 -16 - -6 7 -13 - -6 7 -10 - -6 7 -7 - -6 7 -4 - -6 7 -1 - -6 7 2 - -6 7 5 - -6 7 8 - -6 7 11 - -6 7 14 - -6 7 17 - -6 7 20 - -5 -7 -19 - -5 -7 -16 - -5 -7 -13 - -5 -7 -10 - -5 -7 -7 - -5 -7 -4 - -5 -7 -1 - -5 -7 2 - -5 -7 5 - -5 -7 8 - -5 -7 11 - -5 -7 14 - -5 -7 17 - -5 -7 20 - -5 -6 -20 - -5 -6 -17 - -5 -6 -14 - -5 -6 -11 - -5 -6 -8 - -5 -6 -5 - -5 -6 -2 - -5 -6 1 - -5 -6 4 - -5 -6 7 - -5 -6 10 - -5 -6 13 - -5 -6 16 - -5 -6 19 - -5 -5 -21 - -5 -5 -18 - -5 -5 -15 - -5 -5 -12 - -5 -5 -9 - -5 -5 -6 - -5 -5 -3 - -5 -5 0 - -5 -5 3 - -5 -5 6 - -5 -5 9 - -5 -5 12 - -5 -5 15 - -5 -5 18 - -5 -5 21 - -5 -4 -19 - -5 -4 -16 - -5 -4 -13 - -5 -4 -10 - -5 -4 -7 - -5 -4 -4 - -5 -4 -1 - -5 -4 2 - -5 -4 5 - -5 -4 8 - -5 -4 11 - -5 -4 14 - -5 -4 17 - -5 -4 20 - -5 -3 -20 - -5 -3 -17 - -5 -3 -14 - -5 -3 -11 - -5 -3 -8 - -5 -3 -5 - -5 -3 -2 - -5 -3 1 - -5 -3 4 - -5 -3 7 - -5 -3 10 - -5 -3 13 - -5 -3 16 - -5 -3 19 - -5 -2 -21 - -5 -2 -18 - -5 -2 -15 - -5 -2 -12 - -5 -2 -9 - -5 -2 -6 - -5 -2 -3 - -5 -2 0 - -5 -2 3 - -5 -2 6 - -5 -2 9 - -5 -2 12 - -5 -2 15 - -5 -2 18 - -5 -2 21 - -5 -1 -19 - -5 -1 -16 - -5 -1 -13 - -5 -1 -10 - -5 -1 -7 - -5 -1 -4 - -5 -1 -1 - -5 -1 2 - -5 -1 5 - -5 -1 8 - -5 -1 11 - -5 -1 14 - -5 -1 17 - -5 -1 20 - -5 0 -20 - -5 0 -14 - -5 0 -8 - -5 0 -2 - -5 0 4 - -5 0 10 - -5 0 16 - -5 1 -21 - -5 1 -18 - -5 1 -15 - -5 1 -12 - -5 1 -9 - -5 1 -6 - -5 1 -3 - -5 1 0 - -5 1 3 - -5 1 6 - -5 1 9 - -5 1 12 - -5 1 15 - -5 1 18 - -5 1 21 - -5 2 -19 - -5 2 -16 - -5 2 -13 - -5 2 -10 - -5 2 -7 - -5 2 -4 - -5 2 -1 - -5 2 2 - -5 2 5 - -5 2 8 - -5 2 11 - -5 2 14 - -5 2 17 - -5 2 20 - -5 3 -20 - -5 3 -17 - -5 3 -14 - -5 3 -11 - -5 3 -8 - -5 3 -5 - -5 3 -2 - -5 3 1 - -5 3 4 - -5 3 7 - -5 3 10 - -5 3 13 - -5 3 16 - -5 3 19 - -5 4 -21 - -5 4 -18 - -5 4 -15 - -5 4 -12 - -5 4 -9 - -5 4 -6 - -5 4 -3 - -5 4 0 - -5 4 3 - -5 4 6 - -5 4 9 - -5 4 12 - -5 4 15 - -5 4 18 - -5 4 21 - -5 5 -19 - -5 5 -16 - -5 5 -13 - -5 5 -10 - -5 5 -7 - -5 5 -4 - -5 5 -1 - -5 5 2 - -5 5 5 - -5 5 8 - -5 5 11 - -5 5 14 - -5 5 17 - -5 5 20 - -5 6 -20 - -5 6 -17 - -5 6 -14 - -5 6 -11 - -5 6 -8 - -5 6 -5 - -5 6 -2 - -5 6 1 - -5 6 4 - -5 6 7 - -5 6 10 - -5 6 13 - -5 6 16 - -5 6 19 - -5 7 -21 - -5 7 -18 - -5 7 -15 - -5 7 -12 - -5 7 -9 - -5 7 -6 - -5 7 -3 - -5 7 0 - -5 7 3 - -5 7 6 - -5 7 9 - -5 7 12 - -5 7 15 - -5 7 18 - -5 7 21 - -4 -7 -21 - -4 -7 -18 - -4 -7 -15 - -4 -7 -12 - -4 -7 -9 - -4 -7 -6 - -4 -7 -3 - -4 -7 0 - -4 -7 3 - -4 -7 6 - -4 -7 9 - -4 -7 12 - -4 -7 15 - -4 -7 18 - -4 -7 21 - -4 -6 -19 - -4 -6 -16 - -4 -6 -13 - -4 -6 -10 - -4 -6 -7 - -4 -6 -4 - -4 -6 -1 - -4 -6 2 - -4 -6 5 - -4 -6 8 - -4 -6 11 - -4 -6 14 - -4 -6 17 - -4 -6 20 - -4 -5 -20 - -4 -5 -17 - -4 -5 -14 - -4 -5 -11 - -4 -5 -8 - -4 -5 -5 - -4 -5 -2 - -4 -5 1 - -4 -5 4 - -4 -5 7 - -4 -5 10 - -4 -5 13 - -4 -5 16 - -4 -5 19 - -4 -4 -21 - -4 -4 -18 - -4 -4 -15 - -4 -4 -12 - -4 -4 -9 - -4 -4 -6 - -4 -4 -3 - -4 -4 0 - -4 -4 3 - -4 -4 6 - -4 -4 9 - -4 -4 12 - -4 -4 15 - -4 -4 18 - -4 -4 21 - -4 -3 -19 - -4 -3 -16 - -4 -3 -13 - -4 -3 -10 - -4 -3 -7 - -4 -3 -4 - -4 -3 -1 - -4 -3 2 - -4 -3 5 - -4 -3 8 - -4 -3 11 - -4 -3 14 - -4 -3 17 - -4 -3 20 - -4 -2 -20 - -4 -2 -17 - -4 -2 -14 - -4 -2 -11 - -4 -2 -8 - -4 -2 -5 - -4 -2 -2 - -4 -2 1 - -4 -2 4 - -4 -2 7 - -4 -2 10 - -4 -2 13 - -4 -2 16 - -4 -2 19 - -4 -1 -21 - -4 -1 -18 - -4 -1 -15 - -4 -1 -12 - -4 -1 -9 - -4 -1 -6 - -4 -1 -3 - -4 -1 0 - -4 -1 3 - -4 -1 6 - -4 -1 9 - -4 -1 12 - -4 -1 15 - -4 -1 18 - -4 -1 21 - -4 0 -16 - -4 0 -10 - -4 0 -4 - -4 0 2 - -4 0 8 - -4 0 14 - -4 0 20 - -4 1 -20 - -4 1 -17 - -4 1 -14 - -4 1 -11 - -4 1 -8 - -4 1 -5 - -4 1 -2 - -4 1 1 - -4 1 4 - -4 1 7 - -4 1 10 - -4 1 13 - -4 1 16 - -4 1 19 - -4 2 -21 - -4 2 -18 - -4 2 -15 - -4 2 -12 - -4 2 -9 - -4 2 -6 - -4 2 -3 - -4 2 0 - -4 2 3 - -4 2 6 - -4 2 9 - -4 2 12 - -4 2 15 - -4 2 18 - -4 2 21 - -4 3 -19 - -4 3 -16 - -4 3 -13 - -4 3 -10 - -4 3 -7 - -4 3 -4 - -4 3 -1 - -4 3 2 - -4 3 5 - -4 3 8 - -4 3 11 - -4 3 14 - -4 3 17 - -4 3 20 - -4 4 -20 - -4 4 -17 - -4 4 -14 - -4 4 -11 - -4 4 -8 - -4 4 -5 - -4 4 -2 - -4 4 1 - -4 4 4 - -4 4 7 - -4 4 10 - -4 4 13 - -4 4 16 - -4 4 19 - -4 5 -21 - -4 5 -18 - -4 5 -15 - -4 5 -12 - -4 5 -9 - -4 5 -6 - -4 5 -3 - -4 5 0 - -4 5 3 - -4 5 6 - -4 5 9 - -4 5 12 - -4 5 15 - -4 5 18 - -4 5 21 - -4 6 -19 - -4 6 -16 - -4 6 -13 - -4 6 -10 - -4 6 -7 - -4 6 -4 - -4 6 -1 - -4 6 2 - -4 6 5 - -4 6 8 - -4 6 11 - -4 6 14 - -4 6 17 - -4 6 20 - -4 7 -20 - -4 7 -17 - -4 7 -14 - -4 7 -11 - -4 7 -8 - -4 7 -5 - -4 7 -2 - -4 7 1 - -4 7 4 - -4 7 7 - -4 7 10 - -4 7 13 - -4 7 16 - -4 7 19 - -3 -7 -20 - -3 -7 -17 - -3 -7 -14 - -3 -7 -11 - -3 -7 -8 - -3 -7 -5 - -3 -7 -2 - -3 -7 1 - -3 -7 4 - -3 -7 7 - -3 -7 10 - -3 -7 13 - -3 -7 16 - -3 -7 19 - -3 -6 -21 - -3 -6 -18 - -3 -6 -15 - -3 -6 -12 - -3 -6 -9 - -3 -6 -6 - -3 -6 -3 - -3 -6 0 - -3 -6 3 - -3 -6 6 - -3 -6 9 - -3 -6 12 - -3 -6 15 - -3 -6 18 - -3 -6 21 - -3 -5 -19 - -3 -5 -16 - -3 -5 -13 - -3 -5 -10 - -3 -5 -7 - -3 -5 -4 - -3 -5 -1 - -3 -5 2 - -3 -5 5 - -3 -5 8 - -3 -5 11 - -3 -5 14 - -3 -5 17 - -3 -5 20 - -3 -4 -20 - -3 -4 -17 - -3 -4 -14 - -3 -4 -11 - -3 -4 -8 - -3 -4 -5 - -3 -4 -2 - -3 -4 1 - -3 -4 4 - -3 -4 7 - -3 -4 10 - -3 -4 13 - -3 -4 16 - -3 -4 19 - -3 -3 -21 - -3 -3 -18 - -3 -3 -15 - -3 -3 -12 - -3 -3 -9 - -3 -3 -6 - -3 -3 -3 - -3 -3 0 - -3 -3 3 - -3 -3 6 - -3 -3 9 - -3 -3 12 - -3 -3 15 - -3 -3 18 - -3 -3 21 - -3 -2 -19 - -3 -2 -16 - -3 -2 -13 - -3 -2 -10 - -3 -2 -7 - -3 -2 -4 - -3 -2 -1 - -3 -2 2 - -3 -2 5 - -3 -2 8 - -3 -2 11 - -3 -2 14 - -3 -2 17 - -3 -2 20 - -3 -1 -20 - -3 -1 -17 - -3 -1 -14 - -3 -1 -11 - -3 -1 -8 - -3 -1 -5 - -3 -1 -2 - -3 -1 1 - -3 -1 4 - -3 -1 7 - -3 -1 10 - -3 -1 13 - -3 -1 16 - -3 -1 19 - -3 0 -18 - -3 0 -12 - -3 0 -6 - -3 0 0 - -3 0 6 - -3 0 12 - -3 0 18 - -3 1 -19 - -3 1 -16 - -3 1 -13 - -3 1 -10 - -3 1 -7 - -3 1 -4 - -3 1 -1 - -3 1 2 - -3 1 5 - -3 1 8 - -3 1 11 - -3 1 14 - -3 1 17 - -3 1 20 - -3 2 -20 - -3 2 -17 - -3 2 -14 - -3 2 -11 - -3 2 -8 - -3 2 -5 - -3 2 -2 - -3 2 1 - -3 2 4 - -3 2 7 - -3 2 10 - -3 2 13 - -3 2 16 - -3 2 19 - -3 3 -21 - -3 3 -18 - -3 3 -15 - -3 3 -12 - -3 3 -9 - -3 3 -6 - -3 3 -3 - -3 3 0 - -3 3 3 - -3 3 6 - -3 3 9 - -3 3 12 - -3 3 15 - -3 3 18 - -3 3 21 - -3 4 -19 - -3 4 -16 - -3 4 -13 - -3 4 -10 - -3 4 -7 - -3 4 -4 - -3 4 -1 - -3 4 2 - -3 4 5 - -3 4 8 - -3 4 11 - -3 4 14 - -3 4 17 - -3 4 20 - -3 5 -20 - -3 5 -17 - -3 5 -14 - -3 5 -11 - -3 5 -8 - -3 5 -5 - -3 5 -2 - -3 5 1 - -3 5 4 - -3 5 7 - -3 5 10 - -3 5 13 - -3 5 16 - -3 5 19 - -3 6 -21 - -3 6 -18 - -3 6 -15 - -3 6 -12 - -3 6 -9 - -3 6 -6 - -3 6 -3 - -3 6 0 - -3 6 3 - -3 6 6 - -3 6 9 - -3 6 12 - -3 6 15 - -3 6 18 - -3 6 21 - -3 7 -19 - -3 7 -16 - -3 7 -13 - -3 7 -10 - -3 7 -7 - -3 7 -4 - -3 7 -1 - -3 7 2 - -3 7 5 - -3 7 8 - -3 7 11 - -3 7 14 - -3 7 17 - -3 7 20 - -2 -7 -19 - -2 -7 -16 - -2 -7 -13 - -2 -7 -10 - -2 -7 -7 - -2 -7 -4 - -2 -7 -1 - -2 -7 2 - -2 -7 5 - -2 -7 8 - -2 -7 11 - -2 -7 14 - -2 -7 17 - -2 -7 20 - -2 -6 -20 - -2 -6 -17 - -2 -6 -14 - -2 -6 -11 - -2 -6 -8 - -2 -6 -5 - -2 -6 -2 - -2 -6 1 - -2 -6 4 - -2 -6 7 - -2 -6 10 - -2 -6 13 - -2 -6 16 - -2 -6 19 - -2 -5 -21 - -2 -5 -18 - -2 -5 -15 - -2 -5 -12 - -2 -5 -9 - -2 -5 -6 - -2 -5 -3 - -2 -5 0 - -2 -5 3 - -2 -5 6 - -2 -5 9 - -2 -5 12 - -2 -5 15 - -2 -5 18 - -2 -5 21 - -2 -4 -19 - -2 -4 -16 - -2 -4 -13 - -2 -4 -10 - -2 -4 -7 - -2 -4 -4 - -2 -4 -1 - -2 -4 2 - -2 -4 5 - -2 -4 8 - -2 -4 11 - -2 -4 14 - -2 -4 17 - -2 -4 20 - -2 -3 -20 - -2 -3 -17 - -2 -3 -14 - -2 -3 -11 - -2 -3 -8 - -2 -3 -5 - -2 -3 -2 - -2 -3 1 - -2 -3 4 - -2 -3 7 - -2 -3 10 - -2 -3 13 - -2 -3 16 - -2 -3 19 - -2 -2 -21 - -2 -2 -18 - -2 -2 -15 - -2 -2 -12 - -2 -2 -9 - -2 -2 -6 - -2 -2 -3 - -2 -2 0 - -2 -2 3 - -2 -2 6 - -2 -2 9 - -2 -2 12 - -2 -2 15 - -2 -2 18 - -2 -2 21 - -2 -1 -19 - -2 -1 -16 - -2 -1 -13 - -2 -1 -10 - -2 -1 -7 - -2 -1 -4 - -2 -1 -1 - -2 -1 2 - -2 -1 5 - -2 -1 8 - -2 -1 11 - -2 -1 14 - -2 -1 17 - -2 -1 20 - -2 0 -20 - -2 0 -14 - -2 0 -8 - -2 0 -2 - -2 0 4 - -2 0 10 - -2 0 16 - -2 1 -21 - -2 1 -18 - -2 1 -15 - -2 1 -12 - -2 1 -9 - -2 1 -6 - -2 1 -3 - -2 1 0 - -2 1 3 - -2 1 6 - -2 1 9 - -2 1 12 - -2 1 15 - -2 1 18 - -2 1 21 - -2 2 -19 - -2 2 -16 - -2 2 -13 - -2 2 -10 - -2 2 -7 - -2 2 -4 - -2 2 -1 - -2 2 2 - -2 2 5 - -2 2 8 - -2 2 11 - -2 2 14 - -2 2 17 - -2 2 20 - -2 3 -20 - -2 3 -17 - -2 3 -14 - -2 3 -11 - -2 3 -8 - -2 3 -5 - -2 3 -2 - -2 3 1 - -2 3 4 - -2 3 7 - -2 3 10 - -2 3 13 - -2 3 16 - -2 3 19 - -2 4 -21 - -2 4 -18 - -2 4 -15 - -2 4 -12 - -2 4 -9 - -2 4 -6 - -2 4 -3 - -2 4 0 - -2 4 3 - -2 4 6 - -2 4 9 - -2 4 12 - -2 4 15 - -2 4 18 - -2 4 21 - -2 5 -19 - -2 5 -16 - -2 5 -13 - -2 5 -10 - -2 5 -7 - -2 5 -4 - -2 5 -1 - -2 5 2 - -2 5 5 - -2 5 8 - -2 5 11 - -2 5 14 - -2 5 17 - -2 5 20 - -2 6 -20 - -2 6 -17 - -2 6 -14 - -2 6 -11 - -2 6 -8 - -2 6 -5 - -2 6 -2 - -2 6 1 - -2 6 4 - -2 6 7 - -2 6 10 - -2 6 13 - -2 6 16 - -2 6 19 - -2 7 -21 - -2 7 -18 - -2 7 -15 - -2 7 -12 - -2 7 -9 - -2 7 -6 - -2 7 -3 - -2 7 0 - -2 7 3 - -2 7 6 - -2 7 9 - -2 7 12 - -2 7 15 - -2 7 18 - -2 7 21 - -1 -7 -21 - -1 -7 -18 - -1 -7 -15 - -1 -7 -12 - -1 -7 -9 - -1 -7 -6 - -1 -7 -3 - -1 -7 0 - -1 -7 3 - -1 -7 6 - -1 -7 9 - -1 -7 12 - -1 -7 15 - -1 -7 18 - -1 -7 21 - -1 -6 -19 - -1 -6 -16 - -1 -6 -13 - -1 -6 -10 - -1 -6 -7 - -1 -6 -4 - -1 -6 -1 - -1 -6 2 - -1 -6 5 - -1 -6 8 - -1 -6 11 - -1 -6 14 - -1 -6 17 - -1 -6 20 - -1 -5 -20 - -1 -5 -17 - -1 -5 -14 - -1 -5 -11 - -1 -5 -8 - -1 -5 -5 - -1 -5 -2 - -1 -5 1 - -1 -5 4 - -1 -5 7 - -1 -5 10 - -1 -5 13 - -1 -5 16 - -1 -5 19 - -1 -4 -21 - -1 -4 -18 - -1 -4 -15 - -1 -4 -12 - -1 -4 -9 - -1 -4 -6 - -1 -4 -3 - -1 -4 0 - -1 -4 3 - -1 -4 6 - -1 -4 9 - -1 -4 12 - -1 -4 15 - -1 -4 18 - -1 -4 21 - -1 -3 -19 - -1 -3 -16 - -1 -3 -13 - -1 -3 -10 - -1 -3 -7 - -1 -3 -4 - -1 -3 -1 - -1 -3 2 - -1 -3 5 - -1 -3 8 - -1 -3 11 - -1 -3 14 - -1 -3 17 - -1 -3 20 - -1 -2 -20 - -1 -2 -17 - -1 -2 -14 - -1 -2 -11 - -1 -2 -8 - -1 -2 -5 - -1 -2 -2 - -1 -2 1 - -1 -2 4 - -1 -2 7 - -1 -2 10 - -1 -2 13 - -1 -2 16 - -1 -2 19 - -1 -1 -21 - -1 -1 -18 - -1 -1 -15 - -1 -1 -12 - -1 -1 -9 - -1 -1 -6 - -1 -1 -3 - -1 -1 0 - -1 -1 3 - -1 -1 6 - -1 -1 9 - -1 -1 12 - -1 -1 15 - -1 -1 18 - -1 -1 21 - -1 0 -16 - -1 0 -10 - -1 0 -4 - -1 0 2 - -1 0 8 - -1 0 14 - -1 0 20 - -1 1 -20 - -1 1 -17 - -1 1 -14 - -1 1 -11 - -1 1 -8 - -1 1 -5 - -1 1 -2 - -1 1 1 - -1 1 4 - -1 1 7 - -1 1 10 - -1 1 13 - -1 1 16 - -1 1 19 - -1 2 -21 - -1 2 -18 - -1 2 -15 - -1 2 -12 - -1 2 -9 - -1 2 -6 - -1 2 -3 - -1 2 0 - -1 2 3 - -1 2 6 - -1 2 9 - -1 2 12 - -1 2 15 - -1 2 18 - -1 2 21 - -1 3 -19 - -1 3 -16 - -1 3 -13 - -1 3 -10 - -1 3 -7 - -1 3 -4 - -1 3 -1 - -1 3 2 - -1 3 5 - -1 3 8 - -1 3 11 - -1 3 14 - -1 3 17 - -1 3 20 - -1 4 -20 - -1 4 -17 - -1 4 -14 - -1 4 -11 - -1 4 -8 - -1 4 -5 - -1 4 -2 - -1 4 1 - -1 4 4 - -1 4 7 - -1 4 10 - -1 4 13 - -1 4 16 - -1 4 19 - -1 5 -21 - -1 5 -18 - -1 5 -15 - -1 5 -12 - -1 5 -9 - -1 5 -6 - -1 5 -3 - -1 5 0 - -1 5 3 - -1 5 6 - -1 5 9 - -1 5 12 - -1 5 15 - -1 5 18 - -1 5 21 - -1 6 -19 - -1 6 -16 - -1 6 -13 - -1 6 -10 - -1 6 -7 - -1 6 -4 - -1 6 -1 - -1 6 2 - -1 6 5 - -1 6 8 - -1 6 11 - -1 6 14 - -1 6 17 - -1 6 20 - -1 7 -20 - -1 7 -17 - -1 7 -14 - -1 7 -11 - -1 7 -8 - -1 7 -5 - -1 7 -2 - -1 7 1 - -1 7 4 - -1 7 7 - -1 7 10 - -1 7 13 - -1 7 16 - -1 7 19 - 0 -7 -20 - 0 -7 -14 - 0 -7 -8 - 0 -7 -2 - 0 -7 4 - 0 -7 10 - 0 -7 16 - 0 -6 -18 - 0 -6 -12 - 0 -6 -6 - 0 -6 0 - 0 -6 6 - 0 -6 12 - 0 -6 18 - 0 -5 -16 - 0 -5 -10 - 0 -5 -4 - 0 -5 2 - 0 -5 8 - 0 -5 14 - 0 -5 20 - 0 -4 -20 - 0 -4 -14 - 0 -4 -8 - 0 -4 -2 - 0 -4 4 - 0 -4 10 - 0 -4 16 - 0 -3 -18 - 0 -3 -12 - 0 -3 -6 - 0 -3 0 - 0 -3 6 - 0 -3 12 - 0 -3 18 - 0 -2 -16 - 0 -2 -10 - 0 -2 -4 - 0 -2 2 - 0 -2 8 - 0 -2 14 - 0 -2 20 - 0 -1 -20 - 0 -1 -14 - 0 -1 -8 - 0 -1 -2 - 0 -1 4 - 0 -1 10 - 0 -1 16 - 0 0 -18 - 0 0 -12 - 0 0 -6 - 0 0 0 - 0 0 6 - 0 0 12 - 0 0 18 - 0 1 -16 - 0 1 -10 - 0 1 -4 - 0 1 2 - 0 1 8 - 0 1 14 - 0 1 20 - 0 2 -20 - 0 2 -14 - 0 2 -8 - 0 2 -2 - 0 2 4 - 0 2 10 - 0 2 16 - 0 3 -18 - 0 3 -12 - 0 3 -6 - 0 3 0 - 0 3 6 - 0 3 12 - 0 3 18 - 0 4 -16 - 0 4 -10 - 0 4 -4 - 0 4 2 - 0 4 8 - 0 4 14 - 0 4 20 - 0 5 -20 - 0 5 -14 - 0 5 -8 - 0 5 -2 - 0 5 4 - 0 5 10 - 0 5 16 - 0 6 -18 - 0 6 -12 - 0 6 -6 - 0 6 0 - 0 6 6 - 0 6 12 - 0 6 18 - 0 7 -16 - 0 7 -10 - 0 7 -4 - 0 7 2 - 0 7 8 - 0 7 14 - 0 7 20 - 1 -7 -19 - 1 -7 -16 - 1 -7 -13 - 1 -7 -10 - 1 -7 -7 - 1 -7 -4 - 1 -7 -1 - 1 -7 2 - 1 -7 5 - 1 -7 8 - 1 -7 11 - 1 -7 14 - 1 -7 17 - 1 -7 20 - 1 -6 -20 - 1 -6 -17 - 1 -6 -14 - 1 -6 -11 - 1 -6 -8 - 1 -6 -5 - 1 -6 -2 - 1 -6 1 - 1 -6 4 - 1 -6 7 - 1 -6 10 - 1 -6 13 - 1 -6 16 - 1 -6 19 - 1 -5 -21 - 1 -5 -18 - 1 -5 -15 - 1 -5 -12 - 1 -5 -9 - 1 -5 -6 - 1 -5 -3 - 1 -5 0 - 1 -5 3 - 1 -5 6 - 1 -5 9 - 1 -5 12 - 1 -5 15 - 1 -5 18 - 1 -5 21 - 1 -4 -19 - 1 -4 -16 - 1 -4 -13 - 1 -4 -10 - 1 -4 -7 - 1 -4 -4 - 1 -4 -1 - 1 -4 2 - 1 -4 5 - 1 -4 8 - 1 -4 11 - 1 -4 14 - 1 -4 17 - 1 -4 20 - 1 -3 -20 - 1 -3 -17 - 1 -3 -14 - 1 -3 -11 - 1 -3 -8 - 1 -3 -5 - 1 -3 -2 - 1 -3 1 - 1 -3 4 - 1 -3 7 - 1 -3 10 - 1 -3 13 - 1 -3 16 - 1 -3 19 - 1 -2 -21 - 1 -2 -18 - 1 -2 -15 - 1 -2 -12 - 1 -2 -9 - 1 -2 -6 - 1 -2 -3 - 1 -2 0 - 1 -2 3 - 1 -2 6 - 1 -2 9 - 1 -2 12 - 1 -2 15 - 1 -2 18 - 1 -2 21 - 1 -1 -19 - 1 -1 -16 - 1 -1 -13 - 1 -1 -10 - 1 -1 -7 - 1 -1 -4 - 1 -1 -1 - 1 -1 2 - 1 -1 5 - 1 -1 8 - 1 -1 11 - 1 -1 14 - 1 -1 17 - 1 -1 20 - 1 0 -20 - 1 0 -14 - 1 0 -8 - 1 0 -2 - 1 0 4 - 1 0 10 - 1 0 16 - 1 1 -21 - 1 1 -18 - 1 1 -15 - 1 1 -12 - 1 1 -9 - 1 1 -6 - 1 1 -3 - 1 1 0 - 1 1 3 - 1 1 6 - 1 1 9 - 1 1 12 - 1 1 15 - 1 1 18 - 1 1 21 - 1 2 -19 - 1 2 -16 - 1 2 -13 - 1 2 -10 - 1 2 -7 - 1 2 -4 - 1 2 -1 - 1 2 2 - 1 2 5 - 1 2 8 - 1 2 11 - 1 2 14 - 1 2 17 - 1 2 20 - 1 3 -20 - 1 3 -17 - 1 3 -14 - 1 3 -11 - 1 3 -8 - 1 3 -5 - 1 3 -2 - 1 3 1 - 1 3 4 - 1 3 7 - 1 3 10 - 1 3 13 - 1 3 16 - 1 3 19 - 1 4 -21 - 1 4 -18 - 1 4 -15 - 1 4 -12 - 1 4 -9 - 1 4 -6 - 1 4 -3 - 1 4 0 - 1 4 3 - 1 4 6 - 1 4 9 - 1 4 12 - 1 4 15 - 1 4 18 - 1 4 21 - 1 5 -19 - 1 5 -16 - 1 5 -13 - 1 5 -10 - 1 5 -7 - 1 5 -4 - 1 5 -1 - 1 5 2 - 1 5 5 - 1 5 8 - 1 5 11 - 1 5 14 - 1 5 17 - 1 5 20 - 1 6 -20 - 1 6 -17 - 1 6 -14 - 1 6 -11 - 1 6 -8 - 1 6 -5 - 1 6 -2 - 1 6 1 - 1 6 4 - 1 6 7 - 1 6 10 - 1 6 13 - 1 6 16 - 1 6 19 - 1 7 -21 - 1 7 -18 - 1 7 -15 - 1 7 -12 - 1 7 -9 - 1 7 -6 - 1 7 -3 - 1 7 0 - 1 7 3 - 1 7 6 - 1 7 9 - 1 7 12 - 1 7 15 - 1 7 18 - 1 7 21 - 2 -7 -21 - 2 -7 -18 - 2 -7 -15 - 2 -7 -12 - 2 -7 -9 - 2 -7 -6 - 2 -7 -3 - 2 -7 0 - 2 -7 3 - 2 -7 6 - 2 -7 9 - 2 -7 12 - 2 -7 15 - 2 -7 18 - 2 -7 21 - 2 -6 -19 - 2 -6 -16 - 2 -6 -13 - 2 -6 -10 - 2 -6 -7 - 2 -6 -4 - 2 -6 -1 - 2 -6 2 - 2 -6 5 - 2 -6 8 - 2 -6 11 - 2 -6 14 - 2 -6 17 - 2 -6 20 - 2 -5 -20 - 2 -5 -17 - 2 -5 -14 - 2 -5 -11 - 2 -5 -8 - 2 -5 -5 - 2 -5 -2 - 2 -5 1 - 2 -5 4 - 2 -5 7 - 2 -5 10 - 2 -5 13 - 2 -5 16 - 2 -5 19 - 2 -4 -21 - 2 -4 -18 - 2 -4 -15 - 2 -4 -12 - 2 -4 -9 - 2 -4 -6 - 2 -4 -3 - 2 -4 0 - 2 -4 3 - 2 -4 6 - 2 -4 9 - 2 -4 12 - 2 -4 15 - 2 -4 18 - 2 -4 21 - 2 -3 -19 - 2 -3 -16 - 2 -3 -13 - 2 -3 -10 - 2 -3 -7 - 2 -3 -4 - 2 -3 -1 - 2 -3 2 - 2 -3 5 - 2 -3 8 - 2 -3 11 - 2 -3 14 - 2 -3 17 - 2 -3 20 - 2 -2 -20 - 2 -2 -17 - 2 -2 -14 - 2 -2 -11 - 2 -2 -8 - 2 -2 -5 - 2 -2 -2 - 2 -2 1 - 2 -2 4 - 2 -2 7 - 2 -2 10 - 2 -2 13 - 2 -2 16 - 2 -2 19 - 2 -1 -21 - 2 -1 -18 - 2 -1 -15 - 2 -1 -12 - 2 -1 -9 - 2 -1 -6 - 2 -1 -3 - 2 -1 0 - 2 -1 3 - 2 -1 6 - 2 -1 9 - 2 -1 12 - 2 -1 15 - 2 -1 18 - 2 -1 21 - 2 0 -16 - 2 0 -10 - 2 0 -4 - 2 0 2 - 2 0 8 - 2 0 14 - 2 0 20 - 2 1 -20 - 2 1 -17 - 2 1 -14 - 2 1 -11 - 2 1 -8 - 2 1 -5 - 2 1 -2 - 2 1 1 - 2 1 4 - 2 1 7 - 2 1 10 - 2 1 13 - 2 1 16 - 2 1 19 - 2 2 -21 - 2 2 -18 - 2 2 -15 - 2 2 -12 - 2 2 -9 - 2 2 -6 - 2 2 -3 - 2 2 0 - 2 2 3 - 2 2 6 - 2 2 9 - 2 2 12 - 2 2 15 - 2 2 18 - 2 2 21 - 2 3 -19 - 2 3 -16 - 2 3 -13 - 2 3 -10 - 2 3 -7 - 2 3 -4 - 2 3 -1 - 2 3 2 - 2 3 5 - 2 3 8 - 2 3 11 - 2 3 14 - 2 3 17 - 2 3 20 - 2 4 -20 - 2 4 -17 - 2 4 -14 - 2 4 -11 - 2 4 -8 - 2 4 -5 - 2 4 -2 - 2 4 1 - 2 4 4 - 2 4 7 - 2 4 10 - 2 4 13 - 2 4 16 - 2 4 19 - 2 5 -21 - 2 5 -18 - 2 5 -15 - 2 5 -12 - 2 5 -9 - 2 5 -6 - 2 5 -3 - 2 5 0 - 2 5 3 - 2 5 6 - 2 5 9 - 2 5 12 - 2 5 15 - 2 5 18 - 2 5 21 - 2 6 -19 - 2 6 -16 - 2 6 -13 - 2 6 -10 - 2 6 -7 - 2 6 -4 - 2 6 -1 - 2 6 2 - 2 6 5 - 2 6 8 - 2 6 11 - 2 6 14 - 2 6 17 - 2 6 20 - 2 7 -20 - 2 7 -17 - 2 7 -14 - 2 7 -11 - 2 7 -8 - 2 7 -5 - 2 7 -2 - 2 7 1 - 2 7 4 - 2 7 7 - 2 7 10 - 2 7 13 - 2 7 16 - 2 7 19 - 3 -7 -20 - 3 -7 -17 - 3 -7 -14 - 3 -7 -11 - 3 -7 -8 - 3 -7 -5 - 3 -7 -2 - 3 -7 1 - 3 -7 4 - 3 -7 7 - 3 -7 10 - 3 -7 13 - 3 -7 16 - 3 -7 19 - 3 -6 -21 - 3 -6 -18 - 3 -6 -15 - 3 -6 -12 - 3 -6 -9 - 3 -6 -6 - 3 -6 -3 - 3 -6 0 - 3 -6 3 - 3 -6 6 - 3 -6 9 - 3 -6 12 - 3 -6 15 - 3 -6 18 - 3 -6 21 - 3 -5 -19 - 3 -5 -16 - 3 -5 -13 - 3 -5 -10 - 3 -5 -7 - 3 -5 -4 - 3 -5 -1 - 3 -5 2 - 3 -5 5 - 3 -5 8 - 3 -5 11 - 3 -5 14 - 3 -5 17 - 3 -5 20 - 3 -4 -20 - 3 -4 -17 - 3 -4 -14 - 3 -4 -11 - 3 -4 -8 - 3 -4 -5 - 3 -4 -2 - 3 -4 1 - 3 -4 4 - 3 -4 7 - 3 -4 10 - 3 -4 13 - 3 -4 16 - 3 -4 19 - 3 -3 -21 - 3 -3 -18 - 3 -3 -15 - 3 -3 -12 - 3 -3 -9 - 3 -3 -6 - 3 -3 -3 - 3 -3 0 - 3 -3 3 - 3 -3 6 - 3 -3 9 - 3 -3 12 - 3 -3 15 - 3 -3 18 - 3 -3 21 - 3 -2 -19 - 3 -2 -16 - 3 -2 -13 - 3 -2 -10 - 3 -2 -7 - 3 -2 -4 - 3 -2 -1 - 3 -2 2 - 3 -2 5 - 3 -2 8 - 3 -2 11 - 3 -2 14 - 3 -2 17 - 3 -2 20 - 3 -1 -20 - 3 -1 -17 - 3 -1 -14 - 3 -1 -11 - 3 -1 -8 - 3 -1 -5 - 3 -1 -2 - 3 -1 1 - 3 -1 4 - 3 -1 7 - 3 -1 10 - 3 -1 13 - 3 -1 16 - 3 -1 19 - 3 0 -18 - 3 0 -12 - 3 0 -6 - 3 0 0 - 3 0 6 - 3 0 12 - 3 0 18 - 3 1 -19 - 3 1 -16 - 3 1 -13 - 3 1 -10 - 3 1 -7 - 3 1 -4 - 3 1 -1 - 3 1 2 - 3 1 5 - 3 1 8 - 3 1 11 - 3 1 14 - 3 1 17 - 3 1 20 - 3 2 -20 - 3 2 -17 - 3 2 -14 - 3 2 -11 - 3 2 -8 - 3 2 -5 - 3 2 -2 - 3 2 1 - 3 2 4 - 3 2 7 - 3 2 10 - 3 2 13 - 3 2 16 - 3 2 19 - 3 3 -21 - 3 3 -18 - 3 3 -15 - 3 3 -12 - 3 3 -9 - 3 3 -6 - 3 3 -3 - 3 3 0 - 3 3 3 - 3 3 6 - 3 3 9 - 3 3 12 - 3 3 15 - 3 3 18 - 3 3 21 - 3 4 -19 - 3 4 -16 - 3 4 -13 - 3 4 -10 - 3 4 -7 - 3 4 -4 - 3 4 -1 - 3 4 2 - 3 4 5 - 3 4 8 - 3 4 11 - 3 4 14 - 3 4 17 - 3 4 20 - 3 5 -20 - 3 5 -17 - 3 5 -14 - 3 5 -11 - 3 5 -8 - 3 5 -5 - 3 5 -2 - 3 5 1 - 3 5 4 - 3 5 7 - 3 5 10 - 3 5 13 - 3 5 16 - 3 5 19 - 3 6 -21 - 3 6 -18 - 3 6 -15 - 3 6 -12 - 3 6 -9 - 3 6 -6 - 3 6 -3 - 3 6 0 - 3 6 3 - 3 6 6 - 3 6 9 - 3 6 12 - 3 6 15 - 3 6 18 - 3 6 21 - 3 7 -19 - 3 7 -16 - 3 7 -13 - 3 7 -10 - 3 7 -7 - 3 7 -4 - 3 7 -1 - 3 7 2 - 3 7 5 - 3 7 8 - 3 7 11 - 3 7 14 - 3 7 17 - 3 7 20 - 4 -7 -19 - 4 -7 -16 - 4 -7 -13 - 4 -7 -10 - 4 -7 -7 - 4 -7 -4 - 4 -7 -1 - 4 -7 2 - 4 -7 5 - 4 -7 8 - 4 -7 11 - 4 -7 14 - 4 -7 17 - 4 -7 20 - 4 -6 -20 - 4 -6 -17 - 4 -6 -14 - 4 -6 -11 - 4 -6 -8 - 4 -6 -5 - 4 -6 -2 - 4 -6 1 - 4 -6 4 - 4 -6 7 - 4 -6 10 - 4 -6 13 - 4 -6 16 - 4 -6 19 - 4 -5 -21 - 4 -5 -18 - 4 -5 -15 - 4 -5 -12 - 4 -5 -9 - 4 -5 -6 - 4 -5 -3 - 4 -5 0 - 4 -5 3 - 4 -5 6 - 4 -5 9 - 4 -5 12 - 4 -5 15 - 4 -5 18 - 4 -5 21 - 4 -4 -19 - 4 -4 -16 - 4 -4 -13 - 4 -4 -10 - 4 -4 -7 - 4 -4 -4 - 4 -4 -1 - 4 -4 2 - 4 -4 5 - 4 -4 8 - 4 -4 11 - 4 -4 14 - 4 -4 17 - 4 -4 20 - 4 -3 -20 - 4 -3 -17 - 4 -3 -14 - 4 -3 -11 - 4 -3 -8 - 4 -3 -5 - 4 -3 -2 - 4 -3 1 - 4 -3 4 - 4 -3 7 - 4 -3 10 - 4 -3 13 - 4 -3 16 - 4 -3 19 - 4 -2 -21 - 4 -2 -18 - 4 -2 -15 - 4 -2 -12 - 4 -2 -9 - 4 -2 -6 - 4 -2 -3 - 4 -2 0 - 4 -2 3 - 4 -2 6 - 4 -2 9 - 4 -2 12 - 4 -2 15 - 4 -2 18 - 4 -2 21 - 4 -1 -19 - 4 -1 -16 - 4 -1 -13 - 4 -1 -10 - 4 -1 -7 - 4 -1 -4 - 4 -1 -1 - 4 -1 2 - 4 -1 5 - 4 -1 8 - 4 -1 11 - 4 -1 14 - 4 -1 17 - 4 -1 20 - 4 0 -20 - 4 0 -14 - 4 0 -8 - 4 0 -2 - 4 0 4 - 4 0 10 - 4 0 16 - 4 1 -21 - 4 1 -18 - 4 1 -15 - 4 1 -12 - 4 1 -9 - 4 1 -6 - 4 1 -3 - 4 1 0 - 4 1 3 - 4 1 6 - 4 1 9 - 4 1 12 - 4 1 15 - 4 1 18 - 4 1 21 - 4 2 -19 - 4 2 -16 - 4 2 -13 - 4 2 -10 - 4 2 -7 - 4 2 -4 - 4 2 -1 - 4 2 2 - 4 2 5 - 4 2 8 - 4 2 11 - 4 2 14 - 4 2 17 - 4 2 20 - 4 3 -20 - 4 3 -17 - 4 3 -14 - 4 3 -11 - 4 3 -8 - 4 3 -5 - 4 3 -2 - 4 3 1 - 4 3 4 - 4 3 7 - 4 3 10 - 4 3 13 - 4 3 16 - 4 3 19 - 4 4 -21 - 4 4 -18 - 4 4 -15 - 4 4 -12 - 4 4 -9 - 4 4 -6 - 4 4 -3 - 4 4 0 - 4 4 3 - 4 4 6 - 4 4 9 - 4 4 12 - 4 4 15 - 4 4 18 - 4 4 21 - 4 5 -19 - 4 5 -16 - 4 5 -13 - 4 5 -10 - 4 5 -7 - 4 5 -4 - 4 5 -1 - 4 5 2 - 4 5 5 - 4 5 8 - 4 5 11 - 4 5 14 - 4 5 17 - 4 5 20 - 4 6 -20 - 4 6 -17 - 4 6 -14 - 4 6 -11 - 4 6 -8 - 4 6 -5 - 4 6 -2 - 4 6 1 - 4 6 4 - 4 6 7 - 4 6 10 - 4 6 13 - 4 6 16 - 4 6 19 - 4 7 -21 - 4 7 -18 - 4 7 -15 - 4 7 -12 - 4 7 -9 - 4 7 -6 - 4 7 -3 - 4 7 0 - 4 7 3 - 4 7 6 - 4 7 9 - 4 7 12 - 4 7 15 - 4 7 18 - 4 7 21 - 5 -7 -21 - 5 -7 -18 - 5 -7 -15 - 5 -7 -12 - 5 -7 -9 - 5 -7 -6 - 5 -7 -3 - 5 -7 0 - 5 -7 3 - 5 -7 6 - 5 -7 9 - 5 -7 12 - 5 -7 15 - 5 -7 18 - 5 -7 21 - 5 -6 -19 - 5 -6 -16 - 5 -6 -13 - 5 -6 -10 - 5 -6 -7 - 5 -6 -4 - 5 -6 -1 - 5 -6 2 - 5 -6 5 - 5 -6 8 - 5 -6 11 - 5 -6 14 - 5 -6 17 - 5 -6 20 - 5 -5 -20 - 5 -5 -17 - 5 -5 -14 - 5 -5 -11 - 5 -5 -8 - 5 -5 -5 - 5 -5 -2 - 5 -5 1 - 5 -5 4 - 5 -5 7 - 5 -5 10 - 5 -5 13 - 5 -5 16 - 5 -5 19 - 5 -4 -21 - 5 -4 -18 - 5 -4 -15 - 5 -4 -12 - 5 -4 -9 - 5 -4 -6 - 5 -4 -3 - 5 -4 0 - 5 -4 3 - 5 -4 6 - 5 -4 9 - 5 -4 12 - 5 -4 15 - 5 -4 18 - 5 -4 21 - 5 -3 -19 - 5 -3 -16 - 5 -3 -13 - 5 -3 -10 - 5 -3 -7 - 5 -3 -4 - 5 -3 -1 - 5 -3 2 - 5 -3 5 - 5 -3 8 - 5 -3 11 - 5 -3 14 - 5 -3 17 - 5 -3 20 - 5 -2 -20 - 5 -2 -17 - 5 -2 -14 - 5 -2 -11 - 5 -2 -8 - 5 -2 -5 - 5 -2 -2 - 5 -2 1 - 5 -2 4 - 5 -2 7 - 5 -2 10 - 5 -2 13 - 5 -2 16 - 5 -2 19 - 5 -1 -21 - 5 -1 -18 - 5 -1 -15 - 5 -1 -12 - 5 -1 -9 - 5 -1 -6 - 5 -1 -3 - 5 -1 0 - 5 -1 3 - 5 -1 6 - 5 -1 9 - 5 -1 12 - 5 -1 15 - 5 -1 18 - 5 -1 21 - 5 0 -16 - 5 0 -10 - 5 0 -4 - 5 0 2 - 5 0 8 - 5 0 14 - 5 0 20 - 5 1 -20 - 5 1 -17 - 5 1 -14 - 5 1 -11 - 5 1 -8 - 5 1 -5 - 5 1 -2 - 5 1 1 - 5 1 4 - 5 1 7 - 5 1 10 - 5 1 13 - 5 1 16 - 5 1 19 - 5 2 -21 - 5 2 -18 - 5 2 -15 - 5 2 -12 - 5 2 -9 - 5 2 -6 - 5 2 -3 - 5 2 0 - 5 2 3 - 5 2 6 - 5 2 9 - 5 2 12 - 5 2 15 - 5 2 18 - 5 2 21 - 5 3 -19 - 5 3 -16 - 5 3 -13 - 5 3 -10 - 5 3 -7 - 5 3 -4 - 5 3 -1 - 5 3 2 - 5 3 5 - 5 3 8 - 5 3 11 - 5 3 14 - 5 3 17 - 5 3 20 - 5 4 -20 - 5 4 -17 - 5 4 -14 - 5 4 -11 - 5 4 -8 - 5 4 -5 - 5 4 -2 - 5 4 1 - 5 4 4 - 5 4 7 - 5 4 10 - 5 4 13 - 5 4 16 - 5 4 19 - 5 5 -21 - 5 5 -18 - 5 5 -15 - 5 5 -12 - 5 5 -9 - 5 5 -6 - 5 5 -3 - 5 5 0 - 5 5 3 - 5 5 6 - 5 5 9 - 5 5 12 - 5 5 15 - 5 5 18 - 5 5 21 - 5 6 -19 - 5 6 -16 - 5 6 -13 - 5 6 -10 - 5 6 -7 - 5 6 -4 - 5 6 -1 - 5 6 2 - 5 6 5 - 5 6 8 - 5 6 11 - 5 6 14 - 5 6 17 - 5 6 20 - 5 7 -20 - 5 7 -17 - 5 7 -14 - 5 7 -11 - 5 7 -8 - 5 7 -5 - 5 7 -2 - 5 7 1 - 5 7 4 - 5 7 7 - 5 7 10 - 5 7 13 - 5 7 16 - 5 7 19 - 6 -7 -20 - 6 -7 -17 - 6 -7 -14 - 6 -7 -11 - 6 -7 -8 - 6 -7 -5 - 6 -7 -2 - 6 -7 1 - 6 -7 4 - 6 -7 7 - 6 -7 10 - 6 -7 13 - 6 -7 16 - 6 -7 19 - 6 -6 -21 - 6 -6 -18 - 6 -6 -15 - 6 -6 -12 - 6 -6 -9 - 6 -6 -6 - 6 -6 -3 - 6 -6 0 - 6 -6 3 - 6 -6 6 - 6 -6 9 - 6 -6 12 - 6 -6 15 - 6 -6 18 - 6 -6 21 - 6 -5 -19 - 6 -5 -16 - 6 -5 -13 - 6 -5 -10 - 6 -5 -7 - 6 -5 -4 - 6 -5 -1 - 6 -5 2 - 6 -5 5 - 6 -5 8 - 6 -5 11 - 6 -5 14 - 6 -5 17 - 6 -5 20 - 6 -4 -20 - 6 -4 -17 - 6 -4 -14 - 6 -4 -11 - 6 -4 -8 - 6 -4 -5 - 6 -4 -2 - 6 -4 1 - 6 -4 4 - 6 -4 7 - 6 -4 10 - 6 -4 13 - 6 -4 16 - 6 -4 19 - 6 -3 -21 - 6 -3 -18 - 6 -3 -15 - 6 -3 -12 - 6 -3 -9 - 6 -3 -6 - 6 -3 -3 - 6 -3 0 - 6 -3 3 - 6 -3 6 - 6 -3 9 - 6 -3 12 - 6 -3 15 - 6 -3 18 - 6 -3 21 - 6 -2 -19 - 6 -2 -16 - 6 -2 -13 - 6 -2 -10 - 6 -2 -7 - 6 -2 -4 - 6 -2 -1 - 6 -2 2 - 6 -2 5 - 6 -2 8 - 6 -2 11 - 6 -2 14 - 6 -2 17 - 6 -2 20 - 6 -1 -20 - 6 -1 -17 - 6 -1 -14 - 6 -1 -11 - 6 -1 -8 - 6 -1 -5 - 6 -1 -2 - 6 -1 1 - 6 -1 4 - 6 -1 7 - 6 -1 10 - 6 -1 13 - 6 -1 16 - 6 -1 19 - 6 0 -18 - 6 0 -12 - 6 0 -6 - 6 0 0 - 6 0 6 - 6 0 12 - 6 0 18 - 6 1 -19 - 6 1 -16 - 6 1 -13 - 6 1 -10 - 6 1 -7 - 6 1 -4 - 6 1 -1 - 6 1 2 - 6 1 5 - 6 1 8 - 6 1 11 - 6 1 14 - 6 1 17 - 6 1 20 - 6 2 -20 - 6 2 -17 - 6 2 -14 - 6 2 -11 - 6 2 -8 - 6 2 -5 - 6 2 -2 - 6 2 1 - 6 2 4 - 6 2 7 - 6 2 10 - 6 2 13 - 6 2 16 - 6 2 19 - 6 3 -21 - 6 3 -18 - 6 3 -15 - 6 3 -12 - 6 3 -9 - 6 3 -6 - 6 3 -3 - 6 3 0 - 6 3 3 - 6 3 6 - 6 3 9 - 6 3 12 - 6 3 15 - 6 3 18 - 6 3 21 - 6 4 -19 - 6 4 -16 - 6 4 -13 - 6 4 -10 - 6 4 -7 - 6 4 -4 - 6 4 -1 - 6 4 2 - 6 4 5 - 6 4 8 - 6 4 11 - 6 4 14 - 6 4 17 - 6 4 20 - 6 5 -20 - 6 5 -17 - 6 5 -14 - 6 5 -11 - 6 5 -8 - 6 5 -5 - 6 5 -2 - 6 5 1 - 6 5 4 - 6 5 7 - 6 5 10 - 6 5 13 - 6 5 16 - 6 5 19 - 6 6 -21 - 6 6 -18 - 6 6 -15 - 6 6 -12 - 6 6 -9 - 6 6 -6 - 6 6 -3 - 6 6 0 - 6 6 3 - 6 6 6 - 6 6 9 - 6 6 12 - 6 6 15 - 6 6 18 - 6 6 21 - 6 7 -19 - 6 7 -16 - 6 7 -13 - 6 7 -10 - 6 7 -7 - 6 7 -4 - 6 7 -1 - 6 7 2 - 6 7 5 - 6 7 8 - 6 7 11 - 6 7 14 - 6 7 17 - 6 7 20 - 7 -7 -19 - 7 -7 -16 - 7 -7 -13 - 7 -7 -10 - 7 -7 -7 - 7 -7 -4 - 7 -7 -1 - 7 -7 2 - 7 -7 5 - 7 -7 8 - 7 -7 11 - 7 -7 14 - 7 -7 17 - 7 -7 20 - 7 -6 -20 - 7 -6 -17 - 7 -6 -14 - 7 -6 -11 - 7 -6 -8 - 7 -6 -5 - 7 -6 -2 - 7 -6 1 - 7 -6 4 - 7 -6 7 - 7 -6 10 - 7 -6 13 - 7 -6 16 - 7 -6 19 - 7 -5 -21 - 7 -5 -18 - 7 -5 -15 - 7 -5 -12 - 7 -5 -9 - 7 -5 -6 - 7 -5 -3 - 7 -5 0 - 7 -5 3 - 7 -5 6 - 7 -5 9 - 7 -5 12 - 7 -5 15 - 7 -5 18 - 7 -5 21 - 7 -4 -19 - 7 -4 -16 - 7 -4 -13 - 7 -4 -10 - 7 -4 -7 - 7 -4 -4 - 7 -4 -1 - 7 -4 2 - 7 -4 5 - 7 -4 8 - 7 -4 11 - 7 -4 14 - 7 -4 17 - 7 -4 20 - 7 -3 -20 - 7 -3 -17 - 7 -3 -14 - 7 -3 -11 - 7 -3 -8 - 7 -3 -5 - 7 -3 -2 - 7 -3 1 - 7 -3 4 - 7 -3 7 - 7 -3 10 - 7 -3 13 - 7 -3 16 - 7 -3 19 - 7 -2 -21 - 7 -2 -18 - 7 -2 -15 - 7 -2 -12 - 7 -2 -9 - 7 -2 -6 - 7 -2 -3 - 7 -2 0 - 7 -2 3 - 7 -2 6 - 7 -2 9 - 7 -2 12 - 7 -2 15 - 7 -2 18 - 7 -2 21 - 7 -1 -19 - 7 -1 -16 - 7 -1 -13 - 7 -1 -10 - 7 -1 -7 - 7 -1 -4 - 7 -1 -1 - 7 -1 2 - 7 -1 5 - 7 -1 8 - 7 -1 11 - 7 -1 14 - 7 -1 17 - 7 -1 20 - 7 0 -20 - 7 0 -14 - 7 0 -8 - 7 0 -2 - 7 0 4 - 7 0 10 - 7 0 16 - 7 1 -21 - 7 1 -18 - 7 1 -15 - 7 1 -12 - 7 1 -9 - 7 1 -6 - 7 1 -3 - 7 1 0 - 7 1 3 - 7 1 6 - 7 1 9 - 7 1 12 - 7 1 15 - 7 1 18 - 7 1 21 - 7 2 -19 - 7 2 -16 - 7 2 -13 - 7 2 -10 - 7 2 -7 - 7 2 -4 - 7 2 -1 - 7 2 2 - 7 2 5 - 7 2 8 - 7 2 11 - 7 2 14 - 7 2 17 - 7 2 20 - 7 3 -20 - 7 3 -17 - 7 3 -14 - 7 3 -11 - 7 3 -8 - 7 3 -5 - 7 3 -2 - 7 3 1 - 7 3 4 - 7 3 7 - 7 3 10 - 7 3 13 - 7 3 16 - 7 3 19 - 7 4 -21 - 7 4 -18 - 7 4 -15 - 7 4 -12 - 7 4 -9 - 7 4 -6 - 7 4 -3 - 7 4 0 - 7 4 3 - 7 4 6 - 7 4 9 - 7 4 12 - 7 4 15 - 7 4 18 - 7 4 21 - 7 5 -19 - 7 5 -16 - 7 5 -13 - 7 5 -10 - 7 5 -7 - 7 5 -4 - 7 5 -1 - 7 5 2 - 7 5 5 - 7 5 8 - 7 5 11 - 7 5 14 - 7 5 17 - 7 5 20 - 7 6 -20 - 7 6 -17 - 7 6 -14 - 7 6 -11 - 7 6 -8 - 7 6 -5 - 7 6 -2 - 7 6 1 - 7 6 4 - 7 6 7 - 7 6 10 - 7 6 13 - 7 6 16 - 7 6 19 - 7 7 -21 - 7 7 -18 - 7 7 -15 - 7 7 -12 - 7 7 -9 - 7 7 -6 - 7 7 -3 - 7 7 0 - 7 7 3 - 7 7 6 - 7 7 9 - 7 7 12 - 7 7 15 - 7 7 18 - 7 7 21 diff --git a/tmp/amorset.tcl b/tmp/amorset.tcl deleted file mode 100644 index 5c3c9295..00000000 --- a/tmp/amorset.tcl +++ /dev/null @@ -1,27 +0,0 @@ -#----------- settings for AMOR which help test the new AMOR settings module -soz softzero 145.5 -com softzero 0 -cox softzero 0 -dbs softzero 23.7 -d2b softzero -5.25 -d2t softzero 0 -d3b softzero -86.18 -d3t softzero -1.8 -d4b softzero 0 -d4t softzero .5 -d5b softzero 0 -d5t softzero 0 -aoz softzero 0 -aom softzero -.026 -com sign -1 -d4b sign -1 -amorset mono read 500 -amorset mono active 1 -amorset slit1 read 1000 -amorset slit1 active 1 -amorset sample read 2000 -amorset sample active 1 -amorset slit4 read 3000 -amorset slit4 active 1 -amorset detector read 4000 -amorset detector active 1 diff --git a/tmp/batchedtest.tcl b/tmp/batchedtest.tcl deleted file mode 100644 index 6be52bbf..00000000 --- a/tmp/batchedtest.tcl +++ /dev/null @@ -1,51 +0,0 @@ -# -title alignement test -user stahn -sample shit -# -dr s2t .0 som .0 -dr stz 15 -count timer 3 -dr stz 17.9 -# -dr s2t .4 som .2 -# -count timer 3 -# -dr s2t 1.2 som .6 -# -count timer 3 -# -dr s2t 1.6 som .8 -# -count timer 3 -# -dr s2t 2.0 som 1 -# -count timer 3 -# -dr s2t 0 som 0 -dr stz 15 -count timer 3 -dr stz 17.9 -# -dr s2t .4 som .2 -# -count timer 3 -# -dr s2t 1.2 som .6 -# -count timer 3 -# -dr s2t 1.6 som .8 -# -count timer 3 -# -dr s2t 2.0 som 1 -# -count timer 3 -# -count timer 3 -count timer 3 -count timer 3 -# diff --git a/tmp/bbtest.tst b/tmp/bbtest.tst deleted file mode 100644 index 6be52bbf..00000000 --- a/tmp/bbtest.tst +++ /dev/null @@ -1,51 +0,0 @@ -# -title alignement test -user stahn -sample shit -# -dr s2t .0 som .0 -dr stz 15 -count timer 3 -dr stz 17.9 -# -dr s2t .4 som .2 -# -count timer 3 -# -dr s2t 1.2 som .6 -# -count timer 3 -# -dr s2t 1.6 som .8 -# -count timer 3 -# -dr s2t 2.0 som 1 -# -count timer 3 -# -dr s2t 0 som 0 -dr stz 15 -count timer 3 -dr stz 17.9 -# -dr s2t .4 som .2 -# -count timer 3 -# -dr s2t 1.2 som .6 -# -count timer 3 -# -dr s2t 1.6 som .8 -# -count timer 3 -# -dr s2t 2.0 som 1 -# -count timer 3 -# -count timer 3 -count timer 3 -count timer 3 -# diff --git a/tmp/btest.tst b/tmp/btest.tst deleted file mode 100644 index 6be52bbf..00000000 --- a/tmp/btest.tst +++ /dev/null @@ -1,51 +0,0 @@ -# -title alignement test -user stahn -sample shit -# -dr s2t .0 som .0 -dr stz 15 -count timer 3 -dr stz 17.9 -# -dr s2t .4 som .2 -# -count timer 3 -# -dr s2t 1.2 som .6 -# -count timer 3 -# -dr s2t 1.6 som .8 -# -count timer 3 -# -dr s2t 2.0 som 1 -# -count timer 3 -# -dr s2t 0 som 0 -dr stz 15 -count timer 3 -dr stz 17.9 -# -dr s2t .4 som .2 -# -count timer 3 -# -dr s2t 1.2 som .6 -# -count timer 3 -# -dr s2t 1.6 som .8 -# -count timer 3 -# -dr s2t 2.0 som 1 -# -count timer 3 -# -count timer 3 -count timer 3 -count timer 3 -# diff --git a/tmp/bug.lis b/tmp/bug.lis deleted file mode 100644 index be88179e..00000000 --- a/tmp/bug.lis +++ /dev/null @@ -1,74 +0,0 @@ -Script started on Tue 13 Sep 2005 12:11:49 PM CEST - - Display type: XWINDOW - -[tasp@pc4478 ~/tasp_sics]$ gdb debsics core.6603 -GNU gdb Red Hat Linux (6.1post-1.20040607.52rh) -Copyright 2004 Free Software Foundation, Inc. -GDB is free software, covered by the GNU General Public License, and you are -welcome to change it and/or distribute copies of it under certain conditions. -Type "show copying" to see the conditions. -There is absolutely no warranty for GDB. Type "show warranty" for details. -This GDB was configured as "i386-redhat-linux-gnu"...Using host libthread_db library "/lib/tls/libthread_db.so.1". - -Core was generated by `/home/tasp/tasp_sics/SICServer /home/tasp/tasp_sics/tasp.tcl'. -Program terminated with signal 11, Segmentation fault. -Reading symbols from /usr/lib/libtcl8.3.so...done. -Loaded symbols for /usr/lib/libtcl8.3.so -Reading symbols from /lib/libdl.so.2...done. -Loaded symbols for /lib/libdl.so.2 -Reading symbols from /lib/tls/libm.so.6...done. -Loaded symbols for /lib/tls/libm.so.6 -Reading symbols from /lib/tls/libc.so.6...done. -Loaded symbols for /lib/tls/libc.so.6 -Reading symbols from /lib/ld-linux.so.2...done. -Loaded symbols for /lib/ld-linux.so.2 -Reading symbols from /lib/libnss_files.so.2...done. -Loaded symbols for /lib/libnss_files.so.2 -Reading symbols from /lib/libnss_dns.so.2...done. -Loaded symbols for /lib/libnss_dns.so.2 -Reading symbols from /lib/libresolv.so.2...done. -Loaded symbols for /lib/libresolv.so.2 -#0 0x00182009 in free () from /lib/tls/libc.so.6 -(gdb) btr  -#0 0x00182009 in free () from /lib/tls/libc.so.6 -#1 0x0017dc0b in _IO_free_backup_area_internal () from /lib/tls/libc.so.6 -#2 0x0017c170 in _IO_new_file_overflow () from /lib/tls/libc.so.6 -#3 0x0017cc00 in _IO_new_file_xsputn () from /lib/tls/libc.so.6 -#4 0x00155357 in vfprintf () from /lib/tls/libc.so.6 -#5 0x0015ddef in fprintf () from /lib/tls/libc.so.6 -#6 0x08050aa0 in WriteSicsStatus (self=0x8667030, - file=0x86b17b0 "/home/tasp/log/syncstatus.tcl", iMot=1) at SCinter.c:424 -#7 0x0805a75c in BackupStatus (pCon=0x867d280, pSics=0x8667030, - pData=0x866dbf8, argc=2, argv=0xbfff91e4) at status.c:344 -#8 0x0805600f in SicsUnknownProc (pData=0x866cf50, pInter=0x8667610, argc=3, - argv=0xbfff91e0) at macro.c:182 -#9 0x00d317ec in TclInvokeStringCommand () from /usr/lib/libtcl8.3.so -#10 0x00d4e603 in TclExecuteByteCode () from /usr/lib/libtcl8.3.so -#11 0x00d32292 in Tcl_EvalObjEx () from /usr/lib/libtcl8.3.so -#12 0x00d746b8 in TclObjInterpProc () from /usr/lib/libtcl8.3.so -#13 0x00d6d513 in TclExpandTokenArray () from /usr/lib/libtcl8.3.so -#14 0x00d6dbfe in Tcl_EvalEx () from /usr/lib/libtcl8.3.so -#15 0x00d6df62 in Tcl_Eval () from /usr/lib/libtcl8.3.so -#16 0x080571d5 in TclAction (pCon=0x867d280, pSics=0x8667030, pData=0x8688d90, - argc=2, argv=0x86ad290) at macro.c:861 -#17 0x080506bc in InterpExecute (self=0x8667030, pCon=0x867d280, - pText=0xbfffa6b0 "syncbackup /home/tasp/log/syncstatus.tcl") ----Type to continue, or q to quit--- - at SCinter.c:301 -#18 0x080576ab in TransactAction (pCon=0x867d280, pSics=0x8667030, - pData=0x866d828, argc=3, argv=0x8685df8) at macro.c:984 -#19 0x080506bc in InterpExecute (self=0x8667030, pCon=0x867d280, - pText=0x86b08f8 "transact syncbackup /home/tasp/log/syncstatus.tcl") - at SCinter.c:301 -#20 0x0804ec0f in SCInvoke (self=0x867d280, pInter=0x8667030, - pCommand=0x86b08f8 "transact syncbackup /home/tasp/log/syncstatus.tcl") - at conman.c:1346 -#21 0x0804fc85 in SCTaskFunction (pData=0x867d280) at conman.c:1824 -#22 0x08055885 in TaskSchedule (self=0x866d198) at task.c:211 -#23 0x08054b36 in RunServer (self=0x8667008) at nserver.c:409 -#24 0x08054f1e in main (argc=2, argv=0xbfffb394) at SICSmain.c:59 -(gdb) quit -[tasp@pc4478 ~/tasp_sics]$ exit - -Script done on Tue 13 Sep 2005 12:12:05 PM CEST diff --git a/tmp/hdbscan.tcl b/tmp/hdbscan.tcl deleted file mode 100644 index aadb0277..00000000 --- a/tmp/hdbscan.tcl +++ /dev/null @@ -1,9 +0,0 @@ -hset /commands/scan/scan_variables som -hset /commands/scan/scan_start 5 -hset /commands/scan/scan_increments .5 -hset /commands/scan/NP 10 -hset /commands/scan/mode Timer -hset /commands/scan/preset 2 - - - diff --git a/tmp/li-reduced.ub b/tmp/li-reduced.ub deleted file mode 100644 index 5bc1430b..00000000 --- a/tmp/li-reduced.ub +++ /dev/null @@ -1,25 +0,0 @@ -om softzero 0 -ch softzero 0 -ph softzero 0 -stt softzero 0 -sample LiNbO3, reduced -user schaniel woike schefer -# June 30, 2005 Schefer Schaniel -hkl setub -0.0853209 -0.0408253 0.0667085 -0.2071918 -0.0948574 -0.0274408 -0.0101375 -0.1991136 -0.0006048 -hkl setub -0.0835069 -0.0359178 0.0669138 -0.2078507 -0.0954050 -0.0269301 -0.0116421 -0.1997965 0.0008301 -hkl setub -0.0835069 -0.0359178 0.0669138 -0.2078507 -0.0954050 -0.0269301 -0.0116421 -0.1997965 0.0008301 -hkl setub -0.0812246 -0.0357234 0.0672142 -0.2088588 -0.0974462 -0.0261738 -0.0095618 -0.1988440 0.0007514 -hkl setub -0.0810901 -0.0376026 0.0691056 -0.2045003 -0.0947790 -0.0274020 -0.0092719 -0.1951536 -0.0000073 -hkl setub -0.0816891 -0.0373536 0.0676441 -0.2036469 -0.0945316 -0.0271433 -0.0093154 -0.1946803 0.0002011 -hkl setub -0.0868862 -0.0387014 0.0661984 -0.2068806 -0.0912656 -0.0277929 -0.0150816 -0.2018639 -0.0001260 -hkl setub 0.0865922 0.0382913 0.0665164 0.2067114 0.0968973 -0.0278987 0.0091118 0.1986342 0.0007869 -hkl setub 0.0865922 0.0483009 -0.0665164 0.2067114 0.1098141 0.0278987 0.0091118 -0.1895224 -0.0007869 -hkl setub 0.0827032 0.0453160 -0.0670359 0.2084762 0.1054149 0.0266105 0.0029515 -0.1927304 -0.0012072 -hkl setub 0.0825852 0.0448308 -0.0665571 0.2067716 0.1091085 0.0265991 0.0076522 -0.1889944 -0.0004319 -hkl setub 0.0812764 0.0440605 -0.0667313 0.2073279 0.1090023 0.0261758 0.0071815 -0.1892602 -0.0004596 -# -July 4, 2005 -hkl setub 0.0821425 0.0444320 -0.0666986 0.2072366 0.1088816 0.0264524 0.0070800 -0.1895129 -0.0004399 -#end ub -exe tmp/table.res -#end diff --git a/tmp/m2t_generator b/tmp/m2t_generator deleted file mode 100755 index cd5abc86..00000000 --- a/tmp/m2t_generator +++ /dev/null @@ -1,85 +0,0 @@ -#!/usr/bin/perl -w -# -# preliminary way to set the monochromator 2 theta angle 'mth' and -# based thereon the sample 2 theta angle 's2t'. -# -use Math::Trig ; -# -################################################################## -# -if ($ARGV[0]) { - $m2t = $ARGV[0] ; -} else { - die " *** usage: m2t_generator \n" ; -} ; -#---------------------------------------------- -# list of off-sets: - $M = 100.0 ; # monitor / polariser - $DS = -50.0 ; # shielding slit - $D2 = -52.5 ; # 2nd diaphragm - $D3 = -53.5 ; # 3rd diaphragm - $S = 280.8 ; # sample table - #$D4 = 0.0 ; 4th diaphragm - #$D5 = 0.0 ; # 5th diaphragm - $D = -162.0 ; # single detector - #$D = 0.0 ; # area detector -#---------------------------------------------- -# list of fix or default values: - $DST = 15.0 ; # opening shielding slit - $D2T = 1.0 ; # opening 2nd diaphragm - $D3T = 1.0 ; # opening 2rd diaphragm - if ( $ARGV[1] ) { - $s2t = $ARGV[1] ; - } else { - $s2t = 0.0 ; # sample 2 theta - } ; -#---------------------------------------------- -# list of positions due to the ruler: - $M += 7440.0 ; # monitor / polariser - $DS += 6980.0 ; # shielding slit - $D2 += 6653.0 ; # 2nd diaphragm - $D3 += 5956.0 ; # 3rd diaphragm - $S += 5047.8 ; # sample table - #$D4 += 0.0 ; # 4th diaphragm - #$D5 += 0.0 ; # 5th diaphragm - $D += 2600.0 ; # detector stage -#---------------------------------------------- -#---------------------------------------------- -# calculus - # from polariser / monochromator to sample - $DSB = abs($M-$DS) * tan(deg2rad($m2t)) - 0.5 * $DST ; - $D2B = abs($M-$D2) * tan(deg2rad($m2t)) - 0.5 * $D2T ; - $D3B = abs($M-$D3) * tan(deg2rad($m2t)) - 0.5 * $D3T ; - $SOZ = abs($M-$S) * tan(deg2rad($m2t)) ; - # from sample to detector - $com = $s2t + $m2t ; - $COX = abs($S-$D) * ( cos(deg2rad(-$com)) - 1 ) ; - $COZ = abs($S-$D) * sin(deg2rad($com)) + $SOZ ; -# - printf "clientput MS = %5.1f mm\n", abs($M-$S) ; - printf "clientput SD = %5.1f mm\n", abs($S-$D) ; - printf "clientput MD = %5.1f mm\n", abs($M-$D) ; - printf "clientput D2M = %5.1f mm\n", abs($M-$D2) ; - printf "clientput D3M = %5.1f mm\n", abs($M-$D3) ; - printf "clientput DBM = %5.1f mm\n", abs($M-$DS) ; -# - printf "clientput run dbs %5.1f \n", $DSB ; - printf "clientput [run dbs %5.1f]\n", $DSB ; - printf "clientput run d2b %5.1f \n", $D2B ; - printf "clientput [run d2b %5.1f]\n", $D2B ; - printf "clientput run d2t %5.1f \n", $D2T ; - printf "clientput [run d2t %5.1f]\n", $D2T ; - printf "clientput run d3b %5.1f \n", $D3B ; - printf "clientput [run d3b %5.1f]\n", $D3B ; - printf "clientput run d3t %5.1f \n", $D3T ; - printf "clientput [run d3t %5.1f]\n", $D3T ; - printf "clientput run soz %5.1f \n", $SOZ ; - printf "clientput [run soz %5.1f]\n", $SOZ ; - printf "clientput run com %5.1f \n", $com ; - printf "clientput [run com %5.1f]\n", $com ; - printf "clientput run cox %5.1f \n", $COX ; - printf "clientput [run cox %5.1f]\n", $COX ; - printf "clientput run coz %5.1f \n", $COZ ; - printf "clientput [run coz %5.1f]\n", $COZ ; -# -# The End * diff --git a/tmp/rafin.bck b/tmp/rafin.bck deleted file mode 100644 index 9d218603..00000000 --- a/tmp/rafin.bck +++ /dev/null @@ -1,9 +0,0 @@ -HoNi2B2C - 1 1 1 0 5. 10.0 - 0 1.1781 - 0 0.0 0 0.0 0 0.0 0 0.0 -0 3.51 0 3.51 0 10.53 0 90. 0 90. 0 90. -0 0 3 19.34 147.218 180. 0. -2 0 0 39.57 67.165 180. 0. -0 2 0 39.57 18. 90. 0. -0 diff --git a/tmp/rafin.dat b/tmp/rafin.dat deleted file mode 100644 index 568235d8..00000000 --- a/tmp/rafin.dat +++ /dev/null @@ -1,21 +0,0 @@ - 1/3 1/3 2 map 5K, CuCrO2 -2 1 0 0 45 3 4 1 .5 0 -0 1.178 -0 .0 0 .0 0 .0 -0 2.9667 0 2.9667 0 17.3977 0 90 0 90 0 120 - 1.0000 1.0000 0.0000 46.742 23.322 182.960 178.382 - -1.0000 2.0000 0.0000 46.740 23.244 182.601 238.437 - 0.0000 0.0000 6.0000 23.867 11.737 92.919 77.023 - 0.0000 -2.0000 1.0000 54.687 27.298 173.003 28.437 - 0.0000 1.0000 1.0000 26.807 13.375 175.101 208.398 - 1.0000 0.0000 2.0000 27.727 13.848 165.785 149.054 - 0.0000 -1.0000 5.0000 33.282 16.614 140.921 28.625 - 1.0000 0.0000 5.0000 33.270 16.627 145.492 150.046 - -1.0000 1.0000 8.0000 41.915 20.725 131.535 265.171 - 1.0000 0.0000 8.0000 41.915 20.978 132.105 151.023 - 0.0000 2.0000 2.0000 55.172 27.515 174.425 208.367 - -2.0000 0.0000 2.0000 55.177 27.515 170.078 328.031 - 3.0000 0.0000 0.0000 86.800 43.319 181.531 148.375 - 0.0000 3.0000 0.0000 86.802 43.319 182.796 208.429 - --1 diff --git a/tmp/rafin.out b/tmp/rafin.out deleted file mode 100644 index 7d6535b7e22be9e0d3af613f1a33a758af4bc454..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8467 zcmeHMTW{jX65eP3irTESf;qy|Hs%&-r15}B&~lS;GCSvJ9~@{BOMoNWWOnw~pRc+N zn1m#3CXx2&j2}#yuBxuCuCFgu^zPj|O2T=xB4YARCTSF}=#*Tu8!c|)1zC;CAWSM& ztJ$E^GW^q|S(t^iis{r6LX-_bt%|$8u810VPwmEOwMOb0he^1UnM`ONEhKcRj!cLf zqH@GTK`-cgbOdLmV$gX!jOri$GhAIGO0Hz~Rmv5O{GK-qdc!kPmK}7(PDjlYtOe0Ii_&Q#Z{=$G zZKvzg#Qe4G_DxcKr1zbX>#@XE%WA#6Lfpo4ntq!unDDU)gTj9N9K>s6GkXOc|;N~4UT6~-5)k3`459Xz0#AwIj8Uf&y@1?NOU zb6BR;Xj<%#G)v-TYKVV({)on|?+(1c^J(G*?EMLy8e5&e*{tCMbb#;z7bFy-47+Wj!pImMq1o?)J&+jRAIS^O4hL-oBE&q zcQIb~Tee>u#yfa#|5ikNmF9m;!-b}1(R{vTdU5;bFj?_z;~7uBA3Q~Wy_jYvs3=#j zeZa7x3>{ldIkQ%GDuHzl`m2eO_I$5-Llcl)cTe1VdG zIIcumg}PV6;8BQd)P-dqL}YOv#1<#ip2+Fj#}HYmnogBBOT7=)TMrS5l#1_7 zF8aZQ+<=fMB5&B?yFHVAcM_1^DEYL`hgPTj_XFq$wx7hp>ou~Y5exb2h4)=vy>&?G zoAK_7xufzP6z3b=?pl^BYksXc1$*4V7g4* zMO=tlE@6kH6R1AnDvBy&E##eC&16hkXb4OVvQ7V=}KZ$2*lird1XYKuVN{WCa#bWd^5pRwga!Dou21jk7dux2}iICR86{F z-&I-kO;w~j@~Mron&)GB3Q2ZTjqG!j-JtwPf5{}K^d_3a{TTWt?WIyfPn12Vm`8r? zx`&SK?Yp=U*?GRTW!CGKO44ii0^K-VAV=UhP37$SWdLs1$x_9N)Gg$7?OMk>+O2A? zKzw+W#}J*KkJ1LF0fj9#Ag^a_iM*1+POF|L zHSddWHE->?9Q7}_Xr~{`Zkdg$Xc(_G>>M4>#n2mukeCFcF%Fy`KYpYMcAwy9a&a7` Qu|H~`yI8P(<|f1VFP8Ul6951J diff --git a/tmp/rafin.out.bck b/tmp/rafin.out.bck deleted file mode 100644 index 7d6535b7e22be9e0d3af613f1a33a758af4bc454..0000000000000000000000000000000000000000 GIT binary patch literal 0 HcmV?d00001 literal 8467 zcmeHMTW{jX65eP3irTESf;qy|Hs%&-r15}B&~lS;GCSvJ9~@{BOMoNWWOnw~pRc+N zn1m#3CXx2&j2}#yuBxuCuCFgu^zPj|O2T=xB4YARCTSF}=#*Tu8!c|)1zC;CAWSM& ztJ$E^GW^q|S(t^iis{r6LX-_bt%|$8u810VPwmEOwMOb0he^1UnM`ONEhKcRj!cLf zqH@GTK`-cgbOdLmV$gX!jOri$GhAIGO0Hz~Rmv5O{GK-qdc!kPmK}7(PDjlYtOe0Ii_&Q#Z{=$G zZKvzg#Qe4G_DxcKr1zbX>#@XE%WA#6Lfpo4ntq!unDDU)gTj9N9K>s6GkXOc|;N~4UT6~-5)k3`459Xz0#AwIj8Uf&y@1?NOU zb6BR;Xj<%#G)v-TYKVV({)on|?+(1c^J(G*?EMLy8e5&e*{tCMbb#;z7bFy-47+Wj!pImMq1o?)J&+jRAIS^O4hL-oBE&q zcQIb~Tee>u#yfa#|5ikNmF9m;!-b}1(R{vTdU5;bFj?_z;~7uBA3Q~Wy_jYvs3=#j zeZa7x3>{ldIkQ%GDuHzl`m2eO_I$5-Llcl)cTe1VdG zIIcumg}PV6;8BQd)P-dqL}YOv#1<#ip2+Fj#}HYmnogBBOT7=)TMrS5l#1_7 zF8aZQ+<=fMB5&B?yFHVAcM_1^DEYL`hgPTj_XFq$wx7hp>ou~Y5exb2h4)=vy>&?G zoAK_7xufzP6z3b=?pl^BYksXc1$*4V7g4* zMO=tlE@6kH6R1AnDvBy&E##eC&16hkXb4OVvQ7V=}KZ$2*lird1XYKuVN{WCa#bWd^5pRwga!Dou21jk7dux2}iICR86{F z-&I-kO;w~j@~Mron&)GB3Q2ZTjqG!j-JtwPf5{}K^d_3a{TTWt?WIyfPn12Vm`8r? zx`&SK?Yp=U*?GRTW!CGKO44ii0^K-VAV=UhP37$SWdLs1$x_9N)Gg$7?OMk>+O2A? zKzw+W#}J*KkJ1LF0fj9#Ag^a_iM*1+POF|L zHSddWHE->?9Q7}_Xr~{`Zkdg$Xc(_G>>M4>#n2mukeCFcF%Fy`KYpYMcAwy9a&a7` Qu|H~`yI8P(<|f1VFP8Ul6951J diff --git a/tmp/sev.go b/tmp/sev.go deleted file mode 100644 index 8293479a..00000000 --- a/tmp/sev.go +++ /dev/null @@ -1,3 +0,0 @@ - -# -dr a4 20 diff --git a/tmp/shell80.go b/tmp/shell80.go deleted file mode 100644 index 16ac60e2..00000000 --- a/tmp/shell80.go +++ /dev/null @@ -1,8 +0,0 @@ -title omega/2theta comparision with previous omega mode -sample omega/2theta -dataset close -dataset psimode 0 -exe tmp/standard-reduced.go -stt softlowerlim 5 -stt softupperlim 120 -mess measure tmp/all.hkl diff --git a/tmp/standard-reduced.go b/tmp/standard-reduced.go deleted file mode 100644 index f0ea7c4e..00000000 --- a/tmp/standard-reduced.go +++ /dev/null @@ -1,7 +0,0 @@ -mess countmode timer -mess preset 1 -mess step .04 -mess np 31 -four -exe tmp/li.ub -#end diff --git a/tmp/t.go b/tmp/t.go deleted file mode 100644 index 1b5dfb7f..00000000 --- a/tmp/t.go +++ /dev/null @@ -1,2 +0,0 @@ -exec /usr/bin/nassnase - diff --git a/tmp/table.res b/tmp/table.res deleted file mode 100644 index e98b3e41..00000000 --- a/tmp/table.res +++ /dev/null @@ -1,18 +0,0 @@ -mess countmode monitor -#read hkl only -mess psimode 0 -# -mess table clear -# -mess table add 35 om 0.035 40 10000 -mess table add 50 om 0.040 40 10000 -mess table add 70 om 0.050 40 10000 -mess table add 80 om 0.050 40 15000 -# makes om/2theta-scans for stt>90 deg -mess table add 90 o2t 0.070 40 20000 -mess table add 100 o2t 0.080 40 20000 -mess table add 110 o2t 0.090 40 25000 -mess table add 120 o2t 0.012 40 30000 -#end table -mess table list -#end \ No newline at end of file diff --git a/tmp/taspstatus.tcl b/tmp/taspstatus.tcl deleted file mode 100644 index 4fd59442..00000000 --- a/tmp/taspstatus.tcl +++ /dev/null @@ -1,637 +0,0 @@ -updateqe -# Motor a1 -a1 sign 1.000000 -a1 SoftZero -0.057000 -a1 SoftLowerLim -86.642998 -a1 SoftUpperLim -9.942999 -a1 Fixed -1.000000 -a1 InterruptMode 0.000000 -a1 precision 0.010000 -a1 ignorefault 0.000000 -a1 AccessCode 2.000000 -a1 movecount 10.000000 -# Motor a2 -a2 sign 1.000000 -a2 SoftZero -0.268000 -a2 SoftLowerLim -124.000000 -a2 SoftUpperLim -20.000002 -a2 Fixed -1.000000 -a2 InterruptMode 1.000000 -a2 precision 0.020000 -a2 ignorefault 0.000000 -a2 AccessCode 2.000000 -a2 movecount 10.000000 -# Motor a3 -a3 sign 1.000000 -a3 SoftZero 0.000000 -a3 SoftLowerLim -176.067017 -a3 SoftUpperLim 160.308945 -a3 Fixed -1.000000 -a3 InterruptMode 0.000000 -a3 precision 0.020000 -a3 ignorefault 0.000000 -a3 AccessCode 2.000000 -a3 movecount 10.000000 -# Motor a4 -a4 sign 1.000000 -a4 SoftZero -0.145000 -a4 SoftLowerLim -10.000000 -a4 SoftUpperLim 132.000000 -a4 Fixed -1.000000 -a4 InterruptMode 1.000000 -a4 precision 0.020000 -a4 ignorefault 0.000000 -a4 AccessCode 2.000000 -a4 movecount 10.000000 -# Motor mcv -mcv sign 1.000000 -mcv SoftZero 0.100000 -mcv SoftLowerLim -5.100000 -mcv SoftUpperLim 90.000000 -mcv Fixed -1.000000 -mcv InterruptMode 0.000000 -mcv precision 0.100000 -mcv ignorefault 0.000000 -mcv AccessCode 2.000000 -mcv movecount 10.000000 -# Motor sro -sro sign 1.000000 -sro SoftZero 0.000000 -sro SoftLowerLim -117.000000 -sro SoftUpperLim 173.000000 -sro Fixed -1.000000 -sro InterruptMode 0.000000 -sro precision 0.010000 -sro ignorefault 0.000000 -sro AccessCode 2.000000 -sro movecount 10.000000 -# Motor mtl -mtl sign 1.000000 -mtl SoftZero 0.000000 -mtl SoftLowerLim -7.000000 -mtl SoftUpperLim 16.000000 -mtl Fixed 1.000000 -mtl InterruptMode 0.000000 -mtl precision 0.010000 -mtl ignorefault 0.000000 -mtl AccessCode 2.000000 -mtl movecount 10.000000 -# Motor mtu -mtu sign 1.000000 -mtu SoftZero -1.800000 -mtu SoftLowerLim -13.800000 -mtu SoftUpperLim 17.799999 -mtu Fixed 1.000000 -mtu InterruptMode 0.000000 -mtu precision 0.050000 -mtu ignorefault 0.000000 -mtu AccessCode 2.000000 -mtu movecount 10.000000 -# Motor mgl -mgl sign 1.000000 -mgl SoftZero 0.000000 -mgl SoftLowerLim -10.000000 -mgl SoftUpperLim 10.000000 -mgl Fixed 1.000000 -mgl InterruptMode 0.000000 -mgl precision 0.010000 -mgl ignorefault 0.000000 -mgl AccessCode 2.000000 -mgl movecount 10.000000 -# Motor a5 -a5 sign 1.000000 -a5 SoftZero 87.680000 -a5 SoftLowerLim -190.309967 -a5 SoftUpperLim 14.690055 -a5 Fixed -1.000000 -a5 InterruptMode 0.000000 -a5 precision 0.010000 -a5 ignorefault 0.000000 -a5 AccessCode 2.000000 -a5 movecount 10.000000 -# Motor a6 -a6 sign 1.000000 -a6 SoftZero -0.190000 -a6 SoftLowerLim -137.809937 -a6 SoftUpperLim 118.119728 -a6 Fixed -1.000000 -a6 InterruptMode 3.000000 -a6 precision 0.010000 -a6 ignorefault 0.000000 -a6 AccessCode 2.000000 -a6 movecount 10.000000 -# Motor ach -ach sign 1.000000 -ach SoftZero 0.000000 -ach SoftLowerLim -0.400000 -ach SoftUpperLim 100.000000 -ach Fixed 1.000000 -ach InterruptMode 0.000000 -ach precision 0.100000 -ach ignorefault 0.000000 -ach AccessCode 2.000000 -ach movecount 10.000000 -# Motor stl -stl sign 1.000000 -stl SoftZero 0.000000 -stl SoftLowerLim -19.000000 -stl SoftUpperLim 19.000000 -stl Fixed -1.000000 -stl InterruptMode 0.000000 -stl precision 0.010000 -stl ignorefault 0.000000 -stl AccessCode 2.000000 -stl movecount 10.000000 -# Motor stu -stu sign 1.000000 -stu SoftZero 0.000000 -stu SoftLowerLim -18.000000 -stu SoftUpperLim 18.000000 -stu Fixed -1.000000 -stu InterruptMode 0.000000 -stu precision 0.010000 -stu ignorefault 0.000000 -stu AccessCode 2.000000 -stu movecount 10.000000 -# Motor atl -atl sign 1.000000 -atl SoftZero 0.000000 -atl SoftLowerLim -17.000000 -atl SoftUpperLim 17.000000 -atl Fixed -1.000000 -atl InterruptMode 0.000000 -atl precision 0.100000 -atl ignorefault 0.000000 -atl AccessCode 2.000000 -atl movecount 10.000000 -# Motor atu -atu sign 1.000000 -atu SoftZero -0.488000 -atu SoftLowerLim -15.512000 -atu SoftUpperLim 16.488001 -atu Fixed 1.000000 -atu InterruptMode 0.000000 -atu precision 0.100000 -atu ignorefault 0.000000 -atu AccessCode 2.000000 -atu movecount 10.000000 -# Motor sgl -sgl sign 1.000000 -sgl SoftZero -0.601000 -sgl SoftLowerLim -11.449000 -sgl SoftUpperLim 15.000000 -sgl Fixed -1.000000 -sgl InterruptMode 0.000000 -sgl precision 0.010000 -sgl ignorefault 0.000000 -sgl AccessCode 2.000000 -sgl movecount 10.000000 -# Motor sgu -sgu sign 1.000000 -sgu SoftZero -0.085000 -sgu SoftLowerLim -13.915000 -sgu SoftUpperLim 15.085000 -sgu Fixed -1.000000 -sgu InterruptMode 0.000000 -sgu precision 0.010000 -sgu ignorefault 0.000000 -sgu AccessCode 2.000000 -sgu movecount 10.000000 -# Motor agl -agl sign 1.000000 -agl SoftZero 0.000000 -agl SoftLowerLim -10.000000 -agl SoftUpperLim 10.000000 -agl Fixed 1.000000 -agl InterruptMode 0.000000 -agl precision 0.010000 -agl ignorefault 0.000000 -agl AccessCode 2.000000 -agl movecount 10.000000 -# Counter counter -counter SetPreset 20000.000000 -counter SetMode Monitor -as 5.176000 -as setAccess 2 -bs 5.176000 -bs setAccess 2 -cs 10.740000 -cs setAccess 2 -aa 90.000000 -aa setAccess 2 -bb 90.000000 -bb setAccess 2 -cc 90.000000 -cc setAccess 2 -ax 1.000000 -ax setAccess 2 -ay 0.000000 -ay setAccess 2 -az 0.000000 -az setAccess 2 -bx 0.000000 -bx setAccess 2 -by 0.000000 -by setAccess 2 -bz -1.000000 -bz setAccess 2 -ei 3.083731 -ei setAccess 2 -ki 1.219954 -ki setAccess 2 -ef 3.501806 -ef setAccess 2 -kf 1.300023 -kf setAccess 2 -qh -0.054029 -qh setAccess 2 -qk 0.000000 -qk setAccess 2 -ql 3.271409 -ql setAccess 2 -en -0.418075 -en setAccess 2 -tei 3.083680 -tei setAccess 2 -tki 1.219944 -tki setAccess 2 -tef 2.983680 -tef setAccess 2 -tkf 1.200000 -tkf setAccess 2 -tqh 0.000000 -tqh setAccess 2 -tqk 0.000000 -tqk setAccess 2 -tql 3.142300 -tql setAccess 2 -ten 0.100000 -ten setAccess 2 -tqm 1.838329 -tqm setAccess 2 -dm 3.354000 -dm setAccess 1 -da 3.354000 -da setAccess 1 -ss 1 -ss setAccess 2 -sa -1 -sa setAccess 2 -fx 2 -fx setAccess 2 -np 31 -np setAccess 2 -ti 20.000000 -ti setAccess 2 -mn 20000 -mn setAccess 2 -if1v 0.010000 -if1v setAccess 2 -if2v 1.000000 -if2v setAccess 2 -if1h 0.000000 -if1h setAccess 2 -if2h 0.000000 -if2h setAccess 2 -helm 15.775705 -helm setAccess 2 -hx 0.000000 -hx setAccess 2 -hy 0.000000 -hy setAccess 2 -hz 0.000000 -hz setAccess 2 -swunit 0 -swunit setAccess 2 -f1 0 -f1 setAccess 2 -f2 0 -f2 setAccess 2 -title water difusion in CLAYS Na-mont +45degrees -title setAccess 2 -user juranyi/gonzalez -user setAccess 2 -lastcommand sc qh 0 0 3.1423 1 dqh 0 0 0 0.1 np 31 mn 20000 -lastcommand setAccess 2 -output a1 a2 a3 a4 a5 a6 ei ef qm -output setAccess 2 -local Ronnow -local setAccess 2 -alf1 800.000000 -alf1 setAccess 2 -alf2 80.000000 -alf2 setAccess 2 -alf3 800.000000 -alf3 setAccess 2 -alf4 800.000000 -alf4 setAccess 2 -bet1 400.000000 -bet1 setAccess 2 -bet2 400.000000 -bet2 setAccess 2 -bet3 400.000000 -bet3 setAccess 2 -bet4 400.000000 -bet4 setAccess 2 -da1 -0.146000 -da1 setAccess 2 -da2 0.200000 -da2 setAccess 2 -da3 0.050000 -da3 setAccess 2 -da4 0.200000 -da4 setAccess 2 -da5 0.200000 -da5 setAccess 2 -da6 0.500000 -da6 setAccess 2 -dmcv 5.000000 -dmcv setAccess 2 -dsro 0.000000 -dsro setAccess 2 -dach 0.250000 -dach setAccess 2 -dmtl 0.500000 -dmtl setAccess 2 -dmtu 2.000000 -dmtu setAccess 2 -dstl 0.000000 -dstl setAccess 2 -dstu 0.000000 -dstu setAccess 2 -datl 2.000000 -datl setAccess 2 -datu 0.500000 -datu setAccess 2 -dmgl 0.200000 -dmgl setAccess 2 -dsgl -0.500000 -dsgl setAccess 2 -dsgu 0.500000 -dsgu setAccess 2 -dagl 1.000000 -dagl setAccess 2 -dei 0.500000 -dei setAccess 2 -dki -0.050000 -dki setAccess 2 -def 0.500000 -def setAccess 2 -dkf 0.000000 -dkf setAccess 2 -dqh 0.000000 -dqh setAccess 2 -dqk 0.000000 -dqk setAccess 2 -dql 0.000000 -dql setAccess 2 -den 0.100000 -den setAccess 2 -wav 0.000000 -wav setAccess 2 -etam 15.000000 -etam setAccess 2 -etas 60.000000 -etas setAccess 2 -etaa 30.000000 -etaa setAccess 2 -qm 1.914984 -qm setAccess 2 -dqm 21.000000 -dqm setAccess 2 -dtt 5.000000 -dtt setAccess 2 -lpa 0 -lpa setAccess 2 -di1 0.000000 -di1 setAccess 2 -di2 0.000000 -di2 setAccess 2 -di3 0.000000 -di3 setAccess 2 -di4 0.000000 -di4 setAccess 2 -di5 0.000000 -di5 setAccess 2 -di6 1.000000 -di6 setAccess 2 -di7 0.000000 -di7 setAccess 2 -di8 0.000000 -di8 setAccess 2 -dhx 0.000000 -dhx setAccess 2 -dhy 0.000000 -dhy setAccess 2 -dhz 0.000000 -dhz setAccess 2 -ti1 0.000000 -ti1 setAccess 2 -ti2 0.000000 -ti2 setAccess 2 -ti3 -5.000000 -ti3 setAccess 2 -ti4 0.000000 -ti4 setAccess 2 -ti5 0.000000 -ti5 setAccess 2 -ti6 0.000000 -ti6 setAccess 2 -ti7 0.000000 -ti7 setAccess 2 -ti8 0.000000 -ti8 setAccess 2 -thx 0.000000 -thx setAccess 2 -thy 0.000000 -thy setAccess 2 -thz 0.000000 -thz setAccess 2 -mrx1 1.000000 -mrx1 setAccess 1 -mrx2 8.880000 -mrx2 setAccess 1 -arx1 0.136500 -arx1 setAccess 1 -arx2 4.330500 -arx2 setAccess 1 -hconv1 1.000000 -hconv1 setAccess 1 -hconv2 1.000000 -hconv2 setAccess 1 -hconv3 1.000000 -hconv3 setAccess 1 -hconv4 1.000000 -hconv4 setAccess 1 -polfile /home/tasp/kuhn/flip_om.pal -polfile setAccess 2 -diffscan monitor 4.000000 -diffscan skip 0.000000 -exe batchpath /home/tasp/juranyi -exe syspath ./ -a1 hardupperlim 6.100000 -a1 hardlowerlim -86.699997 -a2 hardupperlim -21.650000 -a2 hardlowerlim -128.500000 -a3 hardupperlim 170.000000 -a3 hardlowerlim -179.000000 -a4 hardupperlim 137.899994 -a4 hardlowerlim -135.500000 -a5 hardupperlim 103.000000 -a5 hardlowerlim -103.000000 -a6 hardupperlim 119.000000 -a6 hardlowerlim -138.000000 -mcv hardupperlim 93.000000 -mcv hardlowerlim -5.000000 -sro hardupperlim 173.000000 -sro hardlowerlim -117.000000 -ach hardupperlim 10.000000 -ach hardlowerlim -0.400000 -mtl hardupperlim 17.000000 -mtl hardlowerlim -17.000000 -mtu hardupperlim 17.000000 -mtu hardlowerlim -17.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -stu hardupperlim 18.000000 -stu hardlowerlim -18.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -atu hardupperlim 17.000000 -atu hardlowerlim -17.000000 -mgl hardupperlim 10.000000 -mgl hardlowerlim -10.000000 -sgl hardupperlim 15.200000 -sgl hardlowerlim -16.299999 -sgu hardupperlim 17.500000 -sgu hardlowerlim -14.200000 -agl hardupperlim 10.000000 -agl hardlowerlim -10.000000 -atl hardupperlim 17.000000 -atl hardlowerlim -17.000000 -updateqe -a1 hardupperlim 6.100000 -a1 hardlowerlim -86.699997 -a2 hardupperlim -21.650000 -a2 hardlowerlim -128.500000 -a3 hardupperlim 170.000000 -a3 hardlowerlim -179.000000 -a4 hardupperlim 137.899994 -a4 hardlowerlim -135.500000 -a5 hardupperlim 103.000000 -a5 hardlowerlim -103.000000 -a6 hardupperlim 119.000000 -a6 hardlowerlim -138.000000 -mcv hardupperlim 93.000000 -mcv hardlowerlim -5.000000 -sro hardupperlim 173.000000 -sro hardlowerlim -117.000000 -ach hardupperlim 10.000000 -ach hardlowerlim -0.400000 -mtl hardupperlim 17.000000 -mtl hardlowerlim -17.000000 -mtu hardupperlim 17.000000 -mtu hardlowerlim -17.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -stu hardupperlim 18.000000 -stu hardlowerlim -18.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -atu hardupperlim 17.000000 -atu hardlowerlim -17.000000 -mgl hardupperlim 10.000000 -mgl hardlowerlim -10.000000 -sgl hardupperlim 15.200000 -sgl hardlowerlim -16.299999 -sgu hardupperlim 17.500000 -sgu hardlowerlim -14.200000 -agl hardupperlim 10.000000 -agl hardlowerlim -10.000000 -atl hardupperlim 17.000000 -atl hardlowerlim -17.000000 -updateqe -a1 hardupperlim 6.100000 -a1 hardlowerlim -86.699997 -a2 hardupperlim -21.650000 -a2 hardlowerlim -128.500000 -a3 hardupperlim 170.000000 -a3 hardlowerlim -179.000000 -a4 hardupperlim 137.899994 -a4 hardlowerlim -135.500000 -a5 hardupperlim 103.000000 -a5 hardlowerlim -103.000000 -a6 hardupperlim 119.000000 -a6 hardlowerlim -138.000000 -mcv hardupperlim 93.000000 -mcv hardlowerlim -5.000000 -sro hardupperlim 173.000000 -sro hardlowerlim -117.000000 -ach hardupperlim 10.000000 -ach hardlowerlim -0.400000 -mtl hardupperlim 17.000000 -mtl hardlowerlim -17.000000 -mtu hardupperlim 17.000000 -mtu hardlowerlim -17.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -stu hardupperlim 18.000000 -stu hardlowerlim -18.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -atu hardupperlim 17.000000 -atu hardlowerlim -17.000000 -mgl hardupperlim 10.000000 -mgl hardlowerlim -10.000000 -sgl hardupperlim 15.200000 -sgl hardlowerlim -16.299999 -sgu hardupperlim 17.500000 -sgu hardlowerlim -14.200000 -agl hardupperlim 10.000000 -agl hardlowerlim -10.000000 -atl hardupperlim 17.000000 -atl hardlowerlim -17.000000 -updateqe -a1 hardupperlim 6.100000 -a1 hardlowerlim -86.699997 -a2 hardupperlim -21.650000 -a2 hardlowerlim -128.500000 -a3 hardupperlim 170.000000 -a3 hardlowerlim -179.000000 -a4 hardupperlim 137.899994 -a4 hardlowerlim -135.500000 -a5 hardupperlim 103.000000 -a5 hardlowerlim -103.000000 -a6 hardupperlim 119.000000 -a6 hardlowerlim -138.000000 -mcv hardupperlim 93.000000 -mcv hardlowerlim -5.000000 -sro hardupperlim 173.000000 -sro hardlowerlim -117.000000 -ach hardupperlim 10.000000 -ach hardlowerlim -0.400000 -mtl hardupperlim 17.000000 -mtl hardlowerlim -17.000000 -mtu hardupperlim 17.000000 -mtu hardlowerlim -17.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -stu hardupperlim 18.000000 -stu hardlowerlim -18.000000 -stl hardupperlim 19.000000 -stl hardlowerlim -19.000000 -atu hardupperlim 17.000000 -atu hardlowerlim -17.000000 -mgl hardupperlim 10.000000 -mgl hardlowerlim -10.000000 -sgl hardupperlim 15.200000 -sgl hardlowerlim -16.299999 -sgu hardupperlim 17.500000 -sgu hardlowerlim -14.200000 -agl hardupperlim 10.000000 -agl hardlowerlim -10.000000 -atl hardupperlim 17.000000 -atl hardlowerlim -17.000000 -updateqe -catch { remob new cfgenv sea } -catch { remob new samenv sea } diff --git a/tmp/tasubstat.tcl b/tmp/tasubstat.tcl deleted file mode 100644 index 41628238..00000000 --- a/tmp/tasubstat.tcl +++ /dev/null @@ -1,264 +0,0 @@ -exe batchpath ./ -exe syspath ./ -#---- tasUB module tasub -tasub mono dd 3.354000 -tasub mono hb1 1.000000 -tasub mono hb2 1.000000 -tasub mono vb1 1.000000 -tasub mono vb2 1.000000 -tasub mono ss -1 -tasub ana dd 3.354000 -tasub ana hb1 1.000000 -tasub ana hb2 1.000000 -tasub ana vb1 1.000000 -tasub ana vb2 1.000000 -tasub ana ss -1 -tasub cell 5.955000 6.836200 3.246200 90.000000 90.000000 90.000000 -tasub clear -tasub addref 0.00 2.00 0.00 1.14 27.72 0.67 1.88 30.50 30.50 -tasub addref 0.00 0.00 2.00 -72.29 60.59 0.67 -0.99 30.50 30.50 -tasub const kf -tasub ss 1 - tasub setub -0.005106 -0.142613 0.067899 0.000176 -0.032261 -0.300467 0.167848 -0.004304 0.002380 - tasub setnormal -0.030403 0.001046 0.999534 -tasub settarget 0.000000 2.000000 2.000000 2.000000 3.836675 3.836675 -tasub r1 0.00 2.00 0.00 1.14 27.72 0.67 1.88 30.50 30.50 -tasub r2 0.00 0.00 2.00 -72.29 60.59 0.67 -0.99 30.50 30.50 -tasub update -scaninfo 0,Unknown,1.0,.1 -scaninfo setAccess 0 -etaa 0.000000 -etaa setAccess 2 -etas 0.000000 -etas setAccess 2 -etam 0.000000 -etam setAccess 2 -bet4 0.000000 -bet4 setAccess 2 -bet3 0.000000 -bet3 setAccess 2 -bet2 0.000000 -bet2 setAccess 2 -bet1 0.000000 -bet1 setAccess 2 -alf4 0.000000 -alf4 setAccess 2 -alf3 0.000000 -alf3 setAccess 2 -alf2 0.000000 -alf2 setAccess 2 -alf1 10.000000 -alf1 setAccess 2 -polfile UNKNOWN -polfile setAccess 2 -sample UNKNOWN -sample setAccess 2 -local UNKNOWN -local setAccess 2 -output a3 a4 sgu sgl -output setAccess 2 -lastscancommand sc qh 1. 0 0 0 dqh .1 0 0 .2 np 5 ti 1 -lastscancommand setAccess 2 -email UNKNOWN -email setAccess 2 -address UNKNOWN -address setAccess 2 -affiliation UNKNOWN -affiliation setAccess 2 -user UNKNOWN -user setAccess 2 -title UNKNOWN -title setAccess 2 -# Counter counter -counter SetPreset 1.000000 -counter SetMode Timer -# Motor agl -agl sign 1.000000 -agl SoftZero 0.000000 -agl SoftLowerLim -10.000000 -agl SoftUpperLim 10.000000 -agl Fixed -1.000000 -agl InterruptMode 0.000000 -agl precision 0.010000 -agl AccessCode 2.000000 -agl movecount 10.000000 -# Motor sgu -sgu sign 1.000000 -sgu SoftZero 0.000000 -sgu SoftLowerLim -16.000000 -sgu SoftUpperLim 16.000000 -sgu Fixed -1.000000 -sgu InterruptMode 0.000000 -sgu precision 0.010000 -sgu AccessCode 2.000000 -sgu movecount 10.000000 -# Motor sgl -sgl sign 1.000000 -sgl SoftZero 0.000000 -sgl SoftLowerLim -16.000000 -sgl SoftUpperLim 16.000000 -sgl Fixed -1.000000 -sgl InterruptMode 0.000000 -sgl precision 0.010000 -sgl AccessCode 2.000000 -sgl movecount 10.000000 -# Motor mgl -mgl sign 1.000000 -mgl SoftZero 0.000000 -mgl SoftLowerLim -10.000000 -mgl SoftUpperLim 10.000000 -mgl Fixed -1.000000 -mgl InterruptMode 0.000000 -mgl precision 0.010000 -mgl AccessCode 2.000000 -mgl movecount 10.000000 -# Motor atu -atu sign 1.000000 -atu SoftZero 0.000000 -atu SoftLowerLim -17.000000 -atu SoftUpperLim 16.879999 -atu Fixed -1.000000 -atu InterruptMode 0.000000 -atu precision 0.010000 -atu AccessCode 2.000000 -atu movecount 10.000000 -# Motor atl -atl sign 1.000000 -atl SoftZero 0.000000 -atl SoftLowerLim -17.000000 -atl SoftUpperLim 17.000000 -atl Fixed -1.000000 -atl InterruptMode 0.000000 -atl precision 0.010000 -atl AccessCode 2.000000 -atl movecount 10.000000 -# Motor stu -stu sign 1.000000 -stu SoftZero 0.000000 -stu SoftLowerLim -30.000000 -stu SoftUpperLim 30.000000 -stu Fixed -1.000000 -stu InterruptMode 0.000000 -stu precision 0.010000 -stu AccessCode 2.000000 -stu movecount 10.000000 -# Motor stl -stl sign 1.000000 -stl SoftZero 0.000000 -stl SoftLowerLim -30.000000 -stl SoftUpperLim 30.000000 -stl Fixed -1.000000 -stl InterruptMode 0.000000 -stl precision 0.010000 -stl AccessCode 2.000000 -stl movecount 10.000000 -# Motor mtu -mtu sign 1.000000 -mtu SoftZero 0.000000 -mtu SoftLowerLim -17.000000 -mtu SoftUpperLim 17.000000 -mtu Fixed -1.000000 -mtu InterruptMode 0.000000 -mtu precision 0.010000 -mtu AccessCode 2.000000 -mtu movecount 10.000000 -# Motor mtl -mtl sign 1.000000 -mtl SoftZero 0.000000 -mtl SoftLowerLim -17.000000 -mtl SoftUpperLim 17.000000 -mtl Fixed -1.000000 -mtl InterruptMode 0.000000 -mtl precision 0.010000 -mtl AccessCode 2.000000 -mtl movecount 10.000000 -# Motor ach -ach sign 1.000000 -ach SoftZero 0.000000 -ach SoftLowerLim -0.500000 -ach SoftUpperLim 11.500000 -ach Fixed -1.000000 -ach InterruptMode 0.000000 -ach precision 0.010000 -ach AccessCode 2.000000 -ach movecount 10.000000 -# Motor sro -sro sign 1.000000 -sro SoftZero 0.000000 -sro SoftLowerLim 0.000000 -sro SoftUpperLim 351.000000 -sro Fixed -1.000000 -sro InterruptMode 0.000000 -sro precision 0.010000 -sro AccessCode 2.000000 -sro movecount 10.000000 -# Motor mcv -mcv sign 1.000000 -mcv SoftZero 0.000000 -mcv SoftLowerLim -9.000000 -mcv SoftUpperLim 124.000000 -mcv Fixed -1.000000 -mcv InterruptMode 0.000000 -mcv precision 0.010000 -mcv AccessCode 2.000000 -mcv movecount 10.000000 -# Motor a6 -a6 sign 1.000000 -a6 SoftZero 0.000000 -a6 SoftLowerLim -116.000000 -a6 SoftUpperLim 166.000000 -a6 Fixed -1.000000 -a6 InterruptMode 0.000000 -a6 precision 0.010000 -a6 AccessCode 2.000000 -a6 movecount 10.000000 -# Motor a5 -a5 sign 1.000000 -a5 SoftZero 0.000000 -a5 SoftLowerLim -200.000000 -a5 SoftUpperLim 200.000000 -a5 Fixed -1.000000 -a5 InterruptMode 0.000000 -a5 precision 0.010000 -a5 AccessCode 2.000000 -a5 movecount 10.000000 -# Motor a4 -a4 sign 1.000000 -a4 SoftZero 0.000000 -a4 SoftLowerLim -135.100006 -a4 SoftUpperLim 123.400002 -a4 Fixed -1.000000 -a4 InterruptMode 0.000000 -a4 precision 0.010000 -a4 AccessCode 2.000000 -a4 movecount 10.000000 -# Motor a3 -a3 sign 1.000000 -a3 SoftZero 0.000000 -a3 SoftLowerLim -177.300003 -a3 SoftUpperLim 177.300003 -a3 Fixed -1.000000 -a3 InterruptMode 0.000000 -a3 precision 0.010000 -a3 AccessCode 2.000000 -a3 movecount 10.000000 -# Motor a2 -a2 sign 1.000000 -a2 SoftZero 0.000000 -a2 SoftLowerLim -129.100006 -a2 SoftUpperLim -22.000000 -a2 Fixed -1.000000 -a2 InterruptMode 0.000000 -a2 precision 0.010000 -a2 AccessCode 2.000000 -a2 movecount 10.000000 -# Motor a1 -a1 sign 1.000000 -a1 SoftZero 0.000000 -a1 SoftLowerLim -87.000000 -a1 SoftUpperLim 6.100000 -a1 Fixed -1.000000 -a1 InterruptMode 0.000000 -a1 precision 0.010000 -a1 AccessCode 2.000000 -a1 movecount 10.000000 diff --git a/tmp/tricsstatus.tcl b/tmp/tricsstatus.tcl deleted file mode 100644 index 2b3b4b50..00000000 --- a/tmp/tricsstatus.tcl +++ /dev/null @@ -1,855 +0,0 @@ -exe batchpath /home/tricslnsg/zaharko/langasite2 -exe syspath ./ -title langatite N1 RT closed cradle -title setAccess 2 -sample langasite N1 -sample setAccess 2 -user kusmicheva -user setAccess 2 -fax EMERGENCY: 056 - 250.1332 -fax setAccess 2 -phone 077 403 3332 -phone setAccess 2 -distance 0.000000 -distance setAccess 2 -monochromator UNKNOWN -monochromator setAccess 2 -batchroot /home/tricslnsg/roessli/furnace/ -batchroot setAccess 2 -lastscancommand cscan om 5 .1 3 3 -lastscancommand setAccess 2 -# Motor momu -momu sign 1.000000 -momu SoftZero 0.000000 -momu SoftLowerLim -160.000000 -momu SoftUpperLim 500.000000 -momu Fixed -1.000000 -momu InterruptMode 0.000000 -momu precision 0.010000 -momu ignorefault 0.000000 -momu AccessCode 2.000000 -momu failafter 3.000000 -momu maxretry 3.000000 -momu movecount 10.000000 -# Motor mtvu -mtvu sign 1.000000 -mtvu SoftZero 0.000000 -mtvu SoftLowerLim -9.750000 -mtvu SoftUpperLim 10.000000 -mtvu Fixed -1.000000 -mtvu InterruptMode 0.000000 -mtvu precision 0.010000 -mtvu ignorefault 0.000000 -mtvu AccessCode 2.000000 -mtvu failafter 3.000000 -mtvu maxretry 3.000000 -mtvu movecount 10.000000 -# Motor mtpu -mtpu sign 1.000000 -mtpu SoftZero 0.000000 -mtpu SoftLowerLim -10.000000 -mtpu SoftUpperLim 9.500000 -mtpu Fixed -1.000000 -mtpu InterruptMode 0.000000 -mtpu precision 0.010000 -mtpu ignorefault 0.000000 -mtpu AccessCode 2.000000 -mtpu failafter 3.000000 -mtpu maxretry 3.000000 -mtpu movecount 10.000000 -# Motor mgvu -mgvu sign 1.000000 -mgvu SoftZero 0.000000 -mgvu SoftLowerLim -5.500000 -mgvu SoftUpperLim 3.000000 -mgvu Fixed -1.000000 -mgvu InterruptMode 0.000000 -mgvu precision 0.010000 -mgvu ignorefault 0.000000 -mgvu AccessCode 2.000000 -mgvu failafter 3.000000 -mgvu maxretry 3.000000 -mgvu movecount 10.000000 -# Motor mgpu -mgpu sign 1.000000 -mgpu SoftZero 0.000000 -mgpu SoftLowerLim -3.000000 -mgpu SoftUpperLim 6.000000 -mgpu Fixed -1.000000 -mgpu InterruptMode 0.000000 -mgpu precision 0.010000 -mgpu ignorefault 0.000000 -mgpu AccessCode 2.000000 -mgpu failafter 3.000000 -mgpu maxretry 3.000000 -mgpu movecount 10.000000 -# Motor mcvu -mcvu sign 1.000000 -mcvu SoftZero 0.000000 -mcvu SoftLowerLim -0.100000 -mcvu SoftUpperLim 20.000000 -mcvu Fixed -1.000000 -mcvu InterruptMode 0.000000 -mcvu precision 0.010000 -mcvu ignorefault 0.000000 -mcvu AccessCode 2.000000 -mcvu failafter 3.000000 -mcvu maxretry 3.000000 -mcvu movecount 10.000000 -# Motor moml -moml sign 1.000000 -moml SoftZero 0.000000 -moml SoftLowerLim -160.000000 -moml SoftUpperLim 160.000000 -moml Fixed -1.000000 -moml InterruptMode 0.000000 -moml precision 0.010000 -moml ignorefault 0.000000 -moml AccessCode 2.000000 -moml failafter 3.000000 -moml maxretry 3.000000 -moml movecount 10.000000 -# Motor mtvl -mtvl sign 1.000000 -mtvl SoftZero 0.000000 -mtvl SoftLowerLim -9.500000 -mtvl SoftUpperLim 10.000000 -mtvl Fixed -1.000000 -mtvl InterruptMode 0.000000 -mtvl precision 0.010000 -mtvl ignorefault 0.000000 -mtvl AccessCode 2.000000 -mtvl failafter 3.000000 -mtvl maxretry 3.000000 -mtvl movecount 10.000000 -# Motor mtpl -mtpl sign 1.000000 -mtpl SoftZero 0.000000 -mtpl SoftLowerLim -10.000000 -mtpl SoftUpperLim 10.000000 -mtpl Fixed -1.000000 -mtpl InterruptMode 0.000000 -mtpl precision 0.010000 -mtpl ignorefault 0.000000 -mtpl AccessCode 2.000000 -mtpl failafter 3.000000 -mtpl maxretry 3.000000 -mtpl movecount 10.000000 -# Motor mgvl -mgvl sign 1.000000 -mgvl SoftZero 0.000000 -mgvl SoftLowerLim -6.000000 -mgvl SoftUpperLim 3.000000 -mgvl Fixed -1.000000 -mgvl InterruptMode 0.000000 -mgvl precision 0.010000 -mgvl ignorefault 0.000000 -mgvl AccessCode 2.000000 -mgvl failafter 3.000000 -mgvl maxretry 3.000000 -mgvl movecount 10.000000 -# Motor mgpl -mgpl sign 1.000000 -mgpl SoftZero 0.000000 -mgpl SoftLowerLim -3.000000 -mgpl SoftUpperLim 5.500000 -mgpl Fixed -1.000000 -mgpl InterruptMode 0.000000 -mgpl precision 0.010000 -mgpl ignorefault 0.000000 -mgpl AccessCode 2.000000 -mgpl failafter 3.000000 -mgpl maxretry 3.000000 -mgpl movecount 10.000000 -# Motor mcvl -mcvl sign 1.000000 -mcvl SoftZero 0.000000 -mcvl SoftLowerLim 0.000000 -mcvl SoftUpperLim 10.000000 -mcvl Fixed -1.000000 -mcvl InterruptMode 0.000000 -mcvl precision 0.010000 -mcvl ignorefault 0.000000 -mcvl AccessCode 2.000000 -mcvl failafter 3.000000 -mcvl maxretry 3.000000 -mcvl movecount 10.000000 -# Motor mexz -mexz sign 1.000000 -mexz SoftZero 0.000000 -mexz SoftLowerLim 0.000000 -mexz SoftUpperLim 564.000000 -mexz Fixed -1.000000 -mexz InterruptMode 0.000000 -mexz precision 0.010000 -mexz ignorefault 0.000000 -mexz AccessCode 2.000000 -mexz failafter 3.000000 -mexz maxretry 3.000000 -mexz movecount 10.000000 -# Motor som -som sign 1.000000 -som SoftZero 0.000000 -som SoftLowerLim -15.000000 -som SoftUpperLim 37.500000 -som Fixed -1.000000 -som InterruptMode 0.000000 -som precision 0.020000 -som ignorefault 0.000000 -som AccessCode 2.000000 -som failafter 6.000000 -som maxretry 10.000000 -som movecount 10.000000 -# Motor stt -stt sign 1.000000 -stt SoftZero 0.000000 -stt SoftLowerLim -20.000000 -stt SoftUpperLim 60.000000 -stt Fixed -1.000000 -stt InterruptMode 0.000000 -stt precision 0.040000 -stt ignorefault 0.000000 -stt AccessCode 2.000000 -stt failafter 3.000000 -stt maxretry 12.000000 -stt movecount 10.000000 -# Motor sch -sch sign 1.000000 -sch SoftZero -180.000000 -sch SoftLowerLim 260.000000 -sch SoftUpperLim 395.000000 -sch Fixed -1.000000 -sch InterruptMode 0.000000 -sch precision 0.040000 -sch ignorefault 0.000000 -sch AccessCode 2.000000 -sch failafter 3.000000 -sch maxretry 3.000000 -sch movecount 10.000000 -# Motor sph -sph sign -1.000000 -sph SoftZero 0.000000 -sph SoftLowerLim 0.000000 -sph SoftUpperLim 359.000000 -sph Fixed -1.000000 -sph InterruptMode 0.000000 -sph precision 0.050000 -sph ignorefault 0.000000 -sph AccessCode 2.000000 -sph failafter 3.000000 -sph maxretry 10.000000 -sph movecount 10.000000 -# Motor dg1 -dg1 sign 1.000000 -dg1 SoftZero 0.000000 -dg1 SoftLowerLim -11.000000 -dg1 SoftUpperLim 39.500000 -dg1 Fixed -1.000000 -dg1 InterruptMode 0.000000 -dg1 precision 0.010000 -dg1 ignorefault 0.000000 -dg1 AccessCode 2.000000 -dg1 failafter 3.000000 -dg1 maxretry 3.000000 -dg1 movecount 10.000000 -# Motor dg2 -dg2 sign 1.000000 -dg2 SoftZero 0.000000 -dg2 SoftLowerLim -10.500000 -dg2 SoftUpperLim 15.000000 -dg2 Fixed -1.000000 -dg2 InterruptMode 0.000000 -dg2 precision 0.010000 -dg2 ignorefault 0.000000 -dg2 AccessCode 2.000000 -dg2 failafter 3.000000 -dg2 maxretry 3.000000 -dg2 movecount 10.000000 -# Motor dg3 -dg3 sign 1.000000 -dg3 SoftZero 0.000000 -dg3 SoftLowerLim -11.000000 -dg3 SoftUpperLim 39.500000 -dg3 Fixed -1.000000 -dg3 InterruptMode 0.000000 -dg3 precision 0.010000 -dg3 ignorefault 0.000000 -dg3 AccessCode 2.000000 -dg3 failafter 3.000000 -dg3 maxretry 3.000000 -dg3 movecount 10.000000 -# Motor cex1 -cex1 sign 1.000000 -cex1 SoftZero 0.000000 -cex1 SoftLowerLim 0.000000 -cex1 SoftUpperLim 360.000000 -cex1 Fixed -1.000000 -cex1 InterruptMode 0.000000 -cex1 precision 0.100000 -cex1 ignorefault 0.000000 -cex1 AccessCode 2.000000 -cex1 failafter 5.000000 -cex1 maxretry 3.000000 -cex1 movecount 10.000000 -# Motor cex2 -cex2 sign 1.000000 -cex2 SoftZero 0.000000 -cex2 SoftLowerLim 80.000000 -cex2 SoftUpperLim 300.000000 -cex2 Fixed -1.000000 -cex2 InterruptMode 0.000000 -cex2 precision 0.100000 -cex2 ignorefault 0.000000 -cex2 AccessCode 2.000000 -cex2 failafter 5.000000 -cex2 maxretry 3.000000 -cex2 movecount 10.000000 -# Motor d1b -d1b sign 1.000000 -d1b SoftZero 0.000000 -d1b SoftLowerLim 0.000000 -d1b SoftUpperLim 23.200001 -d1b Fixed -1.000000 -d1b InterruptMode 0.000000 -d1b precision 0.010000 -d1b ignorefault 0.000000 -d1b AccessCode 2.000000 -d1b failafter 3.000000 -d1b maxretry 3.000000 -d1b movecount 10.000000 -# Motor d1t -d1t sign 1.000000 -d1t SoftZero 0.000000 -d1t SoftLowerLim 0.000000 -d1t SoftUpperLim 23.500000 -d1t Fixed -1.000000 -d1t InterruptMode 0.000000 -d1t precision 0.010000 -d1t ignorefault 0.000000 -d1t AccessCode 2.000000 -d1t failafter 3.000000 -d1t maxretry 3.000000 -d1t movecount 10.000000 -# Motor d1l -d1l sign 1.000000 -d1l SoftZero 0.000000 -d1l SoftLowerLim -0.500000 -d1l SoftUpperLim 11.300000 -d1l Fixed -1.000000 -d1l InterruptMode 0.000000 -d1l precision 0.010000 -d1l ignorefault 0.000000 -d1l AccessCode 2.000000 -d1l failafter 3.000000 -d1l maxretry 3.000000 -d1l movecount 10.000000 -# Motor d1r -d1r sign 1.000000 -d1r SoftZero 0.000000 -d1r SoftLowerLim -0.500000 -d1r SoftUpperLim 13.700000 -d1r Fixed -1.000000 -d1r InterruptMode 0.000000 -d1r precision 0.010000 -d1r ignorefault 0.000000 -d1r AccessCode 2.000000 -d1r failafter 3.000000 -d1r maxretry 3.000000 -d1r movecount 10.000000 -# Motor a1 -a1 sign 1.000000 -a1 SoftZero 0.000000 -a1 SoftLowerLim -160.000000 -a1 SoftUpperLim 500.000000 -a1 Fixed -1.000000 -a1 InterruptMode 0.000000 -a1 precision 0.010000 -a1 ignorefault 0.000000 -a1 AccessCode 2.000000 -a1 failafter 3.000000 -a1 maxretry 3.000000 -a1 movecount 10.000000 -# Motor a12 -a12 sign 1.000000 -a12 SoftZero 0.000000 -a12 SoftLowerLim -9.750000 -a12 SoftUpperLim 10.000000 -a12 Fixed -1.000000 -a12 InterruptMode 0.000000 -a12 precision 0.010000 -a12 ignorefault 0.000000 -a12 AccessCode 2.000000 -a12 failafter 3.000000 -a12 maxretry 3.000000 -a12 movecount 10.000000 -# Motor a13 -a13 sign 1.000000 -a13 SoftZero 0.000000 -a13 SoftLowerLim -10.000000 -a13 SoftUpperLim 9.500000 -a13 Fixed -1.000000 -a13 InterruptMode 0.000000 -a13 precision 0.010000 -a13 ignorefault 0.000000 -a13 AccessCode 2.000000 -a13 failafter 3.000000 -a13 maxretry 3.000000 -a13 movecount 10.000000 -# Motor a14 -a14 sign 1.000000 -a14 SoftZero 0.000000 -a14 SoftLowerLim -5.500000 -a14 SoftUpperLim 3.000000 -a14 Fixed -1.000000 -a14 InterruptMode 0.000000 -a14 precision 0.010000 -a14 ignorefault 0.000000 -a14 AccessCode 2.000000 -a14 failafter 3.000000 -a14 maxretry 3.000000 -a14 movecount 10.000000 -# Motor a15 -a15 sign 1.000000 -a15 SoftZero 0.000000 -a15 SoftLowerLim -3.000000 -a15 SoftUpperLim 6.000000 -a15 Fixed -1.000000 -a15 InterruptMode 0.000000 -a15 precision 0.010000 -a15 ignorefault 0.000000 -a15 AccessCode 2.000000 -a15 failafter 3.000000 -a15 maxretry 3.000000 -a15 movecount 10.000000 -# Motor a16 -a16 sign 1.000000 -a16 SoftZero 0.000000 -a16 SoftLowerLim -0.100000 -a16 SoftUpperLim 20.000000 -a16 Fixed -1.000000 -a16 InterruptMode 0.000000 -a16 precision 0.010000 -a16 ignorefault 0.000000 -a16 AccessCode 2.000000 -a16 failafter 3.000000 -a16 maxretry 3.000000 -a16 movecount 10.000000 -# Motor b1 -b1 sign 1.000000 -b1 SoftZero 0.000000 -b1 SoftLowerLim -160.000000 -b1 SoftUpperLim 160.000000 -b1 Fixed -1.000000 -b1 InterruptMode 0.000000 -b1 precision 0.010000 -b1 ignorefault 0.000000 -b1 AccessCode 2.000000 -b1 failafter 3.000000 -b1 maxretry 3.000000 -b1 movecount 10.000000 -# Motor a22 -a22 sign 1.000000 -a22 SoftZero 0.000000 -a22 SoftLowerLim -9.500000 -a22 SoftUpperLim 10.000000 -a22 Fixed -1.000000 -a22 InterruptMode 0.000000 -a22 precision 0.010000 -a22 ignorefault 0.000000 -a22 AccessCode 2.000000 -a22 failafter 3.000000 -a22 maxretry 3.000000 -a22 movecount 10.000000 -# Motor a23 -a23 sign 1.000000 -a23 SoftZero 0.000000 -a23 SoftLowerLim -10.000000 -a23 SoftUpperLim 10.000000 -a23 Fixed -1.000000 -a23 InterruptMode 0.000000 -a23 precision 0.010000 -a23 ignorefault 0.000000 -a23 AccessCode 2.000000 -a23 failafter 3.000000 -a23 maxretry 3.000000 -a23 movecount 10.000000 -# Motor a24 -a24 sign 1.000000 -a24 SoftZero 0.000000 -a24 SoftLowerLim -6.000000 -a24 SoftUpperLim 3.000000 -a24 Fixed -1.000000 -a24 InterruptMode 0.000000 -a24 precision 0.010000 -a24 ignorefault 0.000000 -a24 AccessCode 2.000000 -a24 failafter 3.000000 -a24 maxretry 3.000000 -a24 movecount 10.000000 -# Motor a25 -a25 sign 1.000000 -a25 SoftZero 0.000000 -a25 SoftLowerLim -3.000000 -a25 SoftUpperLim 5.500000 -a25 Fixed -1.000000 -a25 InterruptMode 0.000000 -a25 precision 0.010000 -a25 ignorefault 0.000000 -a25 AccessCode 2.000000 -a25 failafter 3.000000 -a25 maxretry 3.000000 -a25 movecount 10.000000 -# Motor a26 -a26 sign 1.000000 -a26 SoftZero 0.000000 -a26 SoftLowerLim 0.000000 -a26 SoftUpperLim 10.000000 -a26 Fixed -1.000000 -a26 InterruptMode 0.000000 -a26 precision 0.010000 -a26 ignorefault 0.000000 -a26 AccessCode 2.000000 -a26 failafter 3.000000 -a26 maxretry 3.000000 -a26 movecount 10.000000 -# Motor a37 -a37 sign 1.000000 -a37 SoftZero 0.000000 -a37 SoftLowerLim 0.000000 -a37 SoftUpperLim 564.000000 -a37 Fixed -1.000000 -a37 InterruptMode 0.000000 -a37 precision 0.010000 -a37 ignorefault 0.000000 -a37 AccessCode 2.000000 -a37 failafter 3.000000 -a37 maxretry 3.000000 -a37 movecount 10.000000 -# Motor a3 -a3 sign 1.000000 -a3 SoftZero 0.000000 -a3 SoftLowerLim -15.000000 -a3 SoftUpperLim 37.500000 -a3 Fixed -1.000000 -a3 InterruptMode 0.000000 -a3 precision 0.020000 -a3 ignorefault 0.000000 -a3 AccessCode 2.000000 -a3 failafter 6.000000 -a3 maxretry 10.000000 -a3 movecount 10.000000 -# Motor om -om sign 1.000000 -om SoftZero 0.000000 -om SoftLowerLim -15.000000 -om SoftUpperLim 37.500000 -om Fixed -1.000000 -om InterruptMode 0.000000 -om precision 0.020000 -om ignorefault 0.000000 -om AccessCode 2.000000 -om failafter 6.000000 -om maxretry 10.000000 -om movecount 10.000000 -# Motor a4 -a4 sign 1.000000 -a4 SoftZero 0.000000 -a4 SoftLowerLim -20.000000 -a4 SoftUpperLim 60.000000 -a4 Fixed -1.000000 -a4 InterruptMode 0.000000 -a4 precision 0.040000 -a4 ignorefault 0.000000 -a4 AccessCode 2.000000 -a4 failafter 3.000000 -a4 maxretry 12.000000 -a4 movecount 10.000000 -# Motor th -th sign 1.000000 -th SoftZero 0.000000 -th SoftLowerLim -20.000000 -th SoftUpperLim 60.000000 -th Fixed -1.000000 -th InterruptMode 0.000000 -th precision 0.040000 -th ignorefault 0.000000 -th AccessCode 2.000000 -th failafter 3.000000 -th maxretry 12.000000 -th movecount 10.000000 -# Motor a10 -a10 sign 1.000000 -a10 SoftZero -180.000000 -a10 SoftLowerLim 260.000000 -a10 SoftUpperLim 395.000000 -a10 Fixed -1.000000 -a10 InterruptMode 0.000000 -a10 precision 0.040000 -a10 ignorefault 0.000000 -a10 AccessCode 2.000000 -a10 failafter 3.000000 -a10 maxretry 3.000000 -a10 movecount 10.000000 -# Motor a20 -a20 sign -1.000000 -a20 SoftZero 0.000000 -a20 SoftLowerLim 0.000000 -a20 SoftUpperLim 359.000000 -a20 Fixed -1.000000 -a20 InterruptMode 0.000000 -a20 precision 0.050000 -a20 ignorefault 0.000000 -a20 AccessCode 2.000000 -a20 failafter 3.000000 -a20 maxretry 10.000000 -a20 movecount 10.000000 -# Motor ch -ch sign 1.000000 -ch SoftZero -180.000000 -ch SoftLowerLim 260.000000 -ch SoftUpperLim 395.000000 -ch Fixed -1.000000 -ch InterruptMode 0.000000 -ch precision 0.040000 -ch ignorefault 0.000000 -ch AccessCode 2.000000 -ch failafter 3.000000 -ch maxretry 3.000000 -ch movecount 10.000000 -# Motor chi -chi sign 1.000000 -chi SoftZero -180.000000 -chi SoftLowerLim 260.000000 -chi SoftUpperLim 395.000000 -chi Fixed -1.000000 -chi InterruptMode 0.000000 -chi precision 0.040000 -chi ignorefault 0.000000 -chi AccessCode 2.000000 -chi failafter 3.000000 -chi maxretry 3.000000 -chi movecount 10.000000 -# Motor ph -ph sign -1.000000 -ph SoftZero 0.000000 -ph SoftLowerLim 0.000000 -ph SoftUpperLim 359.000000 -ph Fixed -1.000000 -ph InterruptMode 0.000000 -ph precision 0.050000 -ph ignorefault 0.000000 -ph AccessCode 2.000000 -ph failafter 3.000000 -ph maxretry 10.000000 -ph movecount 10.000000 -# Motor a31 -a31 sign 1.000000 -a31 SoftZero 0.000000 -a31 SoftLowerLim -11.000000 -a31 SoftUpperLim 39.500000 -a31 Fixed -1.000000 -a31 InterruptMode 0.000000 -a31 precision 0.010000 -a31 ignorefault 0.000000 -a31 AccessCode 2.000000 -a31 failafter 3.000000 -a31 maxretry 3.000000 -a31 movecount 10.000000 -# Motor a32 -a32 sign 1.000000 -a32 SoftZero 0.000000 -a32 SoftLowerLim -10.500000 -a32 SoftUpperLim 15.000000 -a32 Fixed -1.000000 -a32 InterruptMode 0.000000 -a32 precision 0.010000 -a32 ignorefault 0.000000 -a32 AccessCode 2.000000 -a32 failafter 3.000000 -a32 maxretry 3.000000 -a32 movecount 10.000000 -# Motor a33 -a33 sign 1.000000 -a33 SoftZero 0.000000 -a33 SoftLowerLim -11.000000 -a33 SoftUpperLim 39.500000 -a33 Fixed -1.000000 -a33 InterruptMode 0.000000 -a33 precision 0.010000 -a33 ignorefault 0.000000 -a33 AccessCode 2.000000 -a33 failafter 3.000000 -a33 maxretry 3.000000 -a33 movecount 10.000000 -# Motor phi -phi sign -1.000000 -phi SoftZero 0.000000 -phi SoftLowerLim 0.000000 -phi SoftUpperLim 359.000000 -phi Fixed -1.000000 -phi InterruptMode 0.000000 -phi precision 0.050000 -phi ignorefault 0.000000 -phi AccessCode 2.000000 -phi failafter 3.000000 -phi maxretry 10.000000 -phi movecount 10.000000 -# Motor muca -muca sign 1.000000 -muca SoftZero 0.000000 -muca SoftLowerLim -160.000000 -muca SoftUpperLim 160.000000 -muca Fixed -1.000000 -muca InterruptMode 0.000000 -muca precision 0.010000 -muca ignorefault 0.000000 -muca AccessCode 2.000000 -muca failafter 3.000000 -muca maxretry 3.000000 -muca movecount 10.000000 -# Counter counter -counter SetPreset 30000.000000 -counter SetMode Monitor -hm2 CountMode monitor -hm2 preset 30000.000000 -adress UNKNOWN -adress setAccess 2 -email UNKNOWN -email setAccess 2 -sample_mur 0.000000 -sample_mur setAccess 2 -lambda 3.200000 -lambda setAccess 1 -#Crystallographic Settings -hkl lambda 3.200000 -hkl setub 0.051536 0.051536 0.034324 -0.024271 -0.024271 0.072883 0.569649 -0.056965 0.000000 -hkl hm 0 -hkl scantolerance 1.575000 -hkl nb 0 -ubcalc cell 3.463700 3.463700 18.772100 90.000000 90.000000 120.000000 -ubcalc ref1 1.000000 0.000000 0.000000 9.341000 0.000000 186.500000 22.300000 -ubcalc ref2 2.000000 0.000000 0.000000 26.300000 -108.300000 0.000000 0.000000 -ubcalc ref3 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 0.000000 -ubcalc difftheta 0.300000 -ubcalc maxindex 5 -ubcalc maxlist 10 -#Four Circle Dataset Module dataset -dataset countmode monitor -dataset np 55 -dataset preset 1000.000000 -dataset step 0.050000 -dataset weakthreshold 99999 -dataset compact 1 -dataset psd 0 -dataset weak 0 -dataset fastscan 1 -dataset table clear -dataset table add 120.000000 o2t 0.100000 35 40008.000000 -dataset table add 110.000000 o2t 0.085000 35 40007.000000 -dataset table add 100.000000 o2t 0.075000 35 40006.000000 -dataset table add 90.000000 o2t 0.065000 35 40005.000000 -dataset table add 80.000000 om 0.066000 55 40000.000000 -dataset table add 70.000000 om 0.060000 55 40000.000000 -dataset table add 50.000000 om 0.055000 55 40000.000000 -dataset table add 35.000000 om 0.050000 55 30000.000000 -dataset table add 5.000000 om 0.050000 55 20000.000000 -starttime 2007-11-19 08:54:30 -starttime setAccess 2 -monodescription Germanium-311 -monodescription setAccess 2 -mono2theta 40.200001 -mono2theta setAccess 2 -dist1 1.000000 -dist1 setAccess 2 -dist2 656.000000 -dist2 setAccess 2 -dist3 790.000000 -dist3 setAccess 2 -xscale1 0.740800 -xscale1 setAccess 2 -xscale2 0.740800 -xscale2 setAccess 2 -xscale3 -0.740800 -xscale3 setAccess 2 -zscale1 1.486400 -zscale1 setAccess 2 -zscale2 1.483800 -zscale2 setAccess 2 -zscale3 1.486400 -zscale3 setAccess 2 -xnull1 128.000000 -xnull1 setAccess 2 -xnull2 128.000000 -xnull2 setAccess 2 -xnull3 128.000000 -xnull3 setAccess 2 -znull1 128.000000 -znull1 setAccess 2 -znull2 64.000000 -znull2 setAccess 2 -znull3 128.000000 -znull3 setAccess 2 -sttoffset1 0.000000 -sttoffset1 setAccess 2 -sttoffset2 0.800000 -sttoffset2 setAccess 2 -sttoffset3 1.400000 -sttoffset3 setAccess 2 -diffscan monitor 4.000000 -diffscan skip 0.000000 -ps.phistart 0.000000 -ps.phistart setAccess 2 -ps.phiend 180.000000 -ps.phiend setAccess 2 -ps.phistep 3.000000 -ps.phistep setAccess 2 -ps.chistart 0.000000 -ps.chistart setAccess 2 -ps.chiend 180.000000 -ps.chiend setAccess 2 -ps.chistep 12.000000 -ps.chistep setAccess 2 -ps.omstart 0.000000 -ps.omstart setAccess 2 -ps.omend 30.000000 -ps.omend setAccess 2 -ps.omstep 3.000000 -ps.omstep setAccess 2 -ps.sttstart 5.000000 -ps.sttstart setAccess 2 -ps.sttend 70.000000 -ps.sttend setAccess 2 -ps.sttstep 3.000000 -ps.sttstep setAccess 2 -ps.threshold 30 -ps.threshold setAccess 2 -ps.steepness 3 -ps.steepness setAccess 2 -ps.window 7 -ps.window setAccess 2 -ps.cogwindow 60 -ps.cogwindow setAccess 2 -ps.cogcontour 0.200000 -ps.cogcontour setAccess 2 -ps.countmode monitor -ps.countmode setAccess 2 -ps.preset 1000.000000 -ps.preset setAccess 2 -ps.scanpreset 1000000.000000 -ps.scanpreset setAccess 2 -ps.scansteps 24 -ps.scansteps setAccess 2 -ps.listfile peaksearch.dat -ps.listfile setAccess 2 -xfactor 0.715000 -xfactor setAccess 1 -yfactor 1.420000 -yfactor setAccess 1 -instsms 5873 -instsms setAccess 2 -__autosms 1 -__autosms setAccess 2 -__smsidle 300 -__smsidle setAccess 2 -__smsalarm 1 -__smsalarm setAccess 2 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