PSI sics-cvs-psi-2008-10-02
This commit is contained in:
Douglas Clowes
513
test/testini.tcl
Normal file
513
test/testini.tcl
Normal file
@@ -0,0 +1,513 @@
|
||||
# --------------------------------------------------------------------------
|
||||
# Initialization script for testing SICS
|
||||
#
|
||||
# Started: Dr. Mark Koennecke, July 2006
|
||||
#---------------------------------------------------------------------------
|
||||
# O P T I O N S
|
||||
|
||||
# --------------- Initialize Tcl internals --------------------------------
|
||||
|
||||
# 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.
|
||||
|
||||
|
||||
#---------------------------------------------------------------------------
|
||||
# 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
|
||||
MakeMultiCounter scanCter aba
|
||||
|
||||
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
|
||||
|
||||
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
|
||||
#----------------------------------------------------------------------
|
||||
InstallHdb
|
||||
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
|
||||
|
||||
restore
|
||||
|
||||
#-------------------------------------------------
|
||||
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:7070
|
||||
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 busy
|
||||
}
|
||||
evalcheck {
|
||||
set tst [hval /sics/farm/schneggerunning]
|
||||
if {$tst == 1} {
|
||||
return busy
|
||||
} 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 1
|
||||
|
||||
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
|
||||
|
||||
|
||||
Reference in New Issue
Block a user