highlight background color is new
[dyninst.git] / visiClients / tableVisi / tcl / tableVisi.tcl
1 # tableVisi.tcl
2 # Ariel Tamches
3
4 #
5 # $Log: tableVisi.tcl,v $
6 # Revision 1.4  1995/12/20 02:29:44  tamches
7 # minor menu fix
8 #
9 # Revision 1.3  1995/11/29 00:44:19  tamches
10 # We now call makeLogo
11 #
12 # Revision 1.2  1995/11/08 21:15:33  tamches
13 # choosing sig figs is no longer a slider widget; it is a bunch of menu
14 # choices
15 #
16 # Revision 1.1  1995/11/04 00:43:12  tamches
17 # First version of new table visi
18 #
19 #
20
21 proc initializeTableVisi {} {
22    if {[winfo depth .] > 1} {
23    #  . config -bg grey
24      option add *Background grey
25      option add *activeBackground LightGrey
26      option add *activeForeground black
27      option add *Scale.activeForeground grey
28    } else {
29      option add *Background white
30      option add *Foreground black
31    }
32    
33    option add *Visi*font *-New*Century*Schoolbook-Bold-R-*-18-*
34    option add *Data*font *-Helvetica-*-r-*-12-* 
35    option add *MyMenu*font *-New*Century*Schoolbook-Bold-R-*-14-*
36    
37    # Create the title bar, menu bar, and logo at the top:
38    frame .top
39    pack .top -side top -fill x
40    
41    frame .top.left 
42    pack .top.left -side left -fill both -expand true
43    
44    label .top.left.title -relief raised -text "Table Visualization" \
45          -font *-New*Century*Schoolbook-Bold-R-*-14-* \
46          -foreground white -background HotPink2
47    pack .top.left.title -side top -fill both -expand true
48    
49    # Menus:
50    
51    frame .top.left.menubar -class MyMenu -borderwidth 2 -relief raised
52    pack .top.left.menubar -side top -fill x
53    
54    menubutton .top.left.menubar.file -text "File" -menu .top.left.menubar.file.m
55    menu .top.left.menubar.file.m -selectcolor cornflowerblue
56    .top.left.menubar.file.m add command -label "Close Table" -command {destroy .}
57    
58    menubutton .top.left.menubar.acts -text "Actions" -menu .top.left.menubar.acts.m
59    menu .top.left.menubar.acts.m  -selectcolor cornflowerblue
60    .top.left.menubar.acts.m add command -label "Add Entries" -command AddEntry
61    .top.left.menubar.acts.m add command -label "Delete Selected Entry" -command DelEntry -state disabled
62    
63    menubutton .top.left.menubar.opts -text "View" -menu .top.left.menubar.opts.m
64    menu .top.left.menubar.opts.m  -selectcolor cornflowerblue
65
66    global LongNames
67    set LongNames 1
68    .top.left.menubar.opts.m add check -label "Long Names" -variable LongNames -command {updateNames $LongNames}
69    .top.left.menubar.opts.m add separator
70
71    global DataFormat
72    set DataFormat 0
73    .top.left.menubar.opts.m add radio -label "Current Values" \
74            -variable DataFormat \
75            -value 0 -command formatChanged
76    .top.left.menubar.opts.m add radio -label "Average Values" \
77            -variable DataFormat \
78            -value 1 -command formatChanged
79    .top.left.menubar.opts.m add radio -label "Total Values" \
80            -variable DataFormat \
81            -value 2 -command formatChanged
82    .top.left.menubar.opts.m add separator
83    global sortMetrics
84    set sortMetrics 0
85    .top.left.menubar.opts.m add radio -label "Don't Sort Metrics" \
86            -variable sortMetrics -value 0 -command unsortMetrics
87    .top.left.menubar.opts.m add radio -label "Sort Metrics (ascending)" \
88            -variable sortMetrics -value 1 -command sortMetrics
89    .top.left.menubar.opts.m add separator
90    global sortFoci
91    set sortFoci 0
92    .top.left.menubar.opts.m add radio -label "Don't Sort Foci" \
93            -variable sortFoci -value 0 -command unsortFoci
94    .top.left.menubar.opts.m add radio -label "Sort Foci (ascending)" \
95            -variable sortFoci -value 1 -command sortFoci
96    
97    # significant digits at the end of the View menu (?)
98    global SignificantDigits
99    set SignificantDigits 3
100
101    .top.left.menubar.opts.m add separator
102    .top.left.menubar.opts.m add radio -label "1 significant digit" \
103            -variable SignificantDigits -value 1 -command "sigFigChange "
104    .top.left.menubar.opts.m add radio -label "2 significant digits" \
105            -variable SignificantDigits -value 2 -command "sigFigChange "
106    .top.left.menubar.opts.m add radio -label "3 significant digits" \
107            -variable SignificantDigits -value 3 -command "sigFigChange "
108    .top.left.menubar.opts.m add radio -label "4 significant digits" \
109            -variable SignificantDigits -value 4 -command "sigFigChange "
110    .top.left.menubar.opts.m add radio -label "5 significant digits" \
111            -variable SignificantDigits -value 5 -command "sigFigChange "
112    .top.left.menubar.opts.m add radio -label "6 significant digits" \
113            -variable SignificantDigits -value 6 -command "sigFigChange "
114    .top.left.menubar.opts.m add radio -label "7 significant digits" \
115            -variable SignificantDigits -value 7 -command "sigFigChange "
116    .top.left.menubar.opts.m add radio -label "8 significant digits" \
117            -variable SignificantDigits -value 8 -command "sigFigChange "
118
119    #  Add menu bar to display
120    pack .top.left.menubar.file .top.left.menubar.acts .top.left.menubar.opts \
121         -side left -padx 4
122    
123    makeLogo .top.logo paradynLogo raised 2 HotPink2
124    pack .top.logo -side right
125
126    # Horizontal Scrollbar
127    scrollbar .horizScrollbar -orient horizontal \
128            -background gray -activebackground gray -relief sunken \
129            -command horizScrollbarNewScrollPosition
130    pack .horizScrollbar -side bottom -fill x
131
132    # Vertical Scrollbar:
133    scrollbar .vertScrollbar -orient vertical \
134            -background gray -activebackground gray -relief sunken \
135            -command vertScrollbarNewScrollPosition
136    pack .vertScrollbar -side left -fill y -expand false
137
138    # Body (drawn by C++ code -- metrics, units, foci, cells):
139    frame .body -width 400 -height 220
140    pack  .body -fill both -expand true
141
142    bind .body <Configure> {tableVisiConfigure}
143    bind .body <Expose>    {tableVisiExpose}
144
145    wm minsize . 300 200
146    wm title . "Table Visualization"
147 }
148    
149 #  AddEntry -- Ask paradyn to start a new curve
150 proc AddEntry {} {
151   Dg start "*" "*"
152 }
153
154 #  DelEntry -- Ask paradyn to stop a curve
155 proc DelEntry {} {
156   puts stderr "Delete Entry not yet implemented"
157 }
158
159 #  Called by visi library when histos have folded
160 #    we just update the status line and keep on going
161 #proc DgFoldCallback {} {
162 #  UpdateStatus 
163 #}
164
165 #
166 #  DgPhaseStartCallback -- visi calls this when a phase has started
167 #
168 proc DgPhaseStartCallback {phaseId} {
169    puts stderr "welcome to DgPhaseStartCallback (tcl code)"
170    return
171 }
172
173 #
174 #  DgPhaseEndCallback -- visi calls this when a phase has started
175 #
176 proc DgPhaseEndCallback {phaseId} {
177    puts stderr "welcome to DgPhaseEndCallback (tcl code)"
178    return
179 }
180
181 #
182 #  DgPhaseDataCallback -- visi calls this when a phase has started
183 #
184 proc DgPhaseDataCallback {} {
185    puts stderr "welcome to DgPhaseEndCallback (tcl code)"
186    return
187 }
188
189 #
190 #  Update the status line
191 #
192 proc UpdateStatus {} {
193   global DataFormat W
194   global Callbacks UpdateLimit lastBucket
195
196   set bw [Dg binwidth]
197
198   .status.label configure -text [format "Time: %-10s  Format: %s" [TimeLabel [expr int($bw * $lastBucket)]] $DataFormat]
199 }
200
201 #
202 #  GetValue asks visi library for the data value for the met/res pair 
203 #    we ask visi for the data in the correct DataFormat
204 #
205 #proc GetValue {m r bucket} {
206 #  global DataFormat
207 #  global numMetrics numResources
208 #
209 #   if {![Dg valid $m $r] || ![Dg enabled $m $r]} {
210 #      # there is a hole in valid datagrid entries -- happens all the time
211 #      return ""
212 #   }
213 #
214 #   if {[string match $DataFormat Instantaneous]} {
215 #      return [Dg value $m $r $bucket]
216 #   } elseif {[string match $DataFormat Average]} {
217 #      return [Dg aggregate $m $r]
218 #   } elseif {[string match $DataFormat Sum]} {
219 #      return [Dg sum $m $r]
220 #   } else {
221 #      puts stderr "GetValue: unknown data format: $DataFormat"
222 #      return 0
223 #   }
224 #}
225
226 #
227 # DgValidCallback -- visi calls this when curve becomes valid
228 #
229 #proc DgValidCallback {m} {
230 #  return
231 #  puts stderr "Bucket $m is now valid"
232 #}
233
234 set UpdateCounter 0
235 set UpdateLimit 1
236
237 # TimeToUpdate - returns true (1) iff it is time to redraw
238 #                the status (amount of time) at the bottom of the screen
239 proc TimeToUpdate {} {
240   global UpdateCounter UpdateLimit
241
242   if {$UpdateCounter <= 0} {
243     set UpdateCounter [expr $UpdateLimit / [Dg binwidth]]
244     return 1
245   } else {
246     set UpdateCounter [expr $UpdateCounter - 1]
247     return 0
248   }
249 }
250
251 set Callbacks 0
252
253 #
254 #  DgDataCallback -- visi calls this command when new data is available
255 #    we fill in all of the data labels with the new data values
256 #
257 #proc DgDataCallback {bucket} {
258 #   global Callbacks
259 #
260 #   incr Callbacks
261 #   if {[TimeToUpdate]} {
262 #      DataUpdate $bucket
263 #      UpdateStatus
264 #   }
265 #}
266
267 #
268 #  TimeLabel -- given a time value in seconds, format a nice label
269 #
270 #  note: If called often, this routine should be rewritten in C++.
271 proc TimeLabel {val} {
272   if {($val > 60) && ($val < 3600)} {
273     set min [expr $val / 60]
274     set sec [expr $val - ($min * 60)]
275     return [format "%d m %d s" $min $sec]
276   }
277   if {$val < 60} {
278     return [format "%d s" $val]
279   }
280   if {$val > 3600} {
281     set hr [expr $val / 3600]
282     set left [expr $val - ($hr * 3600)]
283     set min [expr $left / 60]
284     set sec [expr $left - ($min * 60)]
285     return [format "%d h %d m %d s" $hr $min $sec]
286   }
287   return "$val s"
288 }