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