/usr/share/saods9/src/plotbar.tcl is in saods9-data 7.2+dfsg-4.
This file is owned by root:root, with mode 0o644.
The actual contents of the file can be viewed below.
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 | # Copyright (C) 1999-2012
# Smithsonian Astrophysical Observatory, Cambridge, MA, USA
# For conditions of distribution and use, see copyright notice in "copyright"
package provide DS9 1.0
proc PlotBarTool {} {
global iap
PlotBar $iap(tt) [msgcat::mc {Bar Plot Tool}] {} {} {} 2 {}
}
proc PlotBar {tt wtt title xaxis yaxis dim data} {
global iap
# make the window name unique
set ii [lsearch $iap(windows) $tt]
if {$ii>=0} {
append tt $iap(unique)
incr iap(unique)
}
# set the window title if none
if {$wtt == {}} {
set wtt $tt
}
set varname $tt
upvar #0 $varname var
global $varname
PlotBarProc $varname
PlotDialog $varname $wtt $title $xaxis $yaxis
PlotDialogBar $varname
PlotDataSet $varname $dim $data
$var(proc,updategraph) $varname
PlotStats $varname
PlotList $varname
}
proc PlotBarDialog {varname wtt title xaxis yaxis} {
upvar #0 $varname var
global $varname
PlotBarProc $varname
PlotDialog $varname $wtt $title $xaxis $yaxis
PlotDialogBar $varname
}
proc PlotBarProc {varname} {
upvar #0 $varname var
global $varname
set var(proc,updategraph) PlotBarUpdateGraph
set var(proc,createelement) PlotBarCreateElement
set var(proc,updateelement) PlotBarUpdateElement
set var(proc,highlite) PlotBarHighliteElement
set var(proc,button) PlotBarButton
}
proc PlotDialogBar {varname} {
upvar #0 $varname var
global $varname
set var(seq) 1
set var(discrete) 0
set var(linear) 0
set var(step) 0
set var(quadratic) 0
set var(error) 0
set var(bar) 1
# bar
$var(mb).element add checkbutton -label [msgcat::mc {Show}] \
-variable ${varname}(bar) \
-command [list $var(proc,updateelement) $varname]
$var(mb).element add separator
$var(mb).element add cascade \
-label [msgcat::mc {Color}] \
-menu $var(mb).element.color
ColorMenu $var(mb).element.color $varname bar,color \
[list PlotUpdateElementBar $varname]
# graph
set var(graph) [blt::barchart $var(top).bar \
-width 600 -height 500 \
-plotrelief groove \
-plotborderwidth 2 \
]
$var(graph) xaxis configure -grid no -stepsize 0
$var(graph) yaxis configure -grid yes
$var(graph) legend configure -hide yes
pack $var(graph) -expand yes -fill both
PlotChangeMode $varname
}
proc PlotBarUpdateGraph {varname} {
upvar #0 $varname var
global $varname
if {$var(graph,x,auto)} {
set xmin {}
set xmax {}
} else {
set xmin $var(graph,x,min)
set xmax $var(graph,x,max)
}
if {$var(xdata) != {}} {
if {$var(graph,x,auto)} {
set xxmin [blt::vector expr min($var(xdata))]
set xxmax [blt::vector expr max($var(xdata))]
} else {
set xxmin $var(graph,x,min)
set xxmax $var(graph,x,max)
}
set xmin [expr $xxmin-$var(barwidth)/2.]
set xmax [expr $xxmax+$var(barwidth)/2.]
}
if {$var(graph,y,auto)} {
set ymin {}
set ymax {}
} else {
set ymin $var(graph,y,min)
set ymax $var(graph,y,max)
}
$var(graph) xaxis configure -min $xmin -max $xmax \
-descending $var(graph,x,flip)
$var(graph) yaxis configure -min $ymin -max $ymax \
-descending $var(graph,y,flip)
PlotUpdateGraph $varname
}
proc PlotBarCreateElement {varname} {
upvar #0 $varname var
global $varname
# warning: uses current vars
if {$var(data,total) == 0} {
return
}
# delete current elements
set nn $var(data,current)
foreach el [$var(graph) element names] {
set f [split $el -]
if {[lindex $f 1] == $nn} {
$var(graph) element delete $el
}
}
global $var(xdata) $var(ydata)
set aa [blt::vector expr min($var(xdata))]
set bb [blt::vector expr max($var(xdata))]
set var(barwidth) [expr abs(1.0*($bb-$aa) / ([$var(xdata) length]-1))]
switch $var(bar,color) {
black {set clr "#000001"}
default {set clr $var(bar,color)}
}
$var(graph) element create "b-${nn}" \
-xdata $var(xdata) -ydata $var(ydata) \
-relief flat -barwidth $var(barwidth) \
-foreground $clr -background $clr
# do this to force an update in case of no visible elements
$var(graph) legend configure -hide yes
}
proc PlotBarUpdateElement {varname} {
upvar #0 $varname var
global $varname
set nn $var(data,current)
set var($nn,bar) $var(bar)
$var(graph) element configure "b-${nn}" -hide [expr !$var(bar)]
}
proc PlotBarButton {varname x y} {
upvar #0 $varname var
global $varname
}
proc PlotBarHighliteElement {varname rowlist} {
upvar #0 $varname var
global $varname
}
|