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