initial commit
This commit is contained in:
l_samenv
273
tcl/startup/graph.tcl
Normal file
273
tcl/startup/graph.tcl
Normal file
@ -0,0 +1,273 @@
|
||||
proc GraphAvailable {varOrPath {outname 0} {objname 0}} {
|
||||
if {[string match "/*" $varOrPath]} { # its a path
|
||||
set loggername [silent "" hgetpropval $varOrPath logger_name]
|
||||
if {$loggername eq ""} {
|
||||
return 0
|
||||
}
|
||||
scan [hinfo $varOrPath] {%[a-z],} type
|
||||
if {$type in [list int float] || [silent "" hgetpropval $varOrPath enum] ne ""} {
|
||||
if {$outname ne "0"} {
|
||||
upvar $outname v
|
||||
set v $loggername
|
||||
}
|
||||
return 1
|
||||
}
|
||||
return 0
|
||||
}
|
||||
# its a sics variable / command
|
||||
set vl [split $varOrPath]
|
||||
if {[lindex $vl 0] eq "run"} {
|
||||
set loggername [lindex $vl 1]
|
||||
set par ""
|
||||
set obj [lindex $vl 1]
|
||||
} else {
|
||||
set loggername [join $vl .]
|
||||
if {[llength $vl] == 1} {
|
||||
if {[string match "*.*" $varOrPath]} {
|
||||
set vl [split $varOrPath .]
|
||||
set obj [lindex $vl 0]
|
||||
set par [lindex $vl 1]
|
||||
} else {
|
||||
set obj $varOrPath
|
||||
set par ""
|
||||
}
|
||||
} else {
|
||||
set par [lindex $vl 1]
|
||||
set obj [lindex $vl 0]
|
||||
}
|
||||
}
|
||||
|
||||
set var [silent "" result $obj loggeditems $par]
|
||||
if {$var eq ""} {
|
||||
return 0
|
||||
}
|
||||
|
||||
if {$outname ne "NONE"} {
|
||||
upvar $outname v
|
||||
set v $loggername
|
||||
}
|
||||
if {$objname ne "0"} {
|
||||
upvar $objname o
|
||||
set o $obj
|
||||
}
|
||||
return 2
|
||||
}
|
||||
|
||||
proc GraphIcon {varOrPath} {
|
||||
#this feature disabled
|
||||
return
|
||||
|
||||
switch [GraphAvailable $varOrPath var obj] {
|
||||
0 {
|
||||
return
|
||||
}
|
||||
1 { # path
|
||||
set path $varOrPath
|
||||
set pl [split $path /]
|
||||
set g "logger/"
|
||||
set id "config grs/[lindex $pl 1]"
|
||||
foreach itm [lrange $pl 1 end-1] {
|
||||
append g "$itm/"
|
||||
append id " $g"
|
||||
}
|
||||
append id " g-$var"
|
||||
clientput "-X$id"
|
||||
}
|
||||
2 { # sics var
|
||||
clientput "-Xconfig gro/$obj g-$var"
|
||||
}
|
||||
}
|
||||
}
|
||||
|
||||
proc GraphInput {varOrPath} {
|
||||
global shown_groups
|
||||
|
||||
if {[GraphAvailable $varOrPath var] == 0} {
|
||||
return
|
||||
}
|
||||
|
||||
Newline
|
||||
# if {[info exists shown_groups(g-$var)]} {
|
||||
# clientput "-J"
|
||||
# Style graphsettings
|
||||
# }
|
||||
CheckBox "plot $var" "GraphItem shown $var"
|
||||
clientput "---"
|
||||
#NoNewline
|
||||
|
||||
clientput "-Tlabel"
|
||||
clientput "-W12"
|
||||
clientput "-V[result GraphItem label $var]"
|
||||
clientput "-IGraphItem label $var"
|
||||
NoNewline
|
||||
|
||||
clientput "-Tunits"
|
||||
clientput "-W3"
|
||||
clientput "-V[result GraphItem units $var]"
|
||||
clientput "-IGraphItem units $var"
|
||||
NoNewline
|
||||
|
||||
clientput "-Tcolor"
|
||||
clientput "-V[GraphItem color $var]"
|
||||
clientput "-cGraphItem color $var"
|
||||
Newline
|
||||
}
|
||||
|
||||
proc GraphItem {type var {value NONE}} {
|
||||
if {[string match /* $var]} {
|
||||
set var [join [split [string range $var 1 end] /] .]
|
||||
}
|
||||
if {$value eq "NONE"} {
|
||||
if {[graph_$type exists $var]} {
|
||||
return [result graph_$type $var]
|
||||
} else {
|
||||
return ""
|
||||
}
|
||||
} else {
|
||||
graph_$type makeitem $var
|
||||
graph_$type $var "[join [split $value] _]"
|
||||
GraphSave
|
||||
}
|
||||
}
|
||||
|
||||
publishLazy GraphItem
|
||||
|
||||
proc graphLayout {} {
|
||||
Group graph "curve settings"
|
||||
}
|
||||
|
||||
proc graphGroup {} {
|
||||
foreach item [graph_label items] {
|
||||
}
|
||||
}
|
||||
|
||||
proc GraphSave {} {
|
||||
set vars ""
|
||||
foreach var [graph_shown items] {
|
||||
if {[result graph_shown $var]} {
|
||||
set units [result silent "" graph_units $var]
|
||||
set label [result silent "" graph_label $var]
|
||||
set color [result silent "" graph_color $var]
|
||||
set item $var|$units
|
||||
if {$label ne ""} {
|
||||
append item |$label
|
||||
}
|
||||
if {$color ne ""} {
|
||||
append item |$color
|
||||
}
|
||||
append vars "$item "
|
||||
}
|
||||
}
|
||||
vars = $vars
|
||||
return OK
|
||||
}
|
||||
|
||||
proc GraphAdd {var {units ""} {label ""} {color ""}} {
|
||||
if {[string match /* $var]} {
|
||||
set var [join [split [string range $var 1 end] /] .]
|
||||
}
|
||||
if {![appendVars $var|$units|$label|$color]} {
|
||||
# we are not inside configuration scripts
|
||||
graph_shown makeitem $var 1
|
||||
graph_units makeitem $var
|
||||
if {$units ne ""} {
|
||||
graph_units $var $units
|
||||
}
|
||||
graph_label makeitem $var
|
||||
if {$label ne ""} {
|
||||
graph_label $var $label
|
||||
}
|
||||
graph_color makeitem $var
|
||||
if {$color ne ""} {
|
||||
graph_color $var $color
|
||||
}
|
||||
GraphSave
|
||||
}
|
||||
}
|
||||
|
||||
publishLazy GraphAdd
|
||||
|
||||
proc GraphLoad {vars {glist 0}} {
|
||||
if {$glist ne 0} {
|
||||
catch {makeobject graph__$glist array}
|
||||
}
|
||||
foreach item $vars {
|
||||
if {[string match {*|*} $item]} {
|
||||
set i [split "$item|||" |]
|
||||
} else {
|
||||
set i [split "$item///" /]
|
||||
}
|
||||
set v [lindex $i 0]
|
||||
set u [lindex $i 1]
|
||||
set l [lindex $i 2]
|
||||
set c [lindex $i 3]
|
||||
graph_shown makeitem $v 1
|
||||
graph_units makeitem $v
|
||||
if {$glist ne "0"} {
|
||||
graph__$glist makeitem $v 1
|
||||
}
|
||||
if {$u ne ""} {
|
||||
graph_units $v $u
|
||||
}
|
||||
graph_label makeitem $v
|
||||
if {$l ne ""} {
|
||||
graph_label $v $l
|
||||
}
|
||||
graph_color makeitem $v
|
||||
if {$c ne ""} {
|
||||
graph_color $v $c
|
||||
}
|
||||
}
|
||||
GraphSave
|
||||
return OK
|
||||
}
|
||||
|
||||
proc GraphKill {glist} {
|
||||
catch {
|
||||
foreach item [graph__$glist items] {
|
||||
graph_shown deleteitem $item
|
||||
}
|
||||
removeobject graph__$glist
|
||||
}
|
||||
foreach item [graph_shown items] {
|
||||
set obj [lindex [split $item "."] 0]
|
||||
if {[sicsdescriptor $obj] eq "notfound"} {
|
||||
graph_shown deleteitem $item
|
||||
}
|
||||
}
|
||||
GraphSave
|
||||
}
|
||||
|
||||
proc GraphOrder args {
|
||||
if {[catch {
|
||||
foreach unit [graph_order items] {
|
||||
graph_order deleteitem $unit
|
||||
}
|
||||
foreach unit $args {
|
||||
graph_order makeitem $unit
|
||||
set new($unit) [list]
|
||||
}
|
||||
set gitems [graph_shown items]
|
||||
foreach item $gitems {
|
||||
set unit [silent none result graph_units $item]
|
||||
graph_order makeitem $unit
|
||||
lappend new($unit) $item
|
||||
lappend new($unit) [silent 0 result graph_shown $item]
|
||||
graph_shown deleteitem $item
|
||||
}
|
||||
foreach unit [graph_order items] {
|
||||
foreach {item enable} $new($unit) {
|
||||
graph_shown makeitem $item $enable
|
||||
}
|
||||
}
|
||||
GraphSave
|
||||
} msg]} {
|
||||
clientlog $msg
|
||||
GraphLoad [result vars]
|
||||
}
|
||||
}
|
||||
|
||||
publishLazy GraphSave
|
||||
publishLazy GraphLoad
|
||||
publishLazy GraphOrder
|
||||
|
||||
Reference in New Issue
Block a user