156 lines
3.5 KiB
Tcl
156 lines
3.5 KiB
Tcl
proc result {cmd args} {
|
|
set res [eval $cmd $args]
|
|
set list [split $res =]
|
|
if {[llength $list] > 1} {
|
|
return [string trim [lindex $list 1]]
|
|
} else {
|
|
return [string trim $res]
|
|
}
|
|
}
|
|
|
|
proc remob_connect { me you port {fwd -1}} {
|
|
clientput "remob_connect $me $you $port"
|
|
if {0 != [catch { $you }] } {
|
|
if {$fwd == 0} {
|
|
remob server $you localhost.localdomain $port 0
|
|
} else {
|
|
remob server $you localhost.localdomain $port
|
|
}
|
|
}
|
|
if {0 != [catch { $you status }]} {
|
|
return 0
|
|
}
|
|
set conn [split [result $you] " "]
|
|
set conn [lindex $conn 1]
|
|
catch {$you $me} msg
|
|
if { [string match "*$me =*" "$msg"] } {
|
|
set old [split [string trim $msg] =]
|
|
set old [lindex [split [string trim [lindex $old 1]] " "] 0]
|
|
if {[string compare $conn $old] != 0} {
|
|
$you remob del $me
|
|
if {$fwd == 1} {
|
|
$you remob server $me $conn 0
|
|
} else {
|
|
$you remob server $me $conn
|
|
}
|
|
}
|
|
} else {
|
|
if {$fwd == 1} {
|
|
$you remob server $me $conn 0
|
|
} else {
|
|
$you remob server $me $conn
|
|
}
|
|
}
|
|
$you nowait $me nowait status
|
|
return 1
|
|
}
|
|
|
|
proc update_remob {} {
|
|
set objects [split [obj_list items] " "]
|
|
set aliases [definealias -list]
|
|
foreach a $aliases {
|
|
if {[obj_list exists [definealias -translate $a]]} {
|
|
lappend objects $a
|
|
}
|
|
}
|
|
sics sea markForDel
|
|
if {[catch {sics remob obj samenv sea} msg]} {
|
|
clientput $msg
|
|
}
|
|
if {[catch {sics remob obj cfgenv sea} msg]} {
|
|
clientput $msg
|
|
}
|
|
if {[sicstype temperature] eq "DRIV"} {
|
|
sics remob drv temperature sea
|
|
}
|
|
# if {[string compare [sicsdescriptor tt] notfound] != 0} {
|
|
# sics remob drv tt sea
|
|
# }
|
|
foreach o $objects {
|
|
set d [sicstype $o]
|
|
if {[
|
|
catch {
|
|
if { [string compare $d DRIV] == 0 } {
|
|
sics remob drv $o sea
|
|
} else {
|
|
sics remob obj $o sea
|
|
}
|
|
} msg]} {
|
|
clientput "$o not available in sics"
|
|
}
|
|
}
|
|
sics sea delMarked
|
|
if {[string equal hset [string trim [sics sicsdescriptor hset]]]} {
|
|
set v [definealias -show temperature]
|
|
if {$v eq "tt"} {
|
|
set v tt.ts
|
|
}
|
|
sics update_temperature_var $v
|
|
}
|
|
}
|
|
|
|
proc sea_get {var args} {
|
|
upvar $var v
|
|
|
|
set obj [lindex $args 0]
|
|
set desc [sicsdescriptor $obj]
|
|
if {[string compare $desc RemObject] == 0} {
|
|
set desc [string trim [sea sicsdescriptor $obj]]
|
|
}
|
|
if {[string compare $desc notfound] == 0} {
|
|
return 0
|
|
}
|
|
if {[catch { set res [split [$args] =] }] == 0} {
|
|
set val [lindex $res 1]
|
|
if {[string is double -strict $val]} {
|
|
set v $val
|
|
return 1
|
|
}
|
|
}
|
|
return 0
|
|
}
|
|
|
|
proc update_temperature_var {{arg ""}} {
|
|
silent 0 hset /graphics/temperature/vars $arg
|
|
}
|
|
|
|
proc connect_sea {{port 8641} {try 3}} {
|
|
catch {
|
|
if { [remob_connect sics sea $port 1] } {
|
|
sea nowait update_remob
|
|
#remob obj samenv sea
|
|
#remob obj cfgenv sea
|
|
#remob drv temperature sea
|
|
}
|
|
return 0
|
|
} msg
|
|
if {$msg ne "0"} {
|
|
clientput $msg
|
|
if {$try > 0} {
|
|
clientput "retry connect_sea later"
|
|
incr try -1
|
|
dolater 10 "connect_sea $port $try"
|
|
}
|
|
}
|
|
}
|
|
|
|
proc connect_sics {} {
|
|
global connect_sea_to_sics
|
|
|
|
# do not connect when connect_sea_to_sics is 0
|
|
# if connect_sea_to_sics is defined, it contains the sics port number
|
|
|
|
set port [silent 2911 set connect_sea_to_sics]
|
|
if {$port != 0} {
|
|
clientput "connect_sics $port"
|
|
remob_connect sea sics $port 0
|
|
update_remob
|
|
}
|
|
}
|
|
|
|
publish connect_sea User
|
|
publish connect_sics User
|
|
publish update_remob User
|
|
publish update_temperature_var User
|
|
catch {SicsUser remuser sesam 2}
|