860 lines
23 KiB
Tcl
860 lines
23 KiB
Tcl
# --------------------------------------------------------------------------
|
|
# Initialization script for testing SICS
|
|
#
|
|
# Started: Dr. Mark Koennecke, July 2006
|
|
#---------------------------------------------------------------------------
|
|
set home $env(HOME)/src/workspace/sics/test
|
|
|
|
protocol set all
|
|
#----------------------------------------------------------------------------
|
|
# O P T I O N S
|
|
# --------------- ----------------------------------------------------------
|
|
|
|
# first all the server options are set
|
|
|
|
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 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 2913
|
|
# The UDP port where the server will wait for Interrupts from clients.
|
|
# Obviously, clients wishing to interrupt need to know this number.
|
|
|
|
ServerOption historylog $env(HOME)/src/workspace/sics/sim/tmp/comhistorytst.txt
|
|
|
|
#---------------------------------------------------------------------------
|
|
# U S E R S
|
|
|
|
# than the SICS users are specified
|
|
# Syntax: SicsUser name password userRightsCode
|
|
SicsUser Mugger Mugger 1
|
|
SicsUser User User 2
|
|
SicsUser Spy Spy 3
|
|
#SicsUser Spy 007 1
|
|
|
|
#----------------- SICS Variable
|
|
VarMake lotte Text User
|
|
|
|
#----------------- Motors ---------------------------------------------------
|
|
Motor brumm regress
|
|
MakeDrive
|
|
#----------------- Alias ----------------------------------------------------
|
|
SicsAlias brumm miau
|
|
#----------------- Counters -------------------------------------------------
|
|
MakeCounter aba regress
|
|
MakeCounter hugo SIM -1.
|
|
MakeCounter lieselotte SIM -1.
|
|
#------------------------------
|
|
proc SICSValue {command} {
|
|
set txt [eval $command]
|
|
set l [split $txt =]
|
|
return [string trim [lindex $l 1]]
|
|
}
|
|
#-----------------------------
|
|
proc multitransfer {} {
|
|
append res [SICSValue "aba gettime"] " "
|
|
for {set i 0} {$i < 7} {incr i} {
|
|
append res [SICSValue "aba getmonitor $i"] " "
|
|
}
|
|
return $res
|
|
}
|
|
#-----------------------------------
|
|
MakeMultiCounter multi aba hugo lieselotte
|
|
multi transferscript multitransfer
|
|
|
|
#------------- For Scanning ---------------------------------------------
|
|
# This is with the tricky bit set: we use a multicounter and use the
|
|
# scantransfer function to return values of a gaussian for a4 positions.
|
|
# This gives nice scan data which can be used to test all sorts of things.
|
|
#-------------------------------------------------------------------------
|
|
MakeDataNumber SicsDataNumber ./DataNumber
|
|
VarMake SicsDataPath Text Mugger
|
|
SicsDataPath ./
|
|
SicsDataPath lock
|
|
VarMake SicsDataPrefix Text Mugger
|
|
SicsDataPrefix regression
|
|
SicsDataPrefix lock
|
|
VarMake SicsDataPostFix Text Mugger
|
|
SicsDataPostFix .dat
|
|
SicsDataPostFix lock
|
|
|
|
Motor a1 SIM -2 180 -.1 10
|
|
Motor a2 SIM 30 150 -.1 10
|
|
Motor a3 SIM -360 360 -.1 10
|
|
Motor a4 SIM -180 180 -.1 10
|
|
Motor a5 SIM -180 180 -.1 10
|
|
Motor a6 SIM -180 180 -.1 10
|
|
Motor sgu SIM -20 20 -.1 10
|
|
Motor sgl SIM -20 20 -.1 10
|
|
Motor chi SIM 0 360 -.1 10
|
|
Motor phi SIM 0 360 -.1 10
|
|
|
|
MakeMultiCounter scanCter aba
|
|
SicsAlias scanCter counter
|
|
|
|
proc scantransfer {} {
|
|
set FWHM 1.5
|
|
set pos 5.33
|
|
set height 700
|
|
set stddev [expr $FWHM/2.354]
|
|
set ftmp [expr ([SICSValue a4] - $pos)/$stddev]
|
|
set count [expr 10 + $height*0.4*exp(-.5*$ftmp*$ftmp)]
|
|
set counti [expr int($count)]
|
|
append res [SICSValue "lieselotte gettime"] " "
|
|
append res $counti " "
|
|
for {set i 1} {$i < 7} {incr i} {
|
|
append res [SICSValue "lieselotte getmonitor $i"] " "
|
|
}
|
|
return $res
|
|
}
|
|
scancter transferscript scantransfer
|
|
|
|
rename scan stscan
|
|
MakeScanCommand xxxscan scancter test.hdd recover.bin
|
|
MakePeakCenter xxxscan
|
|
source scancommand.tcl
|
|
MakeOptimise opti scancter
|
|
MakeMaximize scancter
|
|
|
|
#-------------------------------------------------------------------------
|
|
# Histogram Memory
|
|
#------------------------------------------------------------------------
|
|
MakeHM hm regress
|
|
hm configure rank 1
|
|
hm configure dim0 23
|
|
hm configure testval 1
|
|
hm configure errortype 0
|
|
hm configure recover 1
|
|
hm configure init 1
|
|
hm init
|
|
|
|
MakeHM tof regress
|
|
tof configure rank 1
|
|
tof configure HistMode TOF
|
|
tof configure dim0 23
|
|
tof configure testval 1
|
|
tof configure errortype 0
|
|
tof configure recover 1
|
|
tof genbin 10 12 100
|
|
tof configure init 1
|
|
tof init
|
|
|
|
#-------------------------------------------------------------------------
|
|
# NXscript
|
|
#-------------------------------------------------------------------------
|
|
MakeNXScript
|
|
#-------------------------------------------------------------------------
|
|
proc makearray {} {
|
|
global ar
|
|
for { set i 10} {$i < 20} {incr i} {
|
|
set ar([expr $i - 10]) [expr $i*1.0]
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc makeintarray {} {
|
|
global ar
|
|
for { set i 10} {$i < 20} {incr i} {
|
|
set ar([expr $i - 10]) $i
|
|
}
|
|
}
|
|
Publish makearray User
|
|
Publish makeintarray User
|
|
Publish parray User
|
|
|
|
#------------------------------------------------------------------------
|
|
# SicsData
|
|
#------------------------------------------------------------------------
|
|
sicsdatafactory new data
|
|
sicsdatafactory new duta
|
|
#-----------------------------------------------------------------------
|
|
# tasub
|
|
#-----------------------------------------------------------------------
|
|
MakeTasUB tasub
|
|
#-----------------------------------------------------------------------
|
|
# MultiMotors
|
|
#----------------------------------------------------------------------
|
|
MakeMulti sa
|
|
sa alias a3 om
|
|
sa alias a4 stt
|
|
sa pos noeff a3 24 a4 48
|
|
sa endconfig
|
|
|
|
#-----------------------------------------------------------------------
|
|
# Hipadaba
|
|
#----------------------------------------------------------------------
|
|
proc SplitReply { text } {
|
|
set l [split $text =]
|
|
return [string trim [lindex $l 1]]
|
|
}
|
|
#---------------------------------------------------------------------
|
|
source ../tcl/hdbutil.tcl
|
|
hmake /instrument spy none
|
|
hmake /instrument/sample spy none
|
|
hattach /instrument/sample a3 omega
|
|
hattach /instrument/sample qh qh
|
|
hmake /instrument/detector spy none
|
|
hattach /instrument/detector hm data
|
|
hattach /instrument lotte title
|
|
|
|
hfactory /target plain spy none
|
|
hfactory /target/ta3 plain internal float
|
|
hattach target a3 /target/ta3
|
|
|
|
proc upsctest {} {
|
|
broadcast "An update script has been called"
|
|
set txt [hval /instrument/title]
|
|
broadcast "Update to $txt"
|
|
}
|
|
|
|
restore
|
|
|
|
#==================================================
|
|
# ScriptContext testing
|
|
#==================================================
|
|
proc sendtest {} {
|
|
set test [catch {sct target} msg]
|
|
if {$test == 0} {
|
|
set data $msg
|
|
} else {
|
|
set data TestDuta
|
|
}
|
|
sct send $data
|
|
return testreply
|
|
}
|
|
#-------------------------------------------------
|
|
proc readtest {} {
|
|
set t [doubletime]
|
|
sct send "Read:$t"
|
|
return testreply
|
|
}
|
|
#-------------------------------------------------
|
|
proc testreply {} {
|
|
sct print [sct result]
|
|
sct update [sct result]
|
|
return idle
|
|
}
|
|
makesctcontroller testsct testprot
|
|
MakeSICSObj testnode Test spy text
|
|
hsetprop /sics/testnode read readtest
|
|
hsetprop /sics/testnode write sendtest
|
|
hsetprop /sics/testnode testreply testreply
|
|
|
|
proc testprio {} {
|
|
testsct queue /sics/testnode read read
|
|
testsct queue /sics/testnode read read
|
|
testsct queue /sics/testnode read read
|
|
testsct queue /sics/testnode halt write
|
|
testsct queue /sics/testnode read read
|
|
testsct queue /sics/testnode read read
|
|
return [testnode]
|
|
}
|
|
Publish testprio Spy
|
|
|
|
#-------------------------------------------------
|
|
proc farmFormat {par num} {
|
|
hsetprop /sics/farm/$par lastError none
|
|
return [format "$par %d" [string trim $num]]
|
|
}
|
|
#-----------------------------------------------
|
|
proc farmRead {par } {
|
|
hsetprop /sics/farm/$par lastError none
|
|
hsetprop /sics/farm/$par replyCommand "farmReply $par"
|
|
return $par
|
|
}
|
|
#-----------------------------------------------
|
|
proc farmReply {par reply} {
|
|
set action [string trim [hgetpropval /sics/farm/$par status]]
|
|
hsetprop /sics/farm/$par status idle
|
|
if {[string first OK $reply] >= 0} {
|
|
if {[string first get $action] >= 0} {
|
|
set idx [string first : $reply]
|
|
if {$idx > 0} {
|
|
set val [string trim [string range $reply [expr $idx +1] end]]
|
|
hupdate /sics/farm/$par $val
|
|
}
|
|
} else {
|
|
hget /sics/farm/$par
|
|
}
|
|
} else {
|
|
if {[string first ERROR $reply] < 0} {
|
|
set reply "ERROR: $reply"
|
|
}
|
|
clientPut $reply
|
|
error $reply
|
|
}
|
|
}
|
|
#=============================================
|
|
proc schconset {val} {
|
|
set com [farmFormat schnegge $val]
|
|
hsetprop /sics/farm/schneggecon replyCommand schreply
|
|
return $com
|
|
}
|
|
#----------------------------------------------
|
|
proc schreply {reply} {
|
|
clientput "schreply $reply"
|
|
if {[string first OK $reply] >= 0} {
|
|
hsetprop /sics/farm/schneggerunning readCommand schrunget
|
|
hget /sics/farm/schneggerunning
|
|
hsetprop /sics/farm/schneggerunning readCommand \
|
|
"farmReply schneggerunning"
|
|
} else {
|
|
hsetprop /sics/farm/schneggecon status idle
|
|
hsetprop /sics/farm/schneggecon lastError $reply
|
|
clientput "ERROR: $reply on schnegge"
|
|
}
|
|
}
|
|
#-----------------------------------------------
|
|
proc schrun {reply} {
|
|
clientput "schrun $reply"
|
|
hsetprop /sics/farm/schneggerunning status idle
|
|
if {[string first OK $reply] >= 0} {
|
|
set idx [string first : $reply]
|
|
if {$idx > 0} {
|
|
set val [string trim [string range $reply [expr $idx +1] end]]
|
|
hupdate /sics/farm/schneggerunning $val
|
|
if {$val == 1} {
|
|
clientput "schnegge creeping"
|
|
hsetprop /sics/farm/schneggerunning readCommand schrunget
|
|
hget /sics/farm/schneggerunning
|
|
hsetprop /sics/farm/schneggerunning readCommand \
|
|
"farmReply schneggerunning"
|
|
} else {
|
|
clientput "schnegge finished"
|
|
hsetprop /sics/farm/schneggerunning readCommand \
|
|
"farmRead schneggerunning"
|
|
hsetprop /sics/farm/schneggecon status idle
|
|
}
|
|
}
|
|
} else {
|
|
clientput "schnegge has error: $reply"
|
|
hsetprop /sics/farm/schneggerunning readCommand \
|
|
"farmRead schneggerunning"
|
|
hsetprop /sics/farm/schneggecon status idle
|
|
hsetprop /sics/farm/schneggecon lastError $reply
|
|
hsetprop /sics/farm/schneggerunning lastError $reply
|
|
}
|
|
}
|
|
#----------------------------------------------
|
|
proc schget {} {
|
|
hsetprop /sics/farm/schneggecon lastError none
|
|
hsetprop /sics/farm/schneggecon replyCommand "farmReply schneggecon"
|
|
return schnegge
|
|
}
|
|
#----------------------------------------------
|
|
proc schrunget {} {
|
|
hsetprop /sics/farm/schneggerunning lastError none
|
|
hsetprop /sics/farm/schneggerunning replyCommand schrun
|
|
return schneggerunning
|
|
}
|
|
#-----------------------------------------------
|
|
set farm 0
|
|
if {$farm == 1} {
|
|
# Generic Controller
|
|
#-------------------------------------------------------------------
|
|
MakeAsyncProtocol norma
|
|
MakeAsyncQueue farmQueue norma localhost 9090
|
|
MakeGenController farm
|
|
genconfigure asynconnect farm farmQueue
|
|
#------------------------------------------------
|
|
genconfigure makepar farm hase int
|
|
hsetprop /sics/farm/hase priv user
|
|
hsetprop /sics/farm/hase writeCommand "farmFormat hase"
|
|
hsetprop /sics/farm/hase readCommand "farmRead hase"
|
|
hsetprop /sics/farm/hase replyCommand "farmReply hase"
|
|
|
|
genconfigure makepar farm schnegge int
|
|
hsetprop /sics/farm/schnegge priv user
|
|
hsetprop /sics/farm/schnegge writeCommand "farmFormat schnegge"
|
|
hsetprop /sics/farm/schnegge readCommand "farmRead schnegge"
|
|
hsetprop /sics/farm/schnegge replyCommand "farmReply schnegge"
|
|
|
|
genconfigure makepar farm schneggerunning int
|
|
hsetprop /sics/farm/schneggerunning priv internal
|
|
hsetprop /sics/farm/schneggerunning readCommand "farmRead schneggerunning"
|
|
hsetprop /sics/farm/schneggerunning replyCommand "farmReply schneggerunning"
|
|
|
|
genconfigure makepar farm schneggecon int
|
|
hsetprop /sics/farm/schneggecon priv user
|
|
hsetprop /sics/farm/schneggecon writeCommand schconset
|
|
hsetprop /sics/farm/schneggecon readCommand schget
|
|
hsetprop /sics/farm/schneggecon replyCommand schreply
|
|
}
|
|
|
|
set farm 0
|
|
|
|
if {$farm == 1} {
|
|
#-------------- Test new async protocol controller
|
|
makesctcontroller farmser std localhost:8080
|
|
makesctcomtask farmcom farmser
|
|
MakeSICSObj farm TestObj
|
|
#---------------------------
|
|
proc farmparcom {par} {
|
|
sct send $par
|
|
return parread
|
|
}
|
|
#------------------------
|
|
proc farmparread {} {
|
|
set rply [sct result]
|
|
if {[string first ERR $rply] >= 0} {
|
|
sct geterror $rply
|
|
return idle
|
|
}
|
|
set data [string range $rply 3 end]
|
|
set node [sct]
|
|
sct update $data
|
|
return idle
|
|
}
|
|
#--------------------------
|
|
proc farmcheck {} {
|
|
set val [sct target]
|
|
if {$val < -100 || $val > 100} {
|
|
error "Value out of range"
|
|
}
|
|
return OK
|
|
}
|
|
#---------------------------
|
|
proc farmset {par} {
|
|
set val [sct target]
|
|
sct send "$par $val"
|
|
return setreply
|
|
}
|
|
#-------------------------
|
|
proc farmsetreply {} {
|
|
set rply [sct result]
|
|
if {[string first ERR $rply] >= 0} {
|
|
sct print $rply
|
|
}
|
|
return idle
|
|
}
|
|
#--------------------------
|
|
hfactory /sics/farm/hase plain spy int
|
|
hsetprop /sics/farm/hase read farmparcom hase
|
|
hsetprop /sics/farm/hase parread farmparread
|
|
|
|
hsetprop /sics/farm/hase check farmcheck
|
|
hsetprop /sics/farm/hase write farmset hase
|
|
hsetprop /sics/farm/hase setreply farmsetreply
|
|
|
|
farmser poll /sics/farm/hase
|
|
farmser write /sics/farm/hase
|
|
|
|
hfactory /sics/farm/hugo plain spy int
|
|
hsetprop /sics/farm/hugo read farmparcom hugo
|
|
hsetprop /sics/farm/hugo parread farmparread
|
|
|
|
hsetprop /sics/farm/hugo check farmcheck
|
|
hsetprop /sics/farm/hugo write farmset hugo
|
|
hsetprop /sics/farm/hugo setreply farmsetreply
|
|
|
|
farmser poll /sics/farm/hugo
|
|
farmser write /sics/farm/hugo
|
|
|
|
hfactory /sics/farm/schnegge plain spy float
|
|
hsetprop /sics/farm/schnegge read farmparcom schnegge
|
|
hsetprop /sics/farm/schnegge parread farmparread
|
|
|
|
hsetprop /sics/farm/schnegge check farmcheck
|
|
hsetprop /sics/farm/schnegge write farmset schnegge
|
|
hsetprop /sics/farm/schnegge setreply farmsetreply
|
|
|
|
farmser poll /sics/farm/schnegge
|
|
farmser write /sics/farm/schnegge
|
|
|
|
hfactory /sics/farm/schneggerunning plain spy int
|
|
hsetprop /sics/farm/schneggerunning read farmparcom schneggerunning
|
|
hsetprop /sics/farm/schneggerunning parread farmparread
|
|
farmser poll /sics/farm/schneggerunning
|
|
|
|
hfactory /sics/farm/stone plain spy int
|
|
hsetprop /sics/farm/stone read farmparcom stone
|
|
hsetprop /sics/farm/stone parread farmparread
|
|
#farmser poll /sics/farm/stone
|
|
|
|
farmser debug -1
|
|
|
|
#----------------- drivable scriptcontext adapter
|
|
proc schneggechecklimits {} {
|
|
return [farmcheck]
|
|
}
|
|
#-----------------------------
|
|
proc schneggestatus {} {
|
|
farmser queue /sics/farm/schneggerunning progress read
|
|
set status [sct writestatus]
|
|
switch $status {
|
|
commandsent {
|
|
set runtime [SICSValue "hgetprop /sics/farm/schneggerunning read_time"]
|
|
set starttime [sct write_time]
|
|
if {$runtime > $starttime} {
|
|
sct writestatus evalcheck
|
|
}
|
|
return run
|
|
}
|
|
evalcheck {
|
|
set tst [hval /sics/farm/schneggerunning]
|
|
if {$tst == 1} {
|
|
return run
|
|
} else {
|
|
return idle
|
|
}
|
|
}
|
|
default {
|
|
error "schneggestatus called in bad state $status"
|
|
}
|
|
}
|
|
}
|
|
#---------------------------------------------
|
|
hsetprop /sics/farm/schnegge checklimits schneggechecklimits
|
|
hsetprop /sics/farm/schnegge checkstatus schneggestatus
|
|
#makesctdrive schnecke /sics/farm/schnegge farmser
|
|
makesctdriveobj schnecke /sics/farm/schnegge DriveAdapter farmser
|
|
|
|
}
|
|
|
|
#---------- test http
|
|
set httptest 0
|
|
|
|
if {$httptest == 1} {
|
|
makesctcontroller amorhmsct sinqhttp amorhm data 180 spy 007
|
|
#makesctcontroller amorhmsct sinqhttp localhost:8080 data 60 spy 007
|
|
MakeSICSObj amorhm HttpTest
|
|
amorhmsct debug -1
|
|
#------------------
|
|
proc statget {} {
|
|
sct send "admin/textstatus.egi"
|
|
return statrepl
|
|
}
|
|
#-----------------
|
|
proc statreply {} {
|
|
sct update [sct result]
|
|
sct utime readtime
|
|
return idle
|
|
}
|
|
#-----------------
|
|
proc readcollapse {} {
|
|
sct send "admin/processhmdata.egi?bank=0&command=sum:2:0:400"
|
|
return colread
|
|
}
|
|
#-----------------
|
|
proc colreply {} {
|
|
sct utime readtime
|
|
set data [sct result]
|
|
return idle
|
|
}
|
|
#-------------------------
|
|
hfactory /sics/amorhm/status plain spy text
|
|
hsetprop /sics/amorhm/status read statget
|
|
hsetprop /sics/amorhm/status statrepl statreply
|
|
amorhmsct poll /sics/amorhm/status 10
|
|
|
|
hattach /sics/amorhm data intvarar collapse
|
|
hsetprop /sics/amorhm/collapse read readcollapse
|
|
hsetprop /sics/amorhm/collapse colread colreply
|
|
amorhmsct poll /sics/amorhm/collapse 20
|
|
|
|
}
|
|
|
|
#source sansdruck.tcl
|
|
|
|
|
|
#MakeRS232Controller sadu pc4639 4168
|
|
#MakeRS232Controller sadu localhost 4168
|
|
#sadu replyterminator 0x04
|
|
#sadu sendterminator 0x04
|
|
#sadu timeout 1000
|
|
|
|
#source ../sim/mars/julcho.tcl
|
|
|
|
#MakeSinqRedirect lnsl15 10500
|
|
|
|
MakeSingleX
|
|
singlex configure stt a4
|
|
singlex configure om a3
|
|
singlex configure chi chi
|
|
singlex configure phi phi
|
|
singlex configure lambda gfrth66jjjhh
|
|
singlex configure nu chi
|
|
singlex configure sgu chi
|
|
singlex configure sgl phi
|
|
singlex mode bi
|
|
|
|
set secMotortest 0
|
|
|
|
if {$secMotortest == 1} {
|
|
|
|
proc hdbReadOnly {} {
|
|
error "Parameter is READ ONLY"
|
|
}
|
|
|
|
source ../tcl/secsim.tcl
|
|
MakeSecSim mig3 -20 20 5
|
|
|
|
makesctcontroller pmac01 pmac ldm-elec-dev:1025 5
|
|
pmac01 debug 0
|
|
source ../tcl/deltatau.tcl
|
|
MakeDeltaTau mig15 pmac01 02
|
|
}
|
|
|
|
set astrium 0
|
|
if {$astrium == 1} {
|
|
source ../tcl/astrium.tcl
|
|
}
|
|
|
|
set el737sec 0
|
|
|
|
|
|
if {$el737sec == 1} {
|
|
source ../tcl/el737sec.tcl
|
|
MakeSecEL737 elli psts235:3008
|
|
}
|
|
|
|
#-------------------------------------------------
|
|
proc loadsinqhm {file} {
|
|
set f [open $file r]
|
|
while {[gets $f line] >= 0} {
|
|
append conf $line
|
|
}
|
|
close $f
|
|
return $conf
|
|
}
|
|
#-------------------------------------------------
|
|
proc appleinit {} {
|
|
return [loadsinqhm sans.xml]
|
|
}
|
|
#---------------------------------------------------------------------
|
|
proc formattof {l} {
|
|
set count 0
|
|
set delay [expr int([lindex $l 0])]
|
|
foreach e $l {
|
|
append txt [format " %12d" [expr int($e) - $delay]]
|
|
incr count
|
|
if {$count >= 5} {
|
|
append txt "\n"
|
|
set count 0
|
|
}
|
|
}
|
|
set len [llength $l]
|
|
set bin [lindex $l [expr $len - 1]]
|
|
set diff [expr [lindex $l 1] - [lindex $l 0]]
|
|
set bin [expr $bin + int($diff)]
|
|
append txt [format " %12d" [expr int($bin) - $delay]]
|
|
append txt "\n"
|
|
return [string trimright $txt]
|
|
}
|
|
#------------------------------------------------------------------
|
|
proc tofappleinit {} {
|
|
set dim [string trim [hval /sics/apple/dim]]
|
|
set dimlist [split $dim]
|
|
set ntime [lindex $dimlist 1]
|
|
append conf "<?xml version=\"1.0\" encoding=\"UTF-8\"?>\n"
|
|
append conf "<sinqhm filler=\"tof\" hdr_daq_mask=\"0x20000000\" "
|
|
append conf "hdr_daq_active=\"0x00000000\">\n"
|
|
append conf "<bank rank=\"2\">\n"
|
|
append conf " <axis length=\"16387\" mapping=\"direct\"/>\n "
|
|
append conf " <axis length=\"$ntime\" mapping=\"boundary\" array=\"tof\"/>\n"
|
|
append conf "</bank>\n"
|
|
set bins [string trim [hval /sics/apple/time_binning]]
|
|
set binl [split $bins]
|
|
set delay [expr int([lindex $binl 0])% 200000]
|
|
# mdif write [format "DT %d" $delay]
|
|
foreach b $binl {
|
|
if { [string length [string trim $b]] > 1} {
|
|
lappend binlist [string trim $b]
|
|
}
|
|
}
|
|
set tlen [expr $ntime + 1]
|
|
append conf "<tof rank=\"1\" dim=\"$tlen\">\n"
|
|
append conf [formattof $binlist] "\n"
|
|
append conf "</tof>\n"
|
|
append conf "</sinqhm>\n"
|
|
return $conf
|
|
}
|
|
#-------------------------------------------------
|
|
set hmhttp 0
|
|
if {$hmhttp == 1} {
|
|
source ../tcl/sinqhttp.tcl
|
|
# MakeHTTPHM apple 1 hm01 appleinit
|
|
# MakeHTTPHM apple 1 localhost:8080 appleinit
|
|
# apple dim 16384
|
|
#---------- for TOF
|
|
MakeHTTPHM apple 2 hm01 tofappleinit tof
|
|
apple dim 16384 10
|
|
apple genbin 10 20 100
|
|
applesct debug 0
|
|
apple init
|
|
}
|
|
|
|
set simhm 1
|
|
#if {$simhm == 1} {
|
|
source ../tcl/simhm.tcl
|
|
simhm::MakeSimHM simi 3 tof
|
|
# simhm::makeSecond simi singledet 30
|
|
simi dim 64 64 5
|
|
lappend tlist 10 20 30 40 50
|
|
simi time_binning $tlist
|
|
simi init
|
|
#}
|
|
|
|
set phytron 0
|
|
if {$phytron == 1} {
|
|
#makesctcontroller phyto phytron psts234:3002 5
|
|
makesctcontroller phyto phytron morpheus-ts:3013
|
|
#makesctcontroller phyto phytron localhost:8080 5
|
|
phyto debug 0
|
|
|
|
source ../tcl/phytron.tcl
|
|
|
|
phytron::make alge X phyto -360 0
|
|
}
|
|
|
|
#MakeLMD200 lmd400 lnsts11 3012
|
|
|
|
|
|
|
|
set stddrive 0
|
|
if {$stddrive == 1} {
|
|
makesctcontroller stdsct std localhost:8080 "\r" 10
|
|
source ../tcl/stddrive.tcl
|
|
stddrive::makestddrive eule EuleDrive stdsct
|
|
}
|
|
|
|
set el755 0
|
|
|
|
if {$el755 == 1} {
|
|
source ../tcl/stddrive.tcl
|
|
source ../tcl/el755.tcl
|
|
makesctcontroller el755sct std localhost:8080 "\r" 10
|
|
#el755sct debug 1
|
|
for {set i 0} {$i < 3} {incr i} {
|
|
el755sct transact "RMT 1"
|
|
el755sct transact "ECHO 2"
|
|
}
|
|
el755::makeel755 mf 5 el755sct
|
|
el755sct queue /sics/mf progress read
|
|
mf upperlimit 10
|
|
mf lowerlimit -10
|
|
mf tolerance .1
|
|
}
|
|
|
|
set dc-804 0
|
|
if {${dc-804} == 1} {
|
|
source ../tcl/pimotor.tcl
|
|
makesctcontroller dc804sct std localhost:8080 "\r" 10 "\x03" "\x03"
|
|
pimotor::makepimotor dc1 1 dc804sct -10000 10000
|
|
}
|
|
|
|
proc testprot {input} {
|
|
return "${input}_hugo_appended_by_Tcl"
|
|
}
|
|
|
|
proc testerr {input} {
|
|
error "$input is SO abyssimally wrong!"
|
|
}
|
|
|
|
|
|
set slsecho 0
|
|
|
|
if {$slsecho == 1} {
|
|
|
|
source ../tcl/stddrive.tcl
|
|
source ../tcl/slsecho.tcl
|
|
makesctcontroller slssct slsecho taspmagnet:5001
|
|
#makesctcontroller slssct slsecho localhost:8080
|
|
slsecho::makeslsecho ma1 5 slssct
|
|
#slsecho::makeslsecho ma3 2 slssct
|
|
}
|
|
|
|
|
|
set nhq202m 0
|
|
|
|
if {$nhq202m == 1} {
|
|
source ../tcl/stddrive.tcl
|
|
source ../tcl/nhq202m.tcl
|
|
#makesctcontroller nhq202 charbychar localhost:8005 "\r\n"
|
|
#makesctcontroller nhq202 charbychar localhost:8080 "\r\n"
|
|
makesctcontroller nhq202 charbychar psts225:3002 "\r\n"
|
|
#------- Put him into lovely mode, it needs a few commands before it gets there
|
|
nhq202 transact \#
|
|
nhq202 transact \#
|
|
nhq202 transact \#
|
|
nhq202 debug 0
|
|
nhq202m::makehv hv1 nhq202 1
|
|
}
|
|
|
|
set poldizug 0
|
|
|
|
if {$poldizug == 1} {
|
|
makesctcontroller zugsct std pc6651:4167 "\r\n" 3.0 "\r\n"
|
|
zugsct debug 0
|
|
source ../tcl/stddrive.tcl
|
|
source ../sim/poldi_sics/zug.tcl
|
|
}
|
|
|
|
#MakeSPSS7 s7 203 251 129.129.195.55:2005
|
|
#MakeSPSS7 s7 203 251 localhost:8090
|
|
|
|
set jvl 0
|
|
|
|
if {$jvl == 1} {
|
|
source ../sim/boa_sics/jvl.tcl
|
|
makesctcontroller jvlsct jvl localhost:8080
|
|
jvlsct debug -1
|
|
jvl::make ja 2 jvlsct -10000 10000 120
|
|
}
|
|
|
|
set nanotec 0
|
|
|
|
if {$nanotec == 1} {
|
|
source ../sim/boa_sics/nanotec.tcl
|
|
makesctcontroller nanosct std localhost:8080 \r 1 \r
|
|
nanosct debug -1
|
|
nanotec::make nano 1 nanosct -100000 100000 120
|
|
}
|
|
|
|
set agilent 0
|
|
|
|
if {$agilent == 1} {
|
|
source ../tcl/stddrive.tcl
|
|
source ../tmp/agilent.tcl
|
|
makesctcontroller agi std 129.129.195.78:5025 \n 2 \n \n
|
|
agilent::make agi
|
|
}
|
|
|
|
set secmot 1
|
|
|
|
if {$secmot == 1} {
|
|
source ../sim/sicscommon/secsim.tcl
|
|
MakeSecSim eva -40 40 .3
|
|
}
|
|
|
|
|
|
set zwickroll 0
|
|
|
|
if {$zwickroll == 1} {
|
|
source ../tcl/zwickroll.tcl
|
|
# makesctcontroller zwro std pc8977:50370 \r\n 5 \r\n
|
|
makesctcontroller zwro std localhost:8080 \r\n 5 \n
|
|
zwickroll::makezwickroll zwro
|
|
}
|
|
|
|
set sputter 0
|
|
|
|
if {$sputter == 1} {
|
|
source ../sim/sicscommon/stddrive.tcl
|
|
source ../sim/amor_sics/sputter.tcl
|
|
SputterInit
|
|
}
|
|
|