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