Update for tk4.0
[dyninst.git] / visiClients / barchart / tcl / barChart.tcl
1 #
2 #  barChart -- A bar chart display visualization for Paradyn
3 #
4 #  $Log: barChart.tcl,v $
5 #  Revision 1.19  1995/07/06 18:54:59  tamches
6 #  Update for tk4.0
7 #
8 # Revision 1.18  1995/05/10  22:28:24  tamches
9 # Removed warning message in getMetricHints when encountering an
10 # unknown metric...but we still default to min=0 max=1.  This information
11 # should really be kept in the data manger, imho.
12 #
13 # Revision 1.17  1995/04/01  01:34:21  tamches
14 # Metric axis lines now 2 pix wide, not 1.  Metric key items now more
15 # color-coordinated (i.e., now, not just the axis lines are drawn in the
16 # bar's color).
17 #
18 # Revision 1.16  1995/02/26  02:01:45  newhall
19 # added callback functions for new visiLib phase info.
20 #
21 # Revision 1.15  1994/11/11  06:46:34  tamches
22 # more configure event handlers for other subwindows has helped fix
23 # some resize bugs, especially when switching from short to long
24 # names.  Window now does not resize itself when adding new resources
25 # with longer names; pack propagate for the toplevel is off.
26 #
27 # Revision 1.14  1994/11/09  04:44:40  tamches
28 # Deleting multiple metrics at a time is now supported.
29 #
30 # Revision 1.13  1994/11/09  03:26:25  tamches
31 # Clicking in a "neutral" area of the resources axis will now un-select
32 # anything that may have been selected.
33 #
34 # Revision 1.12  1994/11/09  02:25:19  tamches
35 # Re-implemented a feature of old: Long Names.  The option
36 # (which is off by default) is found at the bottom of the options menu.
37 # Fixed a bug whereby resourcesAxisWidth stayed unchanged at "1.4i"
38 # forever.
39 #
40 # Revision 1.11  1994/11/06  10:36:48  tamches
41 # changed title font to 14 point
42 # beefed up validResources(), numValidResources, indirectResources()
43 # throughput the code.
44 # implemented a maximum individual color height of 25 pixels
45 # fixed a major bug when deleted resources (deleted resources were still
46 # being counted when calculating resource heights)
47 # Fixed deletion bug by having myXScroll do the callback to C++ code
48 # that updates bar offsets.
49 #
50 # Revision 1.10  1994/10/28  21:53:44  tamches
51 # Fixed a rather flaming bug that could cause any resource add to
52 # potentially crash after doing a sort (c++ code's numResources
53 # wasn't updated before ::rethinkIndirectResources was called, leading
54 # to an assertion check failure)
55 #
56 # Revision 1.9  1994/10/14  10:28:49  tamches
57 # Swapped the x and y axes -- now resources print vertically and
58 # metrics print horizontally.  Can fit many, many more resources
59 # on screen at once with no label overlap.  Multiple metrics
60 # are now shown in the metrics axis.  Metric names are shown in
61 # a "key" in the lower-left.
62 #
63 # Revision 1.8  1994/10/13  00:51:39  tamches
64 # Fixed deletion of resources.
65 # Implemented sorting of resources.
66 # Reorganized menus to be more standars-ish
67 #
68 # Revision 1.7  1994/10/11  22:04:18  tamches
69 # Fixed bug whereupon a resize while paused would erase the bars
70 # until you continued.  Flickers too much on resize now, however...
71 #
72 # Delete resources should now work
73 #
74 # Revision 1.6  1994/10/10  23:08:41  tamches
75 # preliminary changes on the way to swapping the x and y axes
76 #
77 # Revision 1.5  1994/10/07  22:06:36  tamches
78 # Fixed some bugs w.r.t. resizing the window (bars and resources were
79 # sometimes redrawn at the old locations, instead of adapting to the
80 # resize).  The problem was related to [winfo width ...] returning
81 # the old value while in the middle of a resize event.  The solution
82 # was to include %w and %h in the configure-even callback (see the
83 # tk "bind" command man page)
84 #
85 # Revision 1.4  1994/10/04  22:10:56  tamches
86 # more color fixing (moved codes from barChart.C to here)
87 #
88 # Revision 1.3  1994/10/04  19:00:23  tamches
89 # implemented resourceWidth algorithm: try to make resources the maximum
90 # pixel width, but if they don't all fit in the window, shrink (down
91 # to a fixed minimum).  Reapply algorithm when: window resizes, resources
92 # are added/deleted.
93 #
94 # Revision 1.2  1994/10/01  02:22:25  tamches
95 # Fixed some bugs related to scrolling; now, the user can't accidentally
96 # scroll to the left of the leftmost bar or to the right of the rightmost
97 # bar.
98 #
99 # Revision 1.1  1994/09/29  19:49:50  tamches
100 # rewritten for new version of barchart; the bars are now drawn
101 # with xlib code in C++ (no more blt_barchart) in barChart.C.
102 # See also barChartTcl.C and barChartDriver.C
103 #
104 # Revision 1.5  1994/09/08  00:10:43  tamches
105 # Added preliminary blt_drag&drop interface.
106 # changed window title.
107 #
108 # Revision 1.4  1994/09/04  23:55:29  tamches
109 # added 'to do' and 'problems' lists.  tightened code around speed-critical
110 # areas.  improved look of resources axis.
111 #
112 # Revision 1.3  1994/09/03  01:24:40  tamches
113 # Cleaned up syntax some more, e.g. longer variable names.
114 # Cleaned up menus
115 # Added many comments
116 #
117 # Revision 1.2  1994/09/02  21:00:30  tamches
118 # minor get-acquainted formatting cleanups
119 #
120 # Revision 1.1  1994/08/06  22:50:47  rbi
121 # Bar Chart Visi originally written by Sherri Frizell.
122 # Initial revision includes bug fixes and cleanups by rbi.
123 #
124
125 # ######################################################
126 # TO DO LIST:
127 # 2) multiple metrics: allow deletion
128 # 3) too much flickering on resize
129 # 4) No room for scrollbar unless needed
130 # ######################################################
131
132 #  ################### Default options #################
133
134 option add *Visi*font *-New*Century*Schoolbook-Bold-R-*-14-*
135 option add *Data*font *-Helvetica-*-r-*-12-*
136 option add *MyMenu*font *-New*Century*Schoolbook-Bold-R-*-14-*
137
138 if {[winfo depth .] > 1} {
139    # You have a color monitor...
140 #   . config -bg grey
141    option add *Background grey
142    option add *activeBackground LightGrey
143    option add *activeForeground black
144    option add *Scale.activeForeground grey
145 } else {
146    # You don't have a color monitor...
147    option add *Background white
148    option add *Foreground black
149 }
150
151 # ####################  Overall frame ###########################
152
153 set resourcesAxisWidth 1.4i
154 set metricsAxisHeight 0.65i
155
156 set W .bargrph
157 frame $W -class Visi
158
159 frame $W.top
160 pack $W.top -side top -fill x -expand false -anchor n
161    # this area will encompass the title bar, menu bar, and logo
162    # expand is set to false; if the window is made taller,
163    # we don't want to get any taller.
164
165 frame $W.top.left
166 pack $W.top.left -side left -fill both -expand true
167    # this area encompasses the title bar and menu bar
168    # expand is set to true so that if the window is made
169    # wider, we get the extra space (as opposed to the logo
170    # or as opposed to nobody, which would leave ugly blank
171    # space)
172
173 # #################### Paradyn logo #################
174
175 label $W.top.logo -relief raised \
176                   -bitmap @/p/paradyn/core/paradyn/tcl/logo.xbm \
177                   -foreground #b3331e1b53c7
178
179 pack $W.top.logo -side right -expand false
180    # we set expand to false; if the window is made wider, we
181    # don't want any of the extra space; let the menu bar and
182    # title bar have it.
183
184 # #################### Title bar #################
185
186 label $W.top.left.titlebar  -text "BarChart Visualization" -foreground white -background lightslategray
187 pack $W.top.left.titlebar -side top -fill both -expand true
188    # expand is set to true, not because we want more space if the window
189    # is made taller (which won't happen, since the expand flag of our
190    # parent was set to false), but because we want to take up any padding
191    # space left after we and the menu bar are placed (if the logo is
192    # taller than the two of us, which it currently is)
193
194 # ##################### Menu bar ###################
195
196 set Wmbar $W.top.left.mbar
197 frame $Wmbar -class MyMenu -borderwidth 2 -relief raised
198 pack  $Wmbar -side top -fill both -expand false
199
200 # #################### File menu #################
201
202 menubutton $Wmbar.file -text File -menu $Wmbar.file.m
203 menu $Wmbar.file.m -selectcolor tomato
204 $Wmbar.file.m add command -label "Close Bar chart" -command GracefulClose
205
206 # #################### Actions Menu ###################
207
208 menubutton $Wmbar.actions -text Actions -menu $Wmbar.actions.m
209 menu $Wmbar.actions.m -selectcolor tomato
210 $Wmbar.actions.m add command -label "Add Bars..." -command AddMetricDialog
211 $Wmbar.actions.m add separator
212 $Wmbar.actions.m add command -label "Remove Selected Metric(s)" -state disabled
213 $Wmbar.actions.m add command -label "Remove Selected Resource(s)" -state disabled
214
215 # #################### View menu ###################
216
217 menubutton $Wmbar.view -text View -menu $Wmbar.view.m
218 menu $Wmbar.view.m -selectcolor tomato
219 $Wmbar.view.m add radio -label "Order Resources by Name (ascending)" -variable SortPrefs -command ProcessNewSortPrefs -value ByName
220 $Wmbar.view.m add radio -label "Order Resources by Name (descending)" -variable SortPrefs -command ProcessNewSortPrefs -value ByNameDescending
221 $Wmbar.view.m add radio -label "Order Resources as Inserted by User" -variable SortPrefs -command ProcessNewSortPrefs -value NoParticular
222
223 $Wmbar.view.m add separator
224
225 $Wmbar.view.m add radio -label "Current Values" \
226    -variable DataFormat -command {rethinkDataFormat} \
227    -value Instantaneous
228 $Wmbar.view.m add radio -label "Average Values" \
229    -variable DataFormat -command {rethinkDataFormat} \
230    -value Average
231 $Wmbar.view.m add radio -label "Total Values" \
232    -variable DataFormat -command {rethinkDataFormat} \
233    -value Sum
234
235 $Wmbar.view.m add separator
236
237 $Wmbar.view.m add checkbutton -label "Long Names" -variable LongNames \
238         -command ProcessLongNamesChange
239
240 set LongNames 0
241
242 # #################### Help menu #################
243
244 #menubutton $Wmbar.help -text Help \
245 #          -menu $Wmbar.help.m
246 #menu $Wmbar.help.m 
247 #$Wmbar.help.m add command -label "General" -command "NotImpl" -state disabled
248 #$Wmbar.help.m add command -label "Context" -command "NotImpl" -state disabled
249
250
251 # #################### Build the menu bar and add to display #################
252
253 pack $Wmbar.file $Wmbar.actions $Wmbar.view -side left -padx 4
254 #pack $Wmbar.help -side right
255
256 # #################### Organize all menu buttons into a menubar ##############
257
258 tk_menuBar $Wmbar $Wmbar.file $Wmbar.actions \
259    $Wmbar.view
260
261 # #######################  Scrollbar ######################
262
263 canvas $W.farLeft
264 pack $W.farLeft -side left -expand false -fill y
265    # expand is set to false; if the window is made wider, don't change width
266
267 scrollbar $W.farLeft.resourcesAxisScrollbar -orient vertical -width 16 \
268         -background gray -activebackground gray -relief sunken \
269         -command ".bargrph.left.resourcesAxisCanvas yview"
270
271 pack $W.farLeft.resourcesAxisScrollbar -side top -fill y -expand true
272    # expand is set to true; if the window is made taller, we want
273    # extra height.
274
275 canvas $W.farLeft.sbPadding -height $metricsAxisHeight -width 16 -relief flat
276 pack $W.farLeft.sbPadding -side bottom -expand false -fill x
277    # expand is set to false; if the window is made taller, we don't
278    # want any of the extra height.
279
280 # #####################  Resources Axis #################
281
282 canvas $W.left -width $resourcesAxisWidth
283 pack   $W.left -side left -expand false -fill y
284    # expand is set to false; if the window is made wider, we don't want
285    # any of the extra width
286
287 canvas $W.left.metricsKey -height $metricsAxisHeight -width $resourcesAxisWidth\
288         -relief groove
289 pack   $W.left.metricsKey -side bottom -expand false
290    # expand is set to false; if the window is made taller, we don't
291    # want any of the extra height
292
293 set WresourcesCanvas $W.left.resourcesAxisCanvas
294 canvas $WresourcesCanvas -width $resourcesAxisWidth -relief groove \
295                              -yscrollcommand myYScroll \
296                              -yscrollincrement 1
297 pack   $WresourcesCanvas -side top -expand true -fill y
298    # expand is set to true; if the window is made taller, we want the
299    # extra height.
300
301 # ####################  Metrics Axis Canvas ############################
302
303 canvas $W.metricsAxisCanvas -height $metricsAxisHeight -relief groove
304 pack   $W.metricsAxisCanvas -side bottom -fill x -expand false
305    # expand is set to false; if the window is made wider, we don't want
306    # extra width to go to the metrics axis
307
308 # ####################  Barchart Area ($W.body) #################
309
310 canvas $W.body -height 2.5i -width 3.5i -relief groove
311 pack  $W.body -side top -fill both -expand true
312    # expand is set to true; if the window is made taller, we want the
313    # extra height to go to us
314
315 # ######### pack $W (and all its subwindows) into the main (top-level)
316 # ######### window such that it basically consumes the entire window...
317 pack append . $W {fill expand frame center}
318
319 # set some window manager hints:
320 #wm minsize  . 350 250
321 wm title    . "Barchart"
322
323 proc getWindowWidth {wName} {
324    # warning!  This routine will return an old number if an important
325    # event (i.e. resize) happened but idle routines haven't yet kicked in.
326    # --> *** In such cases, be sure to grab the latest information directly
327    #         from the event structure instead of calling this routine!!!!
328
329    set result [winfo width $wName]
330    if {$result == 1} {
331       # hack for a window that hasn't yet been mapped
332       set result [winfo reqwidth $wName]
333    }
334
335    return $result
336 }
337
338 proc getWindowHeight {wName} {
339    # warning!  This routine will return an old number if an important
340    # event (i.e. resize) happened but idle routines haven't yet kicked in.
341    # --> *** In such cases, be sure to grab the latest information directly
342    #         from the event structure instead of calling this routine!!!!
343
344    set result [winfo height $wName]
345    if {$result == 1} {
346       # hack for a window that hasn't yet been mapped
347       set result [winfo reqheight $wName]
348    }
349
350    return $result
351 }
352
353 # isMetricValid -- true iff at least one metric/focus pair for this metric
354 #                  is a enabled (not deleted).  Pass a true (not sorted)
355 #                  metric index.
356 # Given: updated numResources
357 # Does:  returns number of enabled (non-deleted?) metrics
358 proc isMetricValid {mindex} {
359    global numResources
360
361    for {set resourcelcv 0} {$resourcelcv<$numResources} {incr resourcelcv} {
362       if {[Dg enabled $mindex $resourcelcv]} {
363          return 1
364       }
365    }
366
367    # false
368    return 0
369 }
370
371 # isResourceValid -- true iff at least one metric/focus pair for this
372 #                    resource is enabled.  Pass a true resource index, not
373 #                    a sorted one
374 # Given: updated numMetrics
375 # Does:  returns number of enabled (non-deleted?) resources
376 proc isResourceValid {rindex} {
377    global numMetrics
378
379    for {set metriclcv 0} {$metriclcv<$numMetrics} {incr metriclcv} {
380       if {[Dg enabled $metriclcv $rindex]} {
381          return 1
382       }
383    }
384
385    # false
386    return 0
387 }
388
389 # ################ Initialization and LaunchBarChart ######################
390 proc Initialize {} {
391    # a subset of DgConfigCallback that sets important global vrbles
392    # stuff that needs to be in order **BEFORE** the call to launchBarChart
393    # (i.e. launchBarChart depends on these settings)
394
395    # puts stderr "Welcome to Initialize!"
396    # flush stderr
397
398    global W
399
400    global numMetrics numMetricsDrawn
401    global numMetricLabelsDrawn
402    global metricNames
403    global validMetrics
404
405    global metricUnits
406    global metricMinValues metricMaxValues
407
408    global metricsLabelFont resourceNameFont
409    global prevLeftSectionWidth
410
411    global numResources
412    global numValidResources validResources
413    global indirectResources
414    global resourceNames
415
416    global currResourceHeight
417    global minResourceHeight maxResourceHeight maxIndividualColorHeight minIndividualColorHeight
418
419    global DataFormat
420
421    global numLabelsDrawn numResourcesDrawn
422
423    global SortPrefs
424    global barColors numBarColors
425
426    set SortPrefs NoParticular
427    
428    set numLabelsDrawn 0
429    set numResourcesDrawn 0
430
431    set DataFormat Instantaneous
432
433    # keep both of the following lines up here:
434    set numMetrics [Dg nummetrics]
435    set numResources [Dg numresources]
436
437    set numMetricsDrawn 0
438    set numMetricLabelsDrawn 0
439
440    for {set metriclcv 0} {$metriclcv < $numMetrics} {incr metriclcv} {
441       set metricNames($metriclcv) [Dg metricname  $metriclcv]
442       set validMetrics($metriclcv) [isMetricValid $metriclcv]
443       set metricUnits($metriclcv) [Dg metricunits $metriclcv]
444       set metricMinValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 1]
445       set metricMaxValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 2]
446    }
447
448    set numValidResources 0
449    for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
450       set validResources($resourcelcv) [isResourceValid $resourcelcv]
451       if {$validResources($resourcelcv)} {
452          set indirectResources($numValidResources) $resourcelcv
453          incr numValidResources
454       }
455
456       set resourceNames($resourcelcv) [Dg resourcename $resourcelcv]
457    }
458
459    set minResourceHeight 20
460    set maxResourceHeight 50
461    set maxIndividualColorHeight 25
462    set minIndividualColorHeight 0
463    set currResourceHeight $maxResourceHeight
464       # as resources are added, we try to shrink the resource height down to a minimum of
465       # (minResourceHeight) rather than having to invoke the scrollbar.
466    set prevLeftSectionWidth 1
467
468    # bar colors: (see /usr/lib/X11/rgb.txt)
469    # purple is reserved for the where axis.
470    # red should not be next to green; they look equal to colorblind
471    # use greyscales if b&w monitor
472 #   set barColors(0) "tomato"
473    set barColors(0) "cornflower blue"
474    set barColors(1) "medium sea green"
475    set barColors(2) "hotpink"
476    set barColors(3) "chocolate"
477    set barColors(4) "orange"
478    set numBarColors 5
479
480   set resourceNameFont *-Helvetica-*-r-*-12-*
481   set metricsLabelFont *-Helvetica-*-r-*-12-*
482 #   set resourceNameFont "7x13bold"
483 #   set metricsLabelFont "7x13bold"
484
485
486    # launch our C++ barchart code
487    # launchBarChart $W.body.barCanvas doublebuffer noflicker $numMetrics $numResources 0
488    launchBarChart $W.body doublebuffer noflicker $numMetrics $numResources 0
489
490    # trap window resize and window expose events --- for the subwindow
491    # containing the bars only, however.  Note that using
492    # $W.body instead of "." avoids LOTS of unneeded
493    # configuration callbacks.  In particular, when a window is just
494    # moved, it won't create a callback (yea!)  This means we
495    # can treat a configuration event as a true resize.
496
497    # [sec 19.2: 'event patterns' in tk/tcl manual]
498
499    bind $W.body <Configure> {bodyConfigureEventHandler %w %h}
500    bind $W.left.resourcesAxisCanvas <Configure> {resourcesAxisConfigureEventHandler %w %h}
501    bind $W.metricsAxisCanvas <Configure> {metricsAxisConfigureEventHandler %w %h}
502    bind $W.left.metricsKey <Configure> {metricsKeyConfigureEventHandler %w %h}
503    bind $W.body <Expose>    {myExposeEventHandler}
504 }
505
506 # selectResource -- assuming this resource was clicked on, select it
507 proc selectResource {widgetName} {
508    global Wmbar
509
510    set theRelief [lindex [$widgetName configure -relief] 4]
511    if {$theRelief!="groove"} {
512       # Hmmm.. this guy was already selected.  Let's unselect him! (not implemented since
513       # we would have to possibly update the menu too and there's no easy way to do that
514       # without checking whether there exist any still-selected resources)
515
516       #$widgetName configure -relief flat
517       return
518    }
519
520    $widgetName configure -relief sunken
521
522    # update delete resource menu item
523    $Wmbar.actions.m entryconfigure 4 -state normal \
524            -command {delSelectedResources}
525 }
526
527 # processEnterResource -- routine to handle entry of mouse in a resource name
528 proc processEnterResource {widgetName} {
529    # if this widget has already been clicked on, do nothing (leave it sunken)
530    set theRelief [lindex [$widgetName configure -relief] 4]
531    if {$theRelief=="sunken"} return
532
533    $widgetName configure -relief groove
534 }
535
536 # processExitResource -- routine to handle mouse leaving resource name area
537 #                        we may or may not have done a mouse-click in the meantime
538 proc processExitResource {widgetName} {
539    # If we had clicked on this guy, then do nothing (keep selected), else undo the -relief groove
540    set theRelief [lindex [$widgetName configure -relief] 4]
541    if {$theRelief=="groove"} {
542       $widgetName configure -relief flat
543    }
544 }
545
546 proc clickNeutralResourceArea {} {
547    global Wmbar WresourcesCanvas
548    global numResources numResourcesDrawn resourceNames
549    global numValidResources indirectResources
550
551    # unselect whatever was selected
552    for {set resourcelcv 0} {$resourcelcv < $numResourcesDrawn} {incr resourcelcv} {
553       set widgetName $WresourcesCanvas.message$resourcelcv
554
555       $widgetName configure -relief flat
556    }
557
558    # update delete resource menu item
559    $Wmbar.actions.m entryconfigure 4 -state disabled \
560            -command {puts stderr "ignoring unexpected deletion"}
561 }
562
563 proc rethinkResourceHeights {screenHeight} {
564    # When resources are added or deleted, or a resize occurs,
565    # this routine is called.  Its sole purpose is to rethink the value
566    # of currResourceHeight, depending on the resources and window height.
567
568    # algorithm: current window height is passed as a parameter.  Set
569    # resource height equal to window height / num **valid** resources (don't
570    # want to include deleted ones!).  If that would make the resource
571    # height too small, make it minResourceHeight.
572    global minResourceHeight maxResourceHeight
573    global currResourceHeight
574    global numResources numValidResources
575    global validResources
576    global WresourcesCanvas
577
578    if {$numValidResources==0} {
579       set tentativeResourceHeight 0
580    } else {
581       set tentativeResourceHeight [expr $screenHeight / $numValidResources]
582       if {$tentativeResourceHeight < $minResourceHeight} {
583          set tentativeResourceHeight $minResourceHeight
584       } elseif {$tentativeResourceHeight > $maxResourceHeight} {
585          set tentativeResourceHeight $maxResourceHeight
586       }
587    }
588
589    set currResourceHeight $tentativeResourceHeight
590
591 #   puts stderr "Leaving rethinkResourceHeights(tcl); we have decided upon $currResourceHeight (max is $maxResourceHeight)"
592 }
593
594 # Upon changes to the resources axis or the metrics key, call this routine to
595 # rethink how wide the left portion of the screen (which is what holds these
596 # guys) should be.
597 proc rethinkLeftSectionWidth {} {
598    global W
599    global WresourcesCanvas
600    global prevLeftSectionWidth
601    global numResourcesDrawn numMetricsDrawn
602
603    set maxWidthSoFar 20
604    set tickWidth 5
605
606    # loop through the resources on screen in sorted order
607    for {set rindex 0} {$rindex < $numResourcesDrawn} {incr rindex} {
608       set thisLabelWidth [getWindowWidth $WresourcesCanvas.message$rindex]
609       if {$thisLabelWidth > $maxWidthSoFar} {
610          set maxWidthSoFar $thisLabelWidth
611       }
612    }
613
614    # loop through the metrics key on screen in sorted order
615    for {set mindex 0} {$mindex < $numMetricsDrawn} {incr mindex} {
616       set thisLabelWidth [getWindowWidth $W.left.metricsKey.key$mindex]
617       if {$thisLabelWidth > $maxWidthSoFar} {
618          set maxWidthSoFar $thisLabelWidth
619       }
620    }
621
622    if {$maxWidthSoFar != $prevLeftSectionWidth} {
623       # resize the resourcse axis to consume just the right amount of width
624       # we use the "pack propagate" command to avoid resizing the entire window
625       # syntax: "pack progagate master flag"
626 #      pack propagate . false
627          set newWidth [expr 2 + $maxWidthSoFar + $tickWidth + 2]
628          $WresourcesCanvas configure -width $newWidth -relief groove
629          pack $WresourcesCanvas -side top -expand true -fill y
630             # expand is set to true; if the window is made taller, we want the
631             # extra height.
632          $W.left.metricsKey configure -width $newWidth
633 #      pack propagate . true
634    }
635
636    set prevLeftSectionWidth $maxWidthSoFar
637 }
638
639 # how it works: deletes canvas items with the tag "resourcesAxisItemTag",
640 # including window items.  message widgets have to be deleted separately,
641 # notwithstanding that canvas window items were deleted already.
642 # (it knows how many message widgets there are via numResourcesDrawn, which
643 # at the time this routine is called, may not be up-to-date with respect to
644 # numResources), and then redraws by re-recreating the canvas items and
645 # message widgets
646 proc drawResourcesAxis {windowHeight} {
647    global W
648    global Wmbar
649    global WresourcesCanvas
650
651    global resourceNameFont
652    global resourcesAxisWidth
653    global metricsAxisHeight
654
655    global numResources numValidResources
656    global validResources
657    global numResourcesDrawn
658    global resourceNames
659    global indirectResources
660
661    global minResourceHeight maxResourceHeight currResourceHeight
662
663    global SortPrefs
664
665    set resourcesAxisWidth [getWindowWidth $WresourcesCanvas]
666 #   puts stderr "Welcome to drawResourcesAxis; width=$resourcesAxisWidth"
667
668    # delete leftover stuff (canvas widgets in 1 step, then message widgets manually)
669    $WresourcesCanvas delete resourcesAxisItemTag
670    for {set rindex 0} {$rindex < $numResourcesDrawn} {incr rindex} {
671       destroy $WresourcesCanvas.message$rindex
672    }
673
674    set tickWidth 5
675    set right [expr [getWindowWidth $WresourcesCanvas] - 3]
676    set top 3
677    set bottom 3
678    set numResourcesDrawn 0
679
680    # loop through resources in sorted order
681    for {set rindex 0} {$rindex < $numValidResources} {incr rindex} {
682       set actualResource $indirectResources($rindex)
683       if {!$validResources($actualResource)} {
684          puts stderr "drawResourcesAxis -- detected an invalid resource"
685          return
686       }
687
688       set bottom [expr $top + $currResourceHeight - 1]
689       set middle [expr ($top + $bottom) / 2]
690    
691       # create a tick line for this resource
692       $WresourcesCanvas create line [expr $right-$tickWidth] $middle $right \
693               $middle -tag resourcesAxisItemTag
694    
695       # create a message widget, bind some commands to it, and attach it to
696       # the canvas via "create window"
697
698       set theName $resourceNames($actualResource)
699    
700       label $WresourcesCanvas.message$numResourcesDrawn -text $theName \
701               -font $resourceNameFont
702
703       bind $WresourcesCanvas.message$numResourcesDrawn <Enter> \
704               {processEnterResource %W}
705       bind $WresourcesCanvas.message$numResourcesDrawn <Leave> \
706               {processExitResource %W}
707       bind $WresourcesCanvas.message$numResourcesDrawn <ButtonPress> \
708               {selectResource %W}
709
710       $WresourcesCanvas create window [expr $right-$tickWidth] $middle \
711               -anchor e -tag resourcesAxisItemTag \
712               -window $WresourcesCanvas.message$numResourcesDrawn
713
714       set top [expr $top + $currResourceHeight]
715       incr numResourcesDrawn    
716    }
717
718    bind $WresourcesCanvas <ButtonPress> "clickNeutralResourceArea"
719
720    # the axis itself--a horizontal line
721    $WresourcesCanvas create line $right 0 $right $top -tag resourcesAxisItemTag
722
723    # rethink width of resources axis and metrics key.
724    # May forcibly resize the width of those windows as it sees fit.
725    rethinkLeftSectionWidth
726
727    # Update the scrollbar's scrollregion configuration:
728    set regionList {0 0 0 0}
729    set regionList [lreplace $regionList 2 2 $resourcesAxisWidth]
730 #   set regionList [lreplace $regionList 3 3 $bottom]
731    set regionList [lreplace $regionList 3 3 $top]
732    $WresourcesCanvas configure -scrollregion $regionList
733
734    set oldconfig [$W.farLeft.resourcesAxisScrollbar get]
735    set oldFirst [lindex $oldconfig 0]
736    set oldLast  [lindex $oldconfig 1]
737
738    $W.farLeft.resourcesAxisScrollbar set $oldFirst $oldLast
739 }
740
741 # ProcessNewMetricMax {metricid newMaxVal}
742 # Called from barChart.C when y-axis overflow is detected
743 proc processNewMetricMax {mindex newmaxval} {
744    global metricMinValues metricMaxValues
745    global W
746
747    set metricMaxValues($mindex) $newmaxval
748
749    drawMetricsAxis [getWindowWidth $W.metricsAxisCanvas]
750 }
751
752 # drawMetricsAxis windwidth
753 # The metrics axis changes to reflect the new width (in pixels).
754 #
755 # Call if the window is resized and/or metrics are changed.
756 #
757 # Algorithm: delete leftover canvas items
758 proc drawMetricsAxis {metricsAxisWidth} {
759    global W
760    global numMetrics numMetricsDrawn numMetricLabelsDrawn
761
762    global metricNames validMetrics
763
764    global metricUnits metricUnitTypes
765    global metricMinValues metricMaxValues
766    global metricsLabelFont
767
768    set keyWindow $W.left.metricsKey
769
770    $W.metricsAxisCanvas delete metricsAxisTag
771    $keyWindow delete metricsAxisTag
772
773    for {set labelindex 0} {$labelindex < $numMetricLabelsDrawn} {incr labelindex} {
774       destroy $W.metricsAxisCanvas.label$labelindex
775    }
776    for {set metriclcv 0} {$metriclcv < $numMetricsDrawn} {incr metriclcv} {
777       destroy $keyWindow.key$metriclcv
778    }
779
780    set numticks 3
781    set fixedLeft 5
782    set fixedRight [expr $metricsAxisWidth - 5]
783    set top 5
784    set tickHeight 5
785    set tickStepPix [expr ($fixedRight - $fixedLeft + 1) / ($numticks-1)]
786
787    set labelDrawnCount 0
788    set numMetricsDrawn 0
789
790    for {set metriclcv 0} {$metriclcv<$numMetrics} {incr metriclcv} {
791       if {!$validMetrics($metriclcv)} continue
792
793       set numericalStep [expr (1.0 * $metricMaxValues($metriclcv)-$metricMinValues($metriclcv)) / ($numticks-1)]
794
795       # draw horiz line for this metric; color-coded for the metric
796       $W.metricsAxisCanvas create line $fixedLeft $top $fixedRight $top \
797                  -tag metricsAxisTag \
798                  -fill [getMetricColor $metriclcv] \
799                  -width 2
800
801       # draw tick marks and create labels for this metric axis
802       for {set ticklcv 0} {$ticklcv < $numticks} {incr ticklcv} {
803          set tickx [expr $fixedLeft + ($ticklcv * $tickStepPix)]
804          $W.metricsAxisCanvas create line $tickx $top $tickx \
805                     [expr $top + $tickHeight] \
806                     -tag metricsAxisTag -fill [getMetricColor $metriclcv] \
807                     -width 2
808
809          set labelText [expr $metricMinValues($metriclcv) + $ticklcv * $numericalStep]
810
811          if {$ticklcv==0} {
812             set theAnchor nw
813             set theJust left
814          } elseif {$ticklcv==[expr $numticks-1]} {
815             set theAnchor ne
816             set theJust center
817          } else {
818             set theAnchor n
819             set theJust right
820          }
821
822          # msg widgets instead of labels help us get the justification right
823          # (I'm not convinced anymore that we couldn't do this somehow with labels)
824          message $W.metricsAxisCanvas.label$labelDrawnCount -text $labelText \
825                     -justify $theJust -font $metricsLabelFont \
826                     -width [getWindowWidth $W.metricsAxisCanvas]
827          $W.metricsAxisCanvas create window $tickx [expr $top+$tickHeight] \
828                     -anchor $theAnchor -tag metricsAxisItemTag \
829                     -window $W.metricsAxisCanvas.label$labelDrawnCount
830
831          incr labelDrawnCount
832       }
833
834       # Draw "key" entry
835       $keyWindow create line 5 $top [expr [getWindowWidth $keyWindow] - 5] \
836               $top -tag metricsAxisTag -fill [getMetricColor $metriclcv] \
837               -width 2
838       set theText $metricNames($metriclcv)
839       label $keyWindow.key$numMetricsDrawn -text $theText \
840               -font $metricsLabelFont \
841               -foreground [getMetricColor $metriclcv]
842       $keyWindow create window [expr [getWindowWidth $keyWindow] - 5] \
843               [expr $top + $tickHeight] -tag metricsAxisTag \
844               -window $keyWindow.key$numMetricsDrawn -anchor ne
845
846       # prepare for next metric down.  WARNING: "30" is a hack!
847       set top [expr $top + $tickHeight + 30]
848       incr numMetricsDrawn
849    }
850
851    set numMetricLabelsDrawn $labelDrawnCount
852
853    if {$numMetricLabelsDrawn==0} {
854       set newMetricsAxisHeight 5
855    } else {
856       set newMetricsAxisHeight $top
857    }
858
859    # This may forcibly resize key and resources axis:
860    rethinkLeftSectionWidth
861
862    # Want metrics axis to consume right amount of height.
863    $W.metricsAxisCanvas configure -height $newMetricsAxisHeight
864    pack $W.metricsAxisCanvas -side bottom -fill x -expand false
865
866    $W.farLeft.sbPadding configure -height $newMetricsAxisHeight
867    $W.left.metricsKey   configure -height $newMetricsAxisHeight
868 }
869
870 proc getMetricColor {mindex} {
871    global barColors numBarColors
872
873    set theindex [expr $mindex % $numBarColors]
874    return $barColors($theindex)
875 }
876
877 proc bodyConfigureEventHandler {newWidth newHeight} {
878    # the following routines will clear the bar window (ouch! But no
879    # choice since window size change can greatly affect bar layout --- well,
880    # sometimes) so resizeCallback has built-in hacks to simulate one
881    # new-data callback
882
883    resourcesAxisHasChanged $newHeight
884
885    resizeCallback $newWidth $newHeight
886
887    # the following is only needed once (the first time this routine
888    # is executed)
889    pack propagate . false
890 }
891
892 proc resourcesAxisConfigureEventHandler {newWidth newHeight} {
893    global W
894    # rethink how tall the resources should be
895    rethinkResourceHeights $newHeight
896
897    # only needed if the height has changed:
898    drawResourcesAxis $newHeight
899
900    # inform our C++ code
901    resourcesAxisHasChanged $newHeight
902 }
903
904 proc metricsAxisConfigureEventHandler {newWidth newHeight} {
905    global W
906
907    drawMetricsAxis $newWidth
908    metricsAxisHasChanged $newWidth
909 }
910
911 proc metricsKeyConfigureEventHandler {newWidth newHeight} {
912    global W
913
914    drawMetricsAxis [getWindowWidth $W.metricsAxisCanvas]
915 }
916
917 # myExposeEventHandler -- handle an expose in the bar sub-window
918 #    (no need to handle exposes in the other windows because they're
919 #     made of tcl widgets which redraw themselves)
920 proc myExposeEventHandler {} {
921    # all tk widgets redraw automatically (though not 'till the next idle)
922
923    # all that's left to do is inform our C++ code of the expose
924    exposeCallback
925 }
926
927 #proc addResource {rName} {
928 #   global numResources
929 #   global resourceNames
930 #   global W
931 #
932 #   # first, make sure this resource doesn't already exist
933 #   for {set rindex 0} {$rindex < $numResources} {incr rindex} {
934 #      if {$validResources($rindex) && $resourceNames($rindex) == $rName} {
935 #         puts stderr "detected a duplicate resource: $rname (ignoring addition request)"
936 #         return
937 #      } 
938 #   }
939 #
940 #   set resourceNames($numResources) $rName
941 #   set validResources($numResources) [isResourceValid $numResources]
942 #   incr numResources
943 #
944 #   drawResourcesAxis [getWindowWidth $W.left.resourcesAxisCanvas]
945 #}
946
947 # del1SelectedResources
948 # Given: a true (not sorted) resource number
949 # Does: deletes that resource from our internal structures (validResources(),
950 #       numValidResources), calls [Dg stop] on all its met/res combos.
951 # Does not: redraw anything; update the resources axis, etc.
952 proc del1SelectedResource {rindex} {
953    global numResources resourceNames numValidResources validResources
954    global numMetrics
955
956    if {!$validResources($rindex)} {
957       puts stderr "del1SelectedResource: resource #$rindex is invalid (already deleted?)"
958       return
959    }
960
961    # Inform that visi lib that we don't want anything more from this resource
962    for {set mindex 0} {$mindex < $numMetrics} {incr mindex} {
963       if {[Dg enabled $mindex $rindex]} {
964          Dg stop $mindex $rindex
965       }
966    }
967
968    # If the [Dg stop...] worked, then this resource is should now be invalid.
969    if {[isResourceValid $rindex]} {
970       puts stderr "delResource -- valid flag wasn't changed to false after the deletion"
971       return
972    }
973
974    set validResources($rindex) 0
975    set numValidResources [expr $numValidResources - 1]
976
977    if {$numValidResources<0} {
978       puts stderr "del1SelectedResource warning: numValidResources now $numValidResources!"
979       return
980    }
981
982 }
983
984 # delSelectedResources
985 # Given: some resources with -configure relief groove
986 # Does: calls del1SelectedResource on those resources, updates menus,
987 #       updates sorting order, redraws resources, redraws bars
988 proc delSelectedResources {} {
989    global numValidResources validResources indirectResources
990    global numResources resourceNames
991    global Wmbar WresourcesCanvas W
992    global numResourcesDrawn
993
994    # Loop through all visible resources
995    for {set resourcelcv 0} {$resourcelcv < $numResourcesDrawn} {incr resourcelcv} {
996       set widgetName $WresourcesCanvas.message$resourcelcv
997
998       # If this widget has -relief sunken, then it has been selected
999       set theRelief [lindex [$widgetName configure -relief] 4]
1000       if {$theRelief!="sunken"} continue
1001
1002       set actualResource $indirectResources($resourcelcv)
1003       del1SelectedResource $actualResource
1004    }
1005
1006    $Wmbar.actions.m entryconfigure 4 -state disabled \
1007            -command {puts stderr "ignoring unexpected deletion..."}
1008
1009    # Rethink sorting order, and inform our C++ code to do the same
1010    # Does no redrawing whatsoever
1011    rethinkIndirectResources true
1012
1013    # rethink height of each resource (does no redrawing whatsoever; does not
1014    # inform our C++ code of the change)
1015    rethinkResourceHeights [getWindowHeight $W.body]
1016
1017    # This may forcibly change the width of the resources axis and metrics key:
1018    rethinkLeftSectionWidth
1019
1020    # Redraw resources:
1021    drawResourcesAxis      [getWindowHeight $W.body]
1022
1023    # Redraw body:
1024    bodyConfigureEventHandler [getWindowWidth $W.body] [getWindowHeight $W.body]
1025 }
1026
1027 proc getMetricHints {theMetric} {
1028    # #pragma HACK begin
1029    # return metric unit type, hinted min, hinted max, hinted step
1030    # depending on the metric (a hardcoded temporary hack.  This information
1031    # should be [but isn't currently] present in the data manager)
1032    switch $theMetric {
1033       "exec_time"        {return {percentage 0.0 1.0 0.1}}
1034       "hybrid_cost"      {return {real 0.0 1.0 0.1}}
1035       "procedure_calls"  {return {integer 0 1000 100}}
1036       "predicted_cost"   {return {real 0.0 1.0 .1}}
1037       "msgs"             {return {integer 0 10 10}}
1038       "msg_bytes"        {return {integer 0 100 100}}
1039       "pause_time"       {return {percentage 0.0 1.0 .1}}
1040       "msg_bytes_sent"   {return {integer 0 100 100}}
1041       "msg_bytes_recv"   {return {integer 0 100 100}}
1042       "active_processes" {return {integer 0 1 1}}
1043       "sync_ops"         {return {real 0.0 5 1}}
1044       "observed_cost"    {return {real 0.0 1.0 0.1}}
1045       "sync_wait"        {return {integer 0.0 5 1}}
1046       "active_slots"     {return {integer 0.0 2 1}}
1047       "cpu"              {return {real 0.0 1.0 0.1}}
1048    }
1049
1050 #   puts stderr "getMetricHints--unexpected metric: $theMetric...continuing"
1051    return {real 0.0 1.0 0.1}
1052    # #pragma HACK done
1053 }
1054
1055 #proc addMetric {theName theUnits} {
1056 #   global numMetrics
1057 #   global metricNames
1058 #   global validMetrics
1059 #
1060 #   global metricUnits
1061 #   global metricUnitTypes
1062 #   global metricMinValues
1063 #   global metricMaxValues
1064 #   global W
1065 #
1066 #   puts stderr "Welcome to addMetric; name is $theName; units are $theUnits"
1067 #
1068 #   # first make sure that this metric isn't already present (if so, do nothing)
1069 #   for {set metricIndex 0} {$metricIndex < $numMetrics} {incr metricIndex} {
1070 #      if {$metricNames($metricIndex) == $theName && $validMetrics($metricIndex)} {
1071 #         puts stderr "addMetric: ignoring request to add $theName (already present)"
1072 #         return
1073 #      }
1074 #   }
1075 #
1076 #   # make the addition
1077 #   set metricNames($numMetrics) $theName
1078 #   set metricUnits($numMetrics) $theUnits
1079 #
1080 #   set theHints [getMetricHints $theName]
1081 #
1082 #   set metricUnitTypes($numMetrics) [lindex $theHints 0]
1083 #   set metricMinValues($numMetrics) [lindex $theHints 1]
1084 #   set metricMaxValues($numMetrics) [lindex $theHints 2]
1085 #
1086 #   incr numMetrics
1087 #
1088 #   drawResourcesAxis [getWindowHeight $W.left.resourcesAxisCanvas]
1089 #   drawMetricsAxis [getWindowWidth $W.metricsAxisCanvas]
1090 #}
1091
1092 proc delMetric {delIndex} {
1093    global numMetrics
1094    global metricNames
1095    global metricUnits
1096    global W
1097
1098    # first, make sure this metric index is valid
1099    if {$delIndex < 0 || $delIndex >= $numMetrics} {
1100       puts stderr "delMetric: ignoring out of bounds index: $delIndex"
1101       return
1102    }
1103
1104    # shift
1105    for {set mindex $delIndex} {$mindex < [expr $numMetrics-1]} {incr mindex} {
1106       set metricNames($mindex) $metricNames([expr $mindex + 1])
1107       set metricUnits($mindex) $metricUnits([expr $mindex + 1])
1108    }
1109
1110    set numMetrics [expr $numMetrics - 1]
1111    
1112    drawResourcesAxis [getWindowHeight $W.left.resourcesAxisCanvas]
1113    drawMetricsAxis [getWindowWidth $W.metricsAxisCanvas]
1114
1115    # don't we need to tell paradyn to stop sending us data on
1116    # this metric?
1117 }
1118
1119 # myYScroll -- the -scrollcommand config of the resources axis canvas.
1120 #          Gets called whenever the canvas view changes or gets resized.
1121 #          This includes every scroll the user makes (yikes!)
1122 #          Gives us an opportunity to rethink the bounds of the scrollbar.
1123 #          We get passed: total size, window size, left, right
1124 proc myYScroll {first last} {
1125    global W WresourcesCanvas
1126
1127    $W.farLeft.resourcesAxisScrollbar set $first $last
1128
1129    # call our C++ code to update the bar offsets
1130    set totalCanvasHeight [lindex [$WresourcesCanvas cget -scrollregion] 3]
1131 #   puts stderr "myYscroll: totalCanvasHeight is $totalCanvasHeight"
1132
1133    set newFirstFrac [lindex [$W.farLeft.resourcesAxisScrollbar get] 0]
1134 #   puts stderr "myYscroll: newFirstFrac is $newFirstFrac"
1135
1136    set firstPix [expr round($totalCanvasHeight * $newFirstFrac)]
1137 #   puts stderr "myYscroll: so, first pixel is $firstPix" 
1138
1139    newScrollPosition $firstPix
1140 }
1141
1142 # ############################################################################
1143 # ############# blt_drag&drop: declare that we are willing and able ##########
1144 # ######### to receive drag n' drops of type "text" (the type may change) ####
1145 # ############################################################################
1146
1147 proc dragAndDropTargetHandler {} {
1148    # according to the drag n' drop interface, this routine will be
1149    # called via a "send" command from the source.  So don't expect
1150    # to see this routine called from elsewhere in this file...
1151
1152    # the variable DragDrop(text) contains what should be added
1153    global DragDrop
1154
1155    # not yet implemented...
1156    return
1157
1158    puts stderr "Welcome to dragAndDropTargetHandler(); DragDrop(text) is $DragDrop(text)"
1159    addResource $DragDrop(text)
1160 }
1161
1162 # blt_drag&drop target . handler text dragAndDropTargetHandler
1163 #...that cryptic line reads: "declare the window '.' to be a drag n' drop
1164 #   handler for sources of type 'text'; routine dragAndDropTargetHandler
1165 #   gets called (via a "send" from the source...)  Using window '.' means
1166 #   the entire barchart...
1167
1168 # #################### Called by visi library when histos have folded #########
1169
1170 proc DgFoldCallback {} {
1171 #   puts stderr "FOLD detected..."
1172 }
1173
1174 # ########### Called by visi library when metric/resource space changes.
1175 #
1176 # note: this routine is too generic; in the future, we plan to
1177 # implement callbacks that actually tell what was added (as opposed
1178 # to what was already there...)
1179 #
1180 # ######################################################################
1181
1182 proc DgConfigCallback {} {
1183    # puts stderr "Welcome to DgConfigCallback"
1184    # flush stderr
1185
1186    global W
1187
1188    global numMetrics metricNames
1189    global validMetrics
1190    global metricUnits
1191    global metricMinValues metricMaxValues
1192
1193    global numResources numValidResources resourceNames
1194    global validResources
1195    global numResourcesDrawn
1196    global indirectResources
1197    global LongNames
1198
1199    set numMetrics [Dg nummetrics]
1200    # the next line must remain up here or else calls to isMetricValid will be wrong!
1201    set numResources [Dg numresources]
1202
1203    for {set metriclcv 0} {$metriclcv < $numMetrics} {incr metriclcv} {
1204       set metricNames($metriclcv) [Dg metricname  $metriclcv]
1205       set metricUnits($metriclcv) [Dg metricunits $metriclcv]
1206       set validMetrics($metriclcv) [isMetricValid $metriclcv]
1207
1208       # note -- the following 2 lines are very dubious for already-existing
1209       #         resources (i.e. we should try to stick with the initial
1210       #         values)
1211       set metricMinValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 1]
1212       set metricMaxValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 2]
1213    }
1214
1215    set numValidResources 0
1216    for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
1217       if {$LongNames==1} {
1218          set resourceNames($resourcelcv) [Dg resourcename $resourcelcv]
1219       } else {
1220          set resourceNames($resourcelcv) [file tail [Dg resourcename $resourcelcv]]
1221       }
1222
1223       if {[isResourceValid $resourcelcv]} {
1224          set validResources($resourcelcv) 1
1225          incr numValidResources
1226       } else {
1227          set validResources($resourcelcv) 0
1228       }
1229    }
1230
1231    # rethink the sorting order (false --> don't do callback to c++ code
1232    # because it would crash since C++ code doesn't update its value of
1233    # numMetrics and numResources until a 'resourcesAxisHasChanged' or
1234    # 'metricsAxisHasChanged'.  When those do indeed get called below, they
1235    # also update the sorting order, so we're OK.)
1236    rethinkIndirectResources false
1237
1238    # rethink the layout of the axes
1239    rethinkResourceHeights [getWindowHeight $W.left.resourcesAxisCanvas]
1240    drawResourcesAxis [getWindowHeight $W.left.resourcesAxisCanvas]
1241    drawMetricsAxis [getWindowWidth $W.metricsAxisCanvas]
1242
1243    # inform our C++ code that stuff has changed (nummetrics, numresources
1244    # gets updated, structures are recalculated based on new #metrics,
1245    # #resources, etc.)
1246    resourcesAxisHasChanged [getWindowHeight $W.left.resourcesAxisCanvas]
1247    metricsAxisHasChanged   [getWindowWidth $W.metricsAxisCanvas]
1248 }
1249 # ###########  Callback invoked on a PHASESTART event from paradyn  ########
1250 proc DgPhaseCallback {} {
1251   return
1252 }
1253
1254 # ###########  AddMetricDialog -- Ask paradyn for another metric ########
1255
1256 proc AddMetricDialog {} {
1257    Dg start "*" "*"
1258 }
1259
1260 # #########  AddResourceDialog -- Ask paradyn for another resource #######
1261
1262 proc AddResourceDialog {} {
1263    Dg start "*" "*"
1264 }
1265
1266 # A menu item was chosen to change the sorting options
1267 proc ProcessNewSortPrefs {} {
1268    global SortPrefs
1269    global W
1270
1271    # change the order...
1272    rethinkIndirectResources true
1273
1274    # redraw the resources axis
1275    drawResourcesAxis [getWindowHeight $W.left.resourcesAxisCanvas]
1276
1277    # redraw the bars (callback to our C++ code)
1278    resourcesAxisHasChanged [getWindowHeight $W.left.resourcesAxisCanvas]
1279 }
1280
1281 proc sortCmd {x y} {
1282    set str1 [string toupper [lindex $x 1]]
1283    set str2 [string toupper [lindex $y 1]]
1284
1285    return [string compare $str1 $str2]
1286 }
1287
1288 # Given: a change in sorted order and/or deleted/added resources
1289 # Does: rethinks indirectResources(), and (if docallback==true)
1290 #       informs our C++ code of the change in sorting order.
1291 proc rethinkIndirectResources {docallback} {
1292    # sorting order has changed; rethink indirectResources array
1293    global SortPrefs
1294
1295    global numResources numValidResources
1296    global validResources
1297    global resourceNames
1298    global indirectResources
1299
1300    # sorting works as follows: create a temporary list of {index,name} pairs;
1301    # sort the list; extract the indexes in sequence; delete temporary list
1302    set templist {}
1303
1304    # Note that we exclude invalid resources
1305    for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
1306       if {$validResources($resourcelcv)} {
1307          lappend templist [list $resourcelcv $resourceNames($resourcelcv)]
1308       }
1309    }
1310
1311    if {$SortPrefs == "ByName"} {
1312       set templist [lsort -ascii -increasing -command sortCmd $templist]
1313    } elseif {$SortPrefs == "ByNameDescending"} {
1314       set templist [lsort -ascii -decreasing -command sortCmd $templist]
1315    }
1316
1317    # puts stderr "rethinkIndirectResources: sorted templist is $templist"
1318
1319    # Now go through in sorted order:
1320    for {set resourcelcv 0} {$resourcelcv < $numValidResources} {incr resourcelcv} {
1321       set actualResource [lindex [lindex $templist $resourcelcv] 0]
1322       if {$actualResource<0 || $actualResource>=$numResources} {
1323          puts stderr "rethinkIndirectResources -- actualResource=$actualResource (valid range is (0,$numResources)"
1324          return
1325       }
1326       if {!$validResources($actualResource)} {
1327          puts stderr "rethinkIndirectResources -- invalid resource detected"
1328          return
1329       }
1330
1331       set indirectResources($resourcelcv) $actualResource
1332    }
1333
1334 #   puts stderr "rethinkIndirectResources: leaving with indirectResources="
1335 #   for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
1336 #      puts stderr $indirectResources($resourcelcv)
1337 #   }
1338
1339    if {$docallback} {
1340       # inform our C++ code of the changes...
1341       rethinkIndirectResourcesCallback
1342    }
1343 }
1344
1345 proc rethinkDataFormat {} {
1346    # invoked when a menu item from among "current, average, total"
1347    # is selected
1348    global W
1349    global DataFormat
1350    global numMetrics
1351    global metricMinValues
1352    global metricMaxValues
1353    global metricNames
1354
1355    # reset metrics-axis min & max values
1356    for {set metriclcv 0} {$metriclcv < $numMetrics} {incr metriclcv} {
1357       set metricMinValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 1]
1358       set metricMaxValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 2]
1359    }
1360
1361    # inform our C++ code that the data format has changed
1362    dataFormatHasChanged
1363
1364    # redraw the metrics axis
1365    drawMetricsAxis [getWindowWidth $W.metricsAxisCanvas]
1366 }
1367
1368 proc ProcessLongNamesChange {} {
1369    global LongNames W numResources resourceNames
1370
1371    # side effect: any selected resources will become un-selected
1372
1373    # rethink resource names and redraw the resources axis --- that's all that is needed
1374    for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
1375       if {$LongNames==1} {
1376          set resourceNames($resourcelcv) [Dg resourcename $resourcelcv]
1377       } else {
1378          set resourceNames($resourcelcv) [file tail [Dg resourcename $resourcelcv]]
1379       }
1380    }
1381
1382    drawResourcesAxis [getWindowHeight $W.metricsAxisCanvas]
1383 }
1384
1385 proc GracefulClose {} {
1386    # quit barchart
1387
1388    # release installed commands
1389    rename launchBarChart ""
1390
1391    # the above command will render the callback routines harmless
1392    # by virtue of setting barChartIsValid to false
1393    # So, we can delete them at our leisure now...
1394    
1395    rename rethinkIndirectResourcesCallback ""
1396    rename dataFormatHasChanged ""
1397    rename newScrollPosition ""
1398    rename metricsAxisHasChanged ""
1399    rename resourcesAxisHasChanged ""
1400    rename exposeCallback ""
1401    rename resizeCallback ""
1402
1403    exit
1404 }
1405
1406 # #########################################################################
1407 #                           "Main Program"
1408 # #########################################################################
1409
1410 Initialize