initial commit

tcl/startup/lsvar.tcl

@@ -0,0 +1,145 @@
+# list variables normally shown in graphic window
+# to be used for a quick overview with a slow connection
+# M. Bartkowiak Sept 2014
+# M. Zolliker Oct 2014
+
+proc get_var_value {var {unit NONE} {valunitname ""}} {
+  upvar $valunitname valunit
+  set path [join [split $var .] /]
+  if {[catch "hgetpropval $path logger_name"] == 0} {
+    # hipadaba
+    set val [hvali $path]
+    set valunit0 "$val $unit"
+    catch {set valunit0 [format {%12.7g %s} $val $unit]}
+    set valunit [silent $valunit0 hgetpropval $path geterror]
+    if {$valunit0 ne $valunit} {
+      return NaN
+    }
+    return $val
+  } else {
+    set sub ""
+    scan $path {%[^/]/%s} obj sub
+    set com "result $obj $sub"
+    if [catch $com val] {
+      set valunit $val
+      return NaN
+    }    
+    set valunit [format "%12s %s" $val $unit]
+    catch {set valunit [format "%12.6g %s" $val $unit}
+    return $val
+  }
+}
+
+proc lsvar {} {
+  set units [list]
+  set output "[samenv name]\n"
+  foreach item [result vars] {
+    set unit 0
+    set label ""
+    scan $item {%[^|]|%[^|]|%[^|]|} var unit label
+    if {$label eq ""} {
+      set label $var
+    }
+    set fullunit $unit
+    scan $unit {%[^_]} unit
+    get_var_value $var $unit valunit
+    if {! [info exists output_$fullunit]} {
+      lappend units $fullunit
+    }
+    append output_$fullunit [format "%-12s: %s\n" $label $valunit]
+  }
+  foreach fullunit $units {
+    append output [set output_$fullunit]
+  }
+  clientput $output
+}
+
+publishLazy lsvar Spy
+
+proc lsvarjson {} {
+  set units [list]
+  foreach item [result vars] {
+    set unit 0
+    set label ""
+    scan $item {%[^|]|%[^|]|%[^|]|} var unit label
+    if {$label eq ""} {
+      set label $var
+    }
+    set fullunit $unit
+    scan $unit {%[^_]} unit
+    set path [join [split $var .] /]
+    if {[catch "hgetpropval $path logger_name"] == 0} {
+      # hipadaba
+      set val [hvali $path]
+      catch {set val [format %.7g $val]}
+      set valunit [format {,"value":"%s","unit":"%s"} $val $unit]
+      catch {
+        append valunit [format {,"error":"%s"} [hgetpropval $path geterror]]
+      }
+    } else {
+      set sub ""
+      scan $path {%[^/]/%s} obj sub
+      set com "result $obj $sub"
+      if [catch $com val] {
+        set valunit [format {,"error":"%s"} $val]
+      } else {
+        catch {set val [format "%.6g" $val]}
+        set valunit [format {,"value":"%s","unit":"%s"} $val $unit]
+      }
+    }
+    if {! [info exists output_$fullunit]} {
+      lappend units $fullunit
+    }
+    lappend output_$fullunit [format {{"label":"%s"%s}} $label $valunit]
+  }
+  set output [list]
+  foreach fullunit $units {
+    lappend output [set output_$fullunit]
+  }
+  return [format {[%s]} [join $output ,]]
+}
+
+proc lsvarhtml {} {
+  set units [list]
+  set output "<h2>[string toupper [samenv name]]</h2><table>"
+  foreach item [result vars] {
+    set unit 0
+    set label ""
+    scan $item {%[^|]|%[^|]|%[^|]|} var unit label
+    if {$label eq ""} {
+      set label $var
+    }
+    set fullunit $unit
+    scan $unit {%[^_]} unit
+    set path [join [split $var .] /]
+    if {[catch "hgetpropval $path logger_name"] == 0} {
+      # hipadaba
+      set val [hvali $path]
+      catch {set val [format %.7g $val]}
+      set valunit "<td align=right>$val</td><td>$unit</td>"
+      catch {
+        set valunit "<td colspan=2>[hgetpropval $path geterror]</td>"
+      }
+    } else {
+      set sub ""
+      scan $path {%[^/]/%s} obj sub
+      set com "result $obj $sub"
+      if [catch $com val] {
+
+      } else {
+        catch {set val [format "%.6g" $val]}
+      }
+      set valunit "<td align=right>$val</td><td>$unit</td>"
+    }
+    if {! [info exists output_$fullunit]} {
+      lappend units $fullunit
+    }
+    append output_$fullunit "<tr><td>$label</td>$valunit</tr>"
+  }
+  foreach fullunit $units {
+    append output [set output_$fullunit]
+  }
+  clientput "$output</table>"
+}
+
+publishLazy lsvarhtml Spy