initial commit

tcl/remob.tcl

@@ -0,0 +1,155 @@
+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}