- Implemented Hipadaba
This commit is contained in:
koennecke
690
tcl/hdbutil.tcl
Normal file
690
tcl/hdbutil.tcl
Normal file
@ -0,0 +1,690 @@
|
||||
#-----------------------------------------------------------------------
|
||||
# This is a collection of utility procedures to help with Hipadaba and
|
||||
# Gumtree Swiss Edition. This file is supposed to be sourced by any
|
||||
# instrument using Hipadaba.
|
||||
#
|
||||
# Copyright: see file COPYRIGHT
|
||||
#
|
||||
# Collected from various files: Mark Koennecke, March 2008
|
||||
#
|
||||
# Requirements:
|
||||
# * the internal scan command xxxscan
|
||||
# * scan data to live /graphics/scan_data
|
||||
#----------------------------------------------------------------------
|
||||
if { [info exists hdbinit] == 0 } {
|
||||
set hdbinit 1
|
||||
InstallHdb
|
||||
MakeStateMon
|
||||
Publish getgumtreexml Spy
|
||||
if {[string first tmp $home] < 0} {
|
||||
set tmppath $home/tmp
|
||||
} else {
|
||||
set tmppath $home
|
||||
}
|
||||
Publish mgbatch Spy
|
||||
Publish loadmgbatch Spy
|
||||
Publish hsearchprop Spy
|
||||
Publish hdbscan User
|
||||
Publish hdbprepare User
|
||||
Publish hdbcollect User
|
||||
Publish listbatchfiles Spy
|
||||
Publish makemumopos User
|
||||
Publish dropmumo User
|
||||
Publish hdbbatchpath User
|
||||
# Publish hmake Mugger
|
||||
# Publish hmakescript Mugger
|
||||
# Publish hlink Mugger
|
||||
# Publish hcommand Mugger
|
||||
}
|
||||
#===================================================================
|
||||
# Configuration commands provided:
|
||||
# hdbReadOnly
|
||||
# makesampleenv path
|
||||
# makestdscan path
|
||||
# makestdscangraphics path
|
||||
# makestdbatch
|
||||
# makeQuickPar name path
|
||||
# makeslit path left right upper lower
|
||||
# configures a slit. Missing motors can be indicated with NONE
|
||||
# makestdadmin
|
||||
# makecount path
|
||||
# makerepeat path
|
||||
# makekillfile path
|
||||
# makesuccess path
|
||||
# makestdgui
|
||||
# makewait path
|
||||
# makeevproxy rootpath hdbname devicename
|
||||
# makemumo rootpath mumoname
|
||||
# makeexe
|
||||
#===================== hfactory adapters ==========================
|
||||
proc hmake {path priv type {len 1}} {
|
||||
hfactory $path plain $priv $type $len
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc hmakescript {path readscript writescript type {len 1}} {
|
||||
hfactory $path script $readscript $writescript $type $len
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc hlink {path obj {treename NONE} } {
|
||||
if {[string equal $treename NONE]} {
|
||||
set treename $ob
|
||||
}
|
||||
append realpath $path / $treename
|
||||
hfactory $realpath link $obj
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc hcommand {path script} {
|
||||
hfactory $path command $script
|
||||
}
|
||||
#================ make XML tree =====================================
|
||||
proc getdataType {path} {
|
||||
return [lindex [split [hinfo $path] ,] 0]
|
||||
}
|
||||
#----------------------------------------------------------------------
|
||||
proc make_nodes {path result indent} {
|
||||
set nodename [file tail $path];
|
||||
set type [getdataType $path]
|
||||
set prefix [string repeat " " $indent]
|
||||
set newIndent [expr $indent + 2]
|
||||
#array set prop_list [ string trim [join [split [hlistprop $path] =]] ]
|
||||
set prop_list(control) true
|
||||
set we_have_control [info exists prop_list(control)]
|
||||
if {$we_have_control == 0 || $we_have_control && $prop_list(control) == "true"} {
|
||||
append result "$prefix<component id=\"$nodename\" dataType=\"$type\">\n"
|
||||
foreach p [property_elements $path $newIndent] {
|
||||
append result $p
|
||||
}
|
||||
foreach x [hlist $path] {
|
||||
set result [make_nodes [string map {// /} "$path/$x"] $result $newIndent]
|
||||
}
|
||||
append result "$prefix</component>\n"
|
||||
}
|
||||
return $result
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc property_elements_old {path indent} {
|
||||
set prefix [string repeat " " $indent]
|
||||
foreach {key value} [string map {= " "} [hlistprop $path]] {
|
||||
if {[string compare -nocase $key "control"] == 0} {continue}
|
||||
lappend proplist "$prefix<property id=\"$key\">\n"
|
||||
# foreach v [split $value ,] {
|
||||
# lappend proplist "$prefix$prefix<value>$v</value>\n"
|
||||
# }
|
||||
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
||||
lappend proplist "$prefix</property>\n"
|
||||
}
|
||||
if [info exists proplist] {return $proplist}
|
||||
}
|
||||
#-----------------------------------------------------------------------
|
||||
proc property_elements {path indent} {
|
||||
set prefix [string repeat " " $indent]
|
||||
set data [hlistprop $path]
|
||||
set propList [split $data \n]
|
||||
foreach prop $propList {
|
||||
set pl [split $prop =]
|
||||
set key [string trim [lindex $pl 0]]
|
||||
set value [string trim [lindex $pl 1]]
|
||||
if {[string length $key] < 1} {
|
||||
continue
|
||||
}
|
||||
lappend proplist "$prefix<property id=\"$key\">\n"
|
||||
lappend proplist "$prefix$prefix<value>$value</value>\n"
|
||||
lappend proplist "$prefix</property>\n"
|
||||
}
|
||||
if [info exists proplist] {return $proplist}
|
||||
}
|
||||
#--------------------------------------------------------------------------
|
||||
proc getgumtreexml {path} {
|
||||
append result "<?xml version = \"1.0\" encoding = \"UTF-8\"?>\n"
|
||||
append result "<hipadaba:SICS xmlns:hipadaba=\"http://www.psi.ch/sics/hipadaba\" >\n"
|
||||
|
||||
if {[string compare $path "/" ] == 0} {
|
||||
foreach n [hlist $path] {
|
||||
set result [make_nodes $n $result 2]
|
||||
}
|
||||
} else {
|
||||
# set result [make_nodes $path $result 2]
|
||||
foreach n [hlist $path] {
|
||||
set result [make_nodes $path/$n $result 2]
|
||||
}
|
||||
}
|
||||
|
||||
append result "</hipadaba:SICS>\n"
|
||||
}
|
||||
#==================== Gumtree batch =========================================
|
||||
proc searchPathForDrivable {name} {
|
||||
set path [string trim [hmatchprop / sicsdev $name]]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
return $path
|
||||
}
|
||||
set txt [findalias $name]
|
||||
if {[string compare $txt NONE] == 0} {
|
||||
return NONE
|
||||
}
|
||||
set l1 [split $txt =]
|
||||
set l [split [lindex $l1 1] ,]
|
||||
foreach alias $l {
|
||||
set alias [string trim $alias]
|
||||
set path [string trim [hmatchprop / sicsdev $alias]]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
return $path
|
||||
}
|
||||
}
|
||||
return NONE
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc searchForCommand {name} {
|
||||
return [string trim [hmatchprop / sicscommand $name]]
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc treatsscan {scanpath command out} {
|
||||
set l [split $command]
|
||||
set len [llength $l]
|
||||
set noVar [expr ($len-2)/3]
|
||||
set np [lindex $l [expr $len -2]]
|
||||
set preset [lindex $l [expr $len -1]]
|
||||
for {set i 0} {$i < $noVar} {incr i} {
|
||||
set start [expr $i * 3]
|
||||
set scanVar [lindex $l [expr 1 + $start]]
|
||||
set scanStart [lindex $l [expr 2 + $start]]
|
||||
set scanEnd [lindex $l [expr 3 + $start]]
|
||||
set scanStep [expr ($scanEnd*1. - $scanStart*1.)/$np*1.]
|
||||
append hdbVar $scanVar ,
|
||||
append hdbStart $scanStart ,
|
||||
append hdbStep $scanStep ,
|
||||
}
|
||||
set hdbVar [string trim $hdbVar ,]
|
||||
set hdbStart [string trim $hdbStart ,]
|
||||
set hdbStep [string trim $hdbStep ,]
|
||||
puts $out "\#NODE: $scanpath"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out "hdbscan $hdbVar $hdbStart $hdbStep $np monitor $preset"
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc treatcscan {scanpath command out} {
|
||||
set l [split $command]
|
||||
set scanVar [lindex $l 1]
|
||||
set scanCenter [lindex $l 2]
|
||||
set scanStep [lindex $l 3]
|
||||
set np [lindex $l 4]
|
||||
set preset [lindex $l 5]
|
||||
set hdbStart [expr $scanCenter - ($np*1.0)/2. * $scanStep*1.0]
|
||||
puts $out "\#NODE: $scanpath"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out "hdbscan $scanVar $hdbStart $scanStep $np monitor $preset"
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc translateCommand {command out} {
|
||||
set drivelist [list drive dr run]
|
||||
set textList [list for while source if]
|
||||
# clientput "Translating: $command"
|
||||
set command [string trim $command]
|
||||
if {[string length $command] < 2} {
|
||||
return
|
||||
}
|
||||
set l [split $command]
|
||||
set obj [string trim [lindex $l 0]]
|
||||
#------- check for drive commands
|
||||
set idx [lsearch $drivelist $obj]
|
||||
if {$idx >= 0} {
|
||||
set dev [lindex $l 1]
|
||||
set path [searchPathForDrivable $dev]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
set realTxt [hgetprop $path sicsdev]
|
||||
set realL [split $realTxt =]
|
||||
set realDev [lindex $realL 1]
|
||||
set mapList [list $dev $realDev]
|
||||
set newCom [string map $mapList $command]
|
||||
puts $out "\#NODE: $path"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out $newCom
|
||||
return
|
||||
}
|
||||
}
|
||||
#------ check for well known broken commands
|
||||
set idx [lsearch $textList $obj]
|
||||
if {$idx >= 0} {
|
||||
puts $out "\#NODE: /batch/commandtext"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
set buffer [string map {\n @nl@} $command]
|
||||
puts $out "hset /batch/commandtext $buffer"
|
||||
return
|
||||
}
|
||||
#--------- check for simple commands
|
||||
set path [searchForCommand $command]
|
||||
if {[string compare $path NONE] != 0} {
|
||||
puts $out "\#NODE: $path"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
puts $out $command
|
||||
return
|
||||
}
|
||||
set scancom [searchForCommand hdbscan]
|
||||
#---------- deal with scans
|
||||
if {[string first sscan $obj] >= 0} {
|
||||
if {[catch {treatsscan $scancom $command $out}] == 0} {
|
||||
return
|
||||
}
|
||||
}
|
||||
if {[string first cscan $obj] >= 0} {
|
||||
if {[catch {treatsscan $scancom $command $out}] == 0} {
|
||||
return
|
||||
}
|
||||
}
|
||||
#--------- give up: output as a text node
|
||||
puts $out "\#NODE: /batch/commandtext"
|
||||
puts $out "clientput BatchPos = 1"
|
||||
set buffer [string map {\n @nl@} $command]
|
||||
puts $out "hset /batch/commandtext $buffer"
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc mgbatch {filename} {
|
||||
global tmppath
|
||||
set f [open $filename r]
|
||||
gets $f line
|
||||
close $f
|
||||
if {[string first MOUNTAINBATCH $line] > 0} {
|
||||
#--------- This is a mountaingum batch file which does not need
|
||||
# to be massaged
|
||||
return $filename
|
||||
}
|
||||
set f [open $filename r]
|
||||
set realfilename [file tail $filename]
|
||||
set out [open $tmppath/$realfilename w]
|
||||
puts $out \#MOUNTAINBATCH
|
||||
while {[gets $f line] >= 0} {
|
||||
append buffer $line
|
||||
if {[info complete $buffer] == 1} {
|
||||
translateCommand $buffer $out
|
||||
unset buffer
|
||||
} else {
|
||||
append buffer \n
|
||||
}
|
||||
}
|
||||
close $out
|
||||
return $tmppath/$realfilename
|
||||
}
|
||||
#----------------------------------------------------------------
|
||||
proc loadmgbatch {filename} {
|
||||
set txt [exe fullpath $filename]
|
||||
set l [split $txt =]
|
||||
set realf [lindex $l 1]
|
||||
set realf [mgbatch $realf]
|
||||
return [exe print $realf]
|
||||
}
|
||||
#============== hdbscan =========================================
|
||||
proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
||||
global stdscangraph hdbscanactive
|
||||
xxxscan clear
|
||||
xxxscan configure script
|
||||
xxxscan function prepare hdbprepare
|
||||
xxxscan function collect hdbcollect
|
||||
set varlist [split $scanvars ,]
|
||||
set startlist [split $scanstart ,]
|
||||
set incrlist [split $scanincr ,]
|
||||
hset $stdscangraph/scan_variable/name [lindex $varlist 0]
|
||||
set count 0
|
||||
foreach var $varlist {
|
||||
if {[string first / $var] >= 0} {
|
||||
set var [string trim [SplitReply [hgetprop $var sicsdev]]]
|
||||
}
|
||||
xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count]
|
||||
incr count
|
||||
}
|
||||
set hdbscanactive 1
|
||||
set status [catch {xxxscan run $np $mode $preset} msg]
|
||||
set hdbscanactive 0
|
||||
if {$status == 0} {
|
||||
return $msg
|
||||
} else {
|
||||
error $msg
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------------------
|
||||
proc hdbprepare {obj userdata } {
|
||||
global stdscangraph
|
||||
stdscan prepare $obj userdata
|
||||
hupdate $stdscangraph/dim
|
||||
}
|
||||
#------------------------------------------------------------------------------
|
||||
proc hdbcollect {obj userobj np} {
|
||||
global stdscangraph
|
||||
stdscan collect $obj $userobj $np
|
||||
hupdate $stdscangraph/scan_variable
|
||||
hupdate $stdscangraph/counts
|
||||
}
|
||||
#-----------------------------------------------------------------------------
|
||||
proc gethdbscanvardata {no} {
|
||||
set np [string trim [SplitReply [xxxscan np]]]
|
||||
if {$np == 0} {
|
||||
return ".0 .0 .0"
|
||||
}
|
||||
set status [catch {SplitReply [xxxscan getvardata $no]} txt]
|
||||
if {$status == 0} {
|
||||
return [join $txt]
|
||||
} else {
|
||||
return ".0 .0 .0"
|
||||
}
|
||||
}
|
||||
#----------------------------------------------------------------------------
|
||||
proc gethdbscancounts {} {
|
||||
set np [string trim [SplitReply [xxxscan np]]]
|
||||
if {$np == 0} {
|
||||
return "0 0 0"
|
||||
}
|
||||
set status [catch {SplitReply [xxxscan getcounts]} txt]
|
||||
if {$status == 0} {
|
||||
return [join $txt]
|
||||
} else {
|
||||
return "0 0 0"
|
||||
}
|
||||
}
|
||||
#================= helper to get the list of batch files =================
|
||||
proc listbatchfiles {} {
|
||||
set ext [list *.tcl *.job *.run]
|
||||
set txt [SplitReply [exe batchpath]]
|
||||
set dirlist [split $txt :]
|
||||
set txt [SplitReply [exe syspath]]
|
||||
set dirlist [concat $dirlist [split $txt :]]
|
||||
# clientput $dirlist
|
||||
set result [list ""]
|
||||
foreach dir $dirlist {
|
||||
foreach e $ext {
|
||||
set status [catch {glob [string trim $dir]/$e} filetxt]
|
||||
if {$status == 0} {
|
||||
set filelist [split $filetxt]
|
||||
foreach f $filelist {
|
||||
# clientput "Working at $f"
|
||||
set nam [file tail $f]
|
||||
if { [lsearch $result $nam] < 0} {
|
||||
# clientput "Adding $nam"
|
||||
lappend result $nam
|
||||
}
|
||||
}
|
||||
} else {
|
||||
# clientput "ERROR: $filetxt"
|
||||
}
|
||||
}
|
||||
}
|
||||
foreach bf $result {
|
||||
append resulttxt $bf ,
|
||||
}
|
||||
return [string trim $resulttxt ,]
|
||||
}
|
||||
#-------------------------------------------------------------------------
|
||||
proc hsearchprop {root prop val} {
|
||||
set children [hlist $root]
|
||||
set childlist [split $children \n]
|
||||
if {[llength $childlist] <= 0} {
|
||||
error "No children"
|
||||
}
|
||||
foreach child $childlist {
|
||||
if {[string length $child] < 1} {
|
||||
continue
|
||||
}
|
||||
catch {hgetprop $root/$child $prop} msg
|
||||
if { [string first ERROR $msg] < 0} {
|
||||
set value [string trim [SplitReply $msg]]
|
||||
if { [string equal -nocase $value $val] == 1} {
|
||||
return $root/$child
|
||||
}
|
||||
}
|
||||
set status [catch {hsearchprop $root/$child $prop $val} node]
|
||||
if {$status == 0} {
|
||||
return $node
|
||||
}
|
||||
}
|
||||
error "Not found"
|
||||
}
|
||||
#============ various utility routines =====================================
|
||||
proc hdbReadOnly {} {
|
||||
error "Parameter is READ ONLY"
|
||||
}
|
||||
#---------------------------------------------------------------------------
|
||||
proc makesampleenv {path} {
|
||||
hfactory $path plain spy none
|
||||
hsetprop $path type graphdata
|
||||
hsetprop $path viewer mountaingumui.TimeSeries
|
||||
hfactory $path/vars plain user text
|
||||
hset $path/vars tomato
|
||||
hfactory $path/rank plain user int
|
||||
hset $path/rank 1
|
||||
hfactory $path/dim plain user intar 1
|
||||
hset $path/dim 300
|
||||
hfactory $path/getdata plain user text
|
||||
hsetprop $path/getdata type logcommand
|
||||
hfactory $path/getdata/starttime plain spy text
|
||||
hfactory $path/getdata/endtime plain spy text
|
||||
}
|
||||
#--------------------------------------------------
|
||||
proc makestdscan {path} {
|
||||
hfactory $path command hdbscan
|
||||
hsetprop $path type command
|
||||
hsetprop $path viewer mountaingumui.ScanEditor
|
||||
hsetprop $path priv user
|
||||
hfactory $path/scan_variables plain user text
|
||||
hsetprop $path/scan_variables argtype drivable
|
||||
hfactory $path/scan_start plain user text
|
||||
hfactory $path/scan_increments plain user text
|
||||
hfactory $path/NP plain user int
|
||||
hfactory $path/mode plain user text
|
||||
hsetprop $path/mode values "monitor,timer"
|
||||
hfactory $path/preset plain user float
|
||||
}
|
||||
#---------------------------------------------------
|
||||
proc makestdscangraphics {path} {
|
||||
global stdscangraph
|
||||
|
||||
set stdscangraph $path
|
||||
|
||||
hfactory $path plain spy none
|
||||
hsetprop $path type graphdata
|
||||
hsetprop $path viewer default
|
||||
hattach $path title title
|
||||
hfactory $path/rank plain mugger int
|
||||
hset $path/rank 1
|
||||
hsetprop $path/rank priv internal
|
||||
hfactory $path/dim script "xxxscan np" hdbReadOnly intar 1
|
||||
hsetprop $path/dim priv internal
|
||||
hfactory $path/scan_variable script "gethdbscanvardata 0" hdbReadOnly floatvarar 1
|
||||
hsetprop $path/scan_variable type axis
|
||||
hsetprop $path/scan_variable dim 0
|
||||
hsetprop $path/scan_variable transfer zip
|
||||
hsetprop $path/scan_variable priv internal
|
||||
hfactory $path/scan_variable/name plain user text
|
||||
hfactory $path/counts script "gethdbscancounts" hdbReadOnly intvarar 1
|
||||
hsetprop $path/counts type data
|
||||
hsetprop $path/counts transfer zip
|
||||
hsetprop $path/counts priv internal
|
||||
}
|
||||
#----------------------------------------------------
|
||||
proc makeQuickPar {name path} {
|
||||
hfactory /quickview/$name plain mugger text
|
||||
hset /quickview/$name $path
|
||||
}
|
||||
#---------------------------------------------------
|
||||
proc makestdbatch {} {
|
||||
hfactory /batch plain spy none
|
||||
hfactory /batch/bufferlist script listbatchfiles hdbReadOnly text
|
||||
sicspoll add /batch/bufferlist hdb 30
|
||||
hfactory /batch/commandtext plain spy text
|
||||
hsetprop /batch/commandtext viewer mountaingumui.TextEdit
|
||||
hsetprop /batch/commandtext commandtext true
|
||||
hfactory /batch/currentline plain user int
|
||||
}
|
||||
#-----------------------------------------------------
|
||||
proc makeslit {path left right upper bottom} {
|
||||
hfactory $path plain spy none
|
||||
hsetprop $path type part
|
||||
if {![string equal $left NONE]} {
|
||||
hattach $path $left left
|
||||
}
|
||||
if {![string equal $right NONE]} {
|
||||
hattach $path $right right
|
||||
}
|
||||
if {![string equal $upper NONE]} {
|
||||
hattach $path $upper upper
|
||||
}
|
||||
if {![string equal $bottom NONE]} {
|
||||
hattach $path $bottom bottom
|
||||
}
|
||||
}
|
||||
#---------------------------------------------------------
|
||||
proc makestdadmin {} {
|
||||
hfactory /instrument/experiment plain spy none
|
||||
hattach /instrument/experiment title title
|
||||
hattach /instrument/experiment user user
|
||||
hattach /instrument/experiment/user adress address
|
||||
hattach /instrument/experiment/user phone phone
|
||||
hattach /instrument/experiment/user email email
|
||||
hfactory /instrument/experiment/datafilenumber script sicsdatanumber \
|
||||
hdbReadOnly int
|
||||
hsetprop /instrument/experiment/datafilenumber priv internal
|
||||
hfactory /instrument/experiment/batchpath script "exe batchpath" \
|
||||
"exe batchpath" text
|
||||
hsetprop /instrument/experiment/batchpath priv user
|
||||
}
|
||||
#----------------------------------------------------------
|
||||
proc makecount {path} {
|
||||
hfactory $path command count
|
||||
hsetprop $path type command
|
||||
hsetprop $path priv user
|
||||
hfactory $path/mode plain user text
|
||||
hsetprop $path/mode values "monitor,timer"
|
||||
hfactory $path/preset plain user float
|
||||
hset $path/preset 60000
|
||||
hset $path/mode monitor
|
||||
}
|
||||
#----------------------------------------------------------
|
||||
proc makerepeat {path} {
|
||||
hfactory $path command repeat
|
||||
hsetprop $path type command
|
||||
hsetprop $path priv user
|
||||
hfactory $path/num plain user int
|
||||
hfactory $path/mode plain user text
|
||||
hsetprop $path/mode values "monitor,timer"
|
||||
hfactory $path/preset plain user float
|
||||
hset $path/preset 60000
|
||||
hset $path/mode monitor
|
||||
}
|
||||
#----------------------------------------------------------
|
||||
proc makekillfile {path} {
|
||||
hcommand $path killfile
|
||||
hsetprop $path type command
|
||||
hsetprop $path priv manager
|
||||
}
|
||||
#----------------------------------------------------------
|
||||
proc makesuccess {path} {
|
||||
hcommand $path success
|
||||
hsetprop $path type command
|
||||
hsetprop $path priv user
|
||||
}
|
||||
#-----------------------------------------------------------
|
||||
proc makestdgui {} {
|
||||
hfactory /gui plain spy none
|
||||
hfactory /gui/status plain internal text
|
||||
status hdbinterest /gui/status
|
||||
}
|
||||
#------------------------------------------------------------
|
||||
proc makewait {path} {
|
||||
hfactory $path command wait
|
||||
hsetprop $path type command
|
||||
hsetprop $path priv user
|
||||
hfactory $path/time plain user int
|
||||
}
|
||||
#------------------------------------------------------------
|
||||
proc makeevproxy {rootpath hdbname devicename} {
|
||||
MakeProxy p${devicename} $devicename float
|
||||
p${devicename} map upperlimit upperlimit float user
|
||||
p${devicename} map lowerlimit lowerlimit float user
|
||||
hlink $rootpath p${devicename} $hdbname
|
||||
hsetprop $rootpath/$hdbname sicsdev $devicename
|
||||
hsetprop $rootpath/$hdbname type drivable
|
||||
sicspoll add $rootpath/$hdbname hdb 30
|
||||
}
|
||||
#================== multi motor stuff =======================
|
||||
proc getNamposList {mumo} {
|
||||
set txt [$mumo list]
|
||||
set l [split $txt "\n"]
|
||||
set lala [llength $l]
|
||||
for {set i 1} {$i < [llength $l]} {incr i} {
|
||||
set pos [lindex $l $i]
|
||||
if {[string length $pos] > 1} {
|
||||
append result [lindex $l $i] ","
|
||||
}
|
||||
}
|
||||
if { ![info exists result] } {
|
||||
# clientput "nampos = $txt"
|
||||
append result UNKNOWN
|
||||
}
|
||||
return [string trimright $result ","]
|
||||
}
|
||||
#------------------------------------------------------------
|
||||
proc getNamPos {mumo} {
|
||||
set txt [$mumo find]
|
||||
set l [split $txt =]
|
||||
return [string trim [lindex $l 1]]
|
||||
}
|
||||
#-----------------------------------------------------------
|
||||
proc updateNamePosValues {rootpath} {
|
||||
hupdate $rootpath/namedposition/values
|
||||
hupdate $rootpath/dropnamedposition/name/values
|
||||
}
|
||||
#------------------------------------------------------------
|
||||
proc makemumopos {mumo rootpath name} {
|
||||
$mumo pos $name
|
||||
updateNamePosValues $rootpath
|
||||
}
|
||||
#-----------------------------------------------------------
|
||||
proc dropmumo {mumo rootpath name} {
|
||||
$mumo drop $name
|
||||
updateNamePosValues $rootpath
|
||||
}
|
||||
#------------------------------------------------------------
|
||||
proc getDropList {mumo} {
|
||||
set txt [getNamposList $mumo]
|
||||
append txt ",all"
|
||||
return $txt
|
||||
}
|
||||
#-------------------------------------------------------------
|
||||
proc makemumo {rootpath mumoname} {
|
||||
hfactory $rootpath/namedposition script "getNamPos $mumoname" \
|
||||
$mumoname text
|
||||
hsetprop $rootpath/namedposition priv user
|
||||
hfactory $rootpath/namedposition/values script \
|
||||
"getNamposList $mumoname" hdbReadOnly text
|
||||
hsetprop $rootpath/namedposition/values visible false
|
||||
hupdate $rootpath/namedposition/values
|
||||
hfactory $rootpath/assignname2current command \
|
||||
"makemumopos $mumoname $rootpath"
|
||||
hsetprop $rootpath/assignname2current priv user
|
||||
hsetprop $rootpath/assignname2current type command
|
||||
hfactory $rootpath/assignname2current/name plain user text
|
||||
hset $rootpath/assignname2current/name "Undefined"
|
||||
hfactory $rootpath/dropnamedposition command \
|
||||
"dropmumo $mumoname $rootpath"
|
||||
hsetprop $rootpath/dropnamedposition priv user
|
||||
hsetprop $rootpath/dropnamedposition type command
|
||||
hfactory $rootpath/dropnamedposition/name plain user text
|
||||
hfactory $rootpath/dropnamedposition/name/values script \
|
||||
"getDropList $mumoname" hdbReadOnly text
|
||||
hsetprop $rootpath/dropnamedposition/name/values visible false
|
||||
hupdate $rootpath/dropnamedposition/name/values
|
||||
}
|
||||
#-----------------------------------------------------------------
|
||||
proc hdbbatchpath {pathstring} {
|
||||
exe batchpath $pathstring
|
||||
hupdate /instrument/commands/batch/execute/file/values
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc makeexe {} {
|
||||
set path /instrument/commands/batch
|
||||
hfactory $path plain spy none
|
||||
hfactory $path/batchpath script "exe batchpath" hdbbatchpath text
|
||||
hsetprop $path/batchpath priv user
|
||||
hfactory $path/execute command exe
|
||||
hsetprop $path/execute type command
|
||||
hsetprop $path/execute priv user
|
||||
hfactory $path/execute/file plain user text
|
||||
hfactory $path/execute/file/values script listbatchfiles hdbReadOnly text
|
||||
sicspoll add $path/execute/file/values hdb 60
|
||||
}
|
||||
Reference in New Issue
Block a user