visiClients/barchart/tcl/barChart.tcl

   1 #
   2 #  barChart -- A bar chart display visualization for Paradyn
   3 #
   4 #  $Log: barChart.tcl,v $
   5 #  Revision 1.6  1994/10/10 23:08:41  tamches
   6 #  preliminary changes on the way to swapping the x and y axes
   7 #
   8 # Revision 1.5  1994/10/07  22:06:36  tamches
   9 # Fixed some bugs w.r.t. resizing the window (bars and resources were
  10 # sometimes redrawn at the old locations, instead of adapting to the
  11 # resize).  The problem was related to [winfo width ...] returning
  12 # the old value while in the middle of a resize event.  The solution
  13 # was to include %w and %h in the configure-even callback (see the
  14 # tk "bind" command man page)
  15 #
  16 # Revision 1.4  1994/10/04  22:10:56  tamches
  17 # more color fixing (moved codes from barChart.C to here)
  18 #
  19 # Revision 1.3  1994/10/04  19:00:23  tamches
  20 # implemented resourceWidth algorithm: try to make resources the maximum
  21 # pixel width, but if they don't all fit in the window, shrink (down
  22 # to a fixed minimum).  Reapply algorithm when: window resizes, resources
  23 # are added/deleted.
  24 #
  25 # Revision 1.2  1994/10/01  02:22:25  tamches
  26 # Fixed some bugs related to scrolling; now, the user can't accidentally
  27 # scroll to the left of the leftmost bar or to the right of the rightmost
  28 # bar.
  29 #
  30 # Revision 1.1  1994/09/29  19:49:50  tamches
  31 # rewritten for new version of barchart; the bars are now drawn
  32 # with xlib code in C++ (no more blt_barchart) in barChart.C.
  33 # See also barChartTcl.C and barChartDriver.C
  34 #
  35 # Revision 1.5  1994/09/08  00:10:43  tamches
  36 # Added preliminary blt_drag&drop interface.
  37 # changed window title.
  38 #
  39 # Revision 1.4  1994/09/04  23:55:29  tamches
  40 # added 'to do' and 'problems' lists.  tightened code around speed-critical
  41 # areas.  improved look of resources axis.
  42 #
  43 # Revision 1.3  1994/09/03  01:24:40  tamches
  44 # Cleaned up syntax some more, e.g. longer variable names.
  45 # Cleaned up menus
  46 # Added many comments
  47 #
  48 # Revision 1.2  1994/09/02  21:00:30  tamches
  49 # minor get-acquainted formatting cleanups
  50 #
  51 # Revision 1.1  1994/08/06  22:50:47  rbi
  52 # Bar Chart Visi originally written by Sherri Frizell.
  53 # Initial revision includes bug fixes and cleanups by rbi.
  54 #
  55
  56 # ######################################################
  57 # TO DO LIST:
  58 # 1) draw numerical values on the bars (menu option) (default=on?)
  59 # 2) resources: make deletion work
  60 # 3) staggered x-axis names
  61 # 4) multiple metrics: put a "key" on screen
  62 # 5) multiple metrics: make them show on y axis
  63 # 6) multiple metrics: allow deletion
  64 # 7) option to sort resources (will be difficult--would need to map resourceid
  65 #    as given by visi to our new ordering)
  66 # ######################################################
  67
  68 #  ################### Default options #################
  69
  70 option add *Visi*font *-New*Century*Schoolbook-Bold-R-*-18-*
  71 option add *Data*font *-Helvetica-*-r-*-12-*
  72 option add *MyMenu*font *-New*Century*Schoolbook-Bold-R-*-14-*
  73
  74 if {[string match [tk colormodel .] color] == 1} {
  75    # You have a color monitor...
  76    # change primary background color from 'bisque' to 'grey'
  77    . config -bg grey
  78    option add *Background grey
  79    option add *activeBackground LightGrey
  80    option add *activeForeground black
  81    option add *Scale.activeForeground grey
  82 } else {
  83    # You don't have a color monitor...
  84    option add *Background white
  85    option add *Foreground black
  86 }
  87
  88 # ####################  Overall frame ###########################
  89
  90 set metricsAxisWidth 0.75i
  91 set resourcesAxisHeight 0.65i
  92
  93 set W .bargrph
  94 frame $W -class Visi
  95
  96 frame $W.top
  97 pack $W.top -side top -fill x -expand false -anchor n
  98    # this area will encompass the title bar, menu bar, and logo
  99    # expand is set to false; if the window is made taller,
 100    # we don't want to get any taller.
 101
 102 frame $W.top.left
 103 pack $W.top.left -side left -fill both -expand true
 104    # this area encompasses the title bar and menu bar
 105    # expand is set to true so that if the window is made
 106    # wider, we get the extra space (as opposed to the logo
 107    # or as opposed to nobody, which would leave ugly blank
 108    # space)
 109
 110 # #################### Paradyn logo #################
 111
 112 label $W.top.logo -relief raised \
 113                   -bitmap @/p/paradyn/core/paradyn/tcl/logo.xbm \
 114                   -foreground #b3331e1b53c7
 115
 116 pack $W.top.logo -side right -expand false
 117    # we set expand to false; if the window is made wider, we
 118    # don't want any of the extra space; let the menu bar and
 119    # title bar have it.
 120
 121 # #################### Title bar #################
 122
 123 label $W.top.left.titlebar  -text "BarChart Visualization" -foreground white -background lightslategray
 124 pack $W.top.left.titlebar -side top -fill both -expand true
 125    # expand is set to true, not because we want more space if the window
 126    # is made taller (which won't happen, since the expand flag of our
 127    # parent was set to false), but because we want to take up any padding
 128    # space left after we and the menu bar are placed (if the logo is
 129    # taller than the two of us, which it currently is)
 130
 131 # ##################### Menu bar ###################
 132
 133 set Wmbar $W.top.left.mbar
 134 frame $Wmbar -class MyMenu -borderwidth 2 -relief raised
 135 pack  $Wmbar -side top -fill both -expand false
 136
 137 # #################### File menu #################
 138
 139 menubutton $Wmbar.file -text File -menu $Wmbar.file.m
 140 menu $Wmbar.file.m
 141 $Wmbar.file.m add command -label "Close Bar chart" -command exit
 142
 143 # #################### Metrics menu ###################
 144
 145 menubutton $Wmbar.metrics -text Metrics -menu $Wmbar.metrics.m
 146 menu $Wmbar.metrics.m
 147 $Wmbar.metrics.m add command -label "Add Metric..." -command AddMetricDialog
 148 $Wmbar.metrics.m add command -label "Remove Selected Metric" -state disabled
 149
 150 # #################### Resources menu #################
 151
 152 menubutton $Wmbar.resources -text Resources -menu $Wmbar.resources.m
 153 menu $Wmbar.resources.m
 154 $Wmbar.resources.m add command -label "Add Resource..." -command AddResourceDialog
 155 $Wmbar.resources.m add command -label "Remove Selected Resource" -state disabled
 156 $Wmbar.resources.m add separator
 157 $Wmbar.resources.m add radio -label "Order by Name (ascending)" -variable SortPrefs -command ProcessNewSortPrefs -value ByName -state disabled
 158 $Wmbar.resources.m add radio -label "Order by Name (descending)" -variable SortPrefs -command ProcessNewSortPrefs -value ByNameDescending -state disabled
 159 $Wmbar.resources.m add radio -label "Order as Inserted by User" -variable SortPrefs -command ProcessNewSortPrefs -value NoParticular -state disabled
 160
 161 # #################### Display menu #################
 162
 163 menubutton $Wmbar.opts -text "Display" -menu $Wmbar.opts.m
 164 menu $Wmbar.opts.m
 165 $Wmbar.opts.m add radio -label "Current Value" \
 166    -variable DataFormat -command {rethinkDataFormat} \
 167    -value Instantaneous
 168 $Wmbar.opts.m add radio -label "Average Value" \
 169    -variable DataFormat -command {rethinkDataFormat} \
 170    -value Average
 171 $Wmbar.opts.m add radio -label "Total Value" \
 172    -variable DataFormat -command {rethinkDataFormat} \
 173    -value Sum
 174
 175 # #################### Help menu #################
 176
 177 menubutton $Wmbar.help -text Help \
 178           -menu $Wmbar.help.m
 179 menu $Wmbar.help.m
 180 $Wmbar.help.m add command -label "General" -command "NotImpl" -state disabled
 181 $Wmbar.help.m add command -label "Context" -command "NotImpl" -state disabled
 182
 183
 184 # #################### Build the menu bar and add to display #################
 185
 186 pack $Wmbar.file $Wmbar.metrics \
 187      $Wmbar.resources $Wmbar.opts \
 188      -side left -padx 4
 189 pack $Wmbar.help -side right
 190
 191 # #################### Organize all menu buttons into a menubar #################
 192
 193 tk_menuBar $Wmbar $Wmbar.file $Wmbar.metrics \
 194    $Wmbar.resources $Wmbar.opts $Wmbar.help
 195
 196 # ####################  Barchart Title ("Metric: xxxxxxxx") #################
 197
 198 label $W.titleLabel -text "(no barchart currently loaded)" \
 199                     -font "-adobe-helvetica-bold-o-*-*-*-*-*-*-*-*-iso8859-1"
 200 pack  $W.titleLabel -side top -fill x -expand false
 201    # expand is set to false; if the window is made taller, we don't want
 202    # any of the extra space to go to the title (we want it to go to the
 203    # bar graph main area in the middle)
 204
 205
 206 # ####################  Barchart Resources Axis Title ("Resource(s)") ###############
 207
 208 label $W.resourcesAxisTitle -text "Resource(s)" \
 209                     -font "-adobe-helvetica-bold-o-*-*-*-*-*-*-*-*-iso8859-1"
 210 pack  $W.resourcesAxisTitle -side bottom -fill x -expand false
 211    # expand is set to false; if the window is made taller, we don't want
 212    # extra height to go to us.
 213
 214 # ###############  A sub-window to hold x-axis scrollbar & some padding ##########
 215
 216 canvas $W.sbRegion -height 16
 217    # on configure events, must update the -scrollregion
 218 pack $W.sbRegion -side bottom -expand false -fill x
 219    # expand is set to false; if the window is made taller, we don't want
 220    # any of the extra height; let the middle section have it.
 221
 222 canvas $W.sbRegion.padding -width $metricsAxisWidth -height 16
 223 pack $W.sbRegion.padding -side left -expand false
 224    # expand is set to false; if the window is made wider, we don't
 225    # want any of the extra width.
 226
 227 scrollbar $W.sbRegion.resourcesAxisScrollbar -orient horizontal -width 16 -foreground gray \
 228                             -activeforeground gray -relief sunken \
 229                             -command processNewScrollPosition
 230 pack $W.sbRegion.resourcesAxisScrollbar -side right -fill x -expand true
 231    # expand is set to true; if the window is made wider, we want
 232    # extra width.
 233
 234 # #############  A sub-window to hold x-axis canvas & some padding #########
 235
 236 canvas $W.bottom -height $resourcesAxisHeight
 237 pack   $W.bottom -side bottom -expand false -fill x
 238    # expand is set to false; if the window is made taller, we don't want
 239    # any of the extra height; let the middle section have it.
 240
 241 canvas $W.bottom.padding -width $metricsAxisWidth -height $resourcesAxisHeight
 242 pack   $W.bottom.padding -side left -expand false
 243    # expand is set to false; if the window is made wider, we don't
 244    # want any of the extra width.
 245    # We are the blank space at (0,0); we exist to keep the X and Y
 246    # axis from getting any of this area, which would be difficult to manage.
 247
 248 set WresourcesCanvas $W.bottom.resourcesAxisCanvas
 249 canvas $WresourcesCanvas -height $resourcesAxisHeight -relief groove \
 250                              -xscrollcommand myXScroll \
 251                              -scrollincrement 1
 252 pack   $WresourcesCanvas -side right -expand true -fill x
 253    # expand is set to true; if the window is made wider, we want
 254    # extra width.
 255
 256 # ####################  Y Axis Canvas ##################################
 257
 258 canvas $W.metricsAxisCanvas -width $metricsAxisWidth
 259 pack   $W.metricsAxisCanvas -side left -fill y -expand false
 260    # expand is set to false; if the window is made wider, we don't want
 261    # extra width to go to the y axis
 262
 263 # ####################  Barchart Area ($W.body) #################
 264
 265 canvas $W.body -height 3i -width 2.5i -relief groove
 266 #frame $W.body -height 3i -width 2.5i -relief groove
 267 pack  $W.body -side top -fill both -expand true
 268    # expand is set to true; if the window is made taller, we want the
 269    # extra height to go to us (and our slave window $W.body.barCanvas)
 270
 271 # ####################  Bar Canvas ##############################
 272
 273 #frame  $W.body.barCanvas -relief groove -background red
 274 #pack   $W.body.barCanvas -side top -fill both -expand true
 275
 276 #canvas $W.body.barCanvas -relief groove
 277 #pack   $W.body.barCanvas -side top -fill both -expand true
 278
 279 # ######### pack $W (and all its subwindows) into the main (top-level) window such that
 280 # ######### it basically consumes the entire window...
 281 pack append . $W {fill expand frame center}
 282
 283 # set some window manager hints:
 284 wm minsize  . 350 250
 285 wm title    . "Barchart"
 286
 287 proc getWindowWidth {wName} {
 288    # warning!  This routine will return an old number if an important
 289    # event (i.e. resize) happened but idle routines haven't yet kicked in.
 290    # --> *** In such cases, be sure to grab the latest information directly
 291    #         from the event structure instead of calling this routine!!!!
 292
 293    set result [winfo width $wName]
 294    if {$result == 1} {
 295       # hack for a window that hasn't yet been mapped
 296       set result [winfo reqwidth $wName]
 297    }
 298
 299    return $result
 300 }
 301
 302 proc getWindowHeight {wName} {
 303    # warning!  This routine will return an old number if an important
 304    # event (i.e. resize) happened but idle routines haven't yet kicked in.
 305    # --> *** In such cases, be sure to grab the latest information directly
 306    #         from the event structure instead of calling this routine!!!!
 307
 308    set result [winfo height $wName]
 309    if {$result == 1} {
 310       # hack for a window that hasn't yet been mapped
 311       set result [winfo reqwidth $wName]
 312    }
 313
 314    return $result
 315 }
 316
 317 # ################ Initialization and LaunchBarChart ######################
 318 proc Initialize {} {
 319    # a subset of DgConfigCallback that sets important global vrbles
 320    # stuff that needs to be in order **BEFORE** the call to launchBarChart
 321    # (i.e. launchBarChart depends on these settings)
 322
 323    # puts stderr "Welcome to Initialize!"
 324    # flush stderr
 325
 326    global W
 327    global numMetrics
 328    global metricNames
 329    global metricUnits
 330    global metricMinValues
 331    global metricMaxValues
 332
 333    global numResources
 334    global resourceNames
 335
 336    global currResourceWidth
 337    global minResourceWidth
 338    global maxResourceWidth
 339
 340    global DataFormat
 341
 342    global clickedOnResource
 343    global clickedOnResourceText
 344    global numLabelsDrawn
 345    global numResourcesDrawn
 346
 347    global SortPrefs
 348    global barColors
 349    global numBarColors
 350
 351    set SortPrefs NoParticular
 352
 353    set clickedOnResource ""
 354    set clickedOnResourceText ""
 355    set numLabelsDrawn 0
 356    set numResourcesDrawn 0
 357
 358    set DataFormat Instantaneous
 359    set numMetrics [Dg nummetrics]
 360
 361    for {set metriclcv 0} {$metriclcv < $numMetrics} {incr metriclcv} {
 362       set metricNames($metriclcv) [Dg metricname  $metriclcv]
 363       set metricUnits($metriclcv) [Dg metricunits $metriclcv]
 364       set metricMinValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 1]
 365       set metricMaxValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 2]
 366    }
 367
 368    set numResources [Dg numresources]
 369    for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
 370       set resourceNames($resourcelcv) [Dg resourcename $resourcelcv]
 371    }
 372
 373    set minResourceWidth 45
 374    set maxResourceWidth 90
 375    set currResourceWidth $maxResourceWidth
 376       # as resources are added, we try to shrink the resource width down to a minimum of
 377       # (minResourceWidth) rather than having to invoke the scrollbar.
 378       # The question then becomes, if the window is made wider, should we
 379       # tend "resourceWidth" back toward "maxResourceWidth", if it had been shrunk
 380       # toward "minResourceWidth"?  Or once a resource is shrunk, should it never
 381       # be enlarged?
 382
 383    # bar colors: (see /usr/lib/X11/rgb.txt)
 384    # purple is reserved for the where axis.
 385    # red should not be next to green; they look equal to colorblind
 386    # use greyscales if b&w monitor
 387 #   set barColors(0) "tomato"
 388    set barColors(0) "cornflower blue"
 389    set barColors(1) "medium sea green"
 390    set barColors(2) "hotpink"
 391    set barColors(3) "chocolate"
 392    set barColors(4) "orange"
 393    set numBarColors 5
 394
 395    # launch our C++ barchart code
 396    # launchBarChart $W.body.barCanvas doublebuffer noflicker $numMetrics $numResources 0
 397    launchBarChart $W.body doublebuffer noflicker $numMetrics $numResources 0
 398
 399    # trap window resize and window expose events --- for the subwindow
 400    # containing the bars only, however.  Note that using
 401    # $W.body instead of "." avoids LOTS of unneeded
 402    # configuration callbacks.  In particular, when a window is just
 403    # moved, it won't create a callback (yea!)  This means we
 404    # can treat a configuration event as a true resize.
 405
 406    # [sec 19.2: 'event patterns' in tk/tcl manual]
 407
 408    bind $W.body <Configure> {myConfigureEventHandler %w %h}
 409    bind $W.body <Expose>    {myExposeEventHandler}
 410 }
 411
 412 # ############################################################################
 413 # ####################### important procedures ###############################
 414 # ############################################################################
 415 #
 416 # LOW-LEVEL PROCEDURES:
 417 # processEnterResource - given a widget name, let the user know that clicking
 418 #                        on it will enable the "delete" item under the resource
 419 #                        menu. Called when the mouse enters the widget.
 420 # processClickResource - Bound to buttonpress in resource widgets; just
 421 #                        calls selectResource
 422 # processExitResource - Bound to when the mouse leaves a resource message widget.
 423 #                       depending on whether the user clicked, we do something
 424 #                       appropriate user-interface-speaking.
 425 #
 426 # drawResourcesAxis - Completely rethinks the layout of the resource axis and its
 427 #             scrollbar, and redraws them.  Call at the beginning of the program,
 428 #             after the window is resized, and when resources (or metrics) are added
 429 #             or deleted.
 430 #
 431 # drawMetricsAxis - analagous to drawResourcesAxis...
 432 #
 433 # drawTitle - rethinks and redraws the chart title (just below the menubar).
 434 #             Call at the beginning of the program and when metrics are
 435 #             added or deleted (since they comprise the title)
 436 #
 437 # myConfigureEventHandler - called whenever the window configuration has changed
 438 #
 439 # HIGH-LEVEL PROCEDURES:
 440 # selectResource - given a widget name, select it and enable the "delete resource"
 441 #                  menu item.
 442 # unSelectResource - un-select the widget and disable the "delete resource" menu item.
 443 # addResource - given a new resource name, adds it (calling drawResourcesAxis, etc.
 444 #               automatically).
 445 #
 446 # delResource - given an index (0 thru numResources-1), deletes it (calling
 447 #               drawResourcesAxis, etc. automatically)
 448 #
 449 # addMetric - given a new metric name (and its units), adds it (calling drawResourcesAxis,
 450 #             drawMetricsAxis, drawTitle, etc. automatically)
 451 #
 452 # delMetric - analagous to delResource...
 453 #
 454 # ############################################################################
 455
 456 proc selectResource {widgetName} {
 457    global clickedOnResource
 458    global clickedOnResourceText
 459    global Wmbar
 460
 461    # if someone else was previous selected, un-select him
 462    if {$clickedOnResource != ""} {
 463       unSelectResource $clickedOnResource
 464    }
 465
 466    # select
 467    set clickedOnResource $widgetName
 468    set clickedOnResourceText [lindex [$widgetName configure -text] 4]
 469    $widgetName configure -relief sunken
 470    $Wmbar.resources.m entryconfigure 1 -state normal \
 471            -label "Remove \"$clickedOnResourceText\"" \
 472            -command {delResourceByName $clickedOnResourceText}
 473 }
 474
 475 proc unSelectResource {widgetName} {
 476    global clickedOnResource
 477    global clickedOnResourceText
 478    global Wmbar
 479
 480    set clickedOnResource ""
 481    set clickedOnResourceText ""
 482    $widgetName configure -relief flat
 483    $Wmbar.resources.m entryconfigure 1 -state disabled \
 484            -label "Remove Selected Resource" \
 485            -command {puts "ignoring unexpected deletion..."}
 486 }
 487
 488 proc processEnterResource {widgetName} {
 489    global clickedOnResource
 490    global clickedOnResourceText
 491
 492    # if this widget has already been clicked on, do nothing
 493    if {$widgetName == $clickedOnResource} {
 494       return
 495    }
 496
 497    $widgetName configure -relief groove
 498 }
 499
 500 proc processClickResource {widgetName} {
 501    selectResource $widgetName
 502 }
 503
 504 proc processExitResource {widgetName} {
 505    global clickedOnResource
 506    global clickedOnResourceText
 507
 508    # if we clicked on this guy, then do nothing (keep him selected),
 509    # otherwise undo the -relief groove
 510    if {$clickedOnResource != $widgetName} {
 511       $widgetName configure -relief flat
 512    }
 513 }
 514
 515 proc rethinkResourceWidths {screenWidth} {
 516    # When resources are added or deleted, this routine is called.
 517    # Its sole purpose is to rethink the value of currResourceWidth,
 518    # depending on the resources.
 519
 520    # algorithm: get current window width.  set resource width equal
 521    # to window width / num resources.  If that would make the resource
 522    # width too small, make the resource width currResourceWidth
 523    global minResourceWidth
 524    global maxResourceWidth
 525    global currResourceWidth
 526    global numResources
 527    global WresourcesCanvas
 528
 529    set tentativeResourceWidth [expr $screenWidth / $numResources]
 530    if {$tentativeResourceWidth < $minResourceWidth} {
 531       set tentativeResourceWidth $minResourceWidth
 532    } elseif {$tentativeResourceWidth > $maxResourceWidth} {
 533       set tentativeResourceWidth $maxResourceWidth
 534    }
 535
 536    set currResourceWidth $tentativeResourceWidth
 537
 538    # puts stderr "Leaving rethinkResourceWidths; we have decided upon $currResourceWidth"
 539 }
 540
 541 proc drawResourcesAxis {resourcesAxisWidth} {
 542    # how it works: deletes all canvas items with the tag "resourcesAxisItemTag", including
 543    # the window items.  message widgets have to be deleted separately, notwithstanding
 544    # the fact that the canvas window items were deleted already.
 545    # (it knows how many message widgets there are via numResourcesDrawn, which at the
 546    # time this routine is called, may not be up-to-date with respect to numResources),
 547    # and then redraws by re-recreating the canvas items and message widgets
 548
 549    global W
 550    global Wmbar
 551    global WresourcesCanvas
 552
 553    global resourcesAxisHeight
 554    global metricsAxisWidth
 555
 556    global numResources
 557    global numResourcesDrawn
 558    global resourceNames
 559    global clickedOnResource
 560    global clickedOnResourceText
 561
 562    global minResourceWidth
 563    global maxResourceWidth
 564    global currResourceWidth
 565
 566    global SortPrefs
 567
 568    # puts stderr "Welcome to drawResourcesAxis"
 569    # flush stderr
 570
 571    set top 3
 572    set tickHeight 5
 573    set resourceNameFont -adobe-courier-medium-r-normal-*-12-120-*-*-*-*-iso8859-1
 574
 575    # ###### delete leftover stuff
 576    $WresourcesCanvas delete resourcesAxisItemTag
 577    for {set rindex 0} {$rindex < $numResourcesDrawn} {incr rindex} {
 578       destroy $WresourcesCanvas.message$rindex
 579    }
 580
 581    # next, several tick marks extending down a few pixels from the resources axis (one per resource),
 582    # plus (while we're at it) the text of the given resources (centered at their respective
 583    # tick marks)
 584
 585    # yet to implement: STAGGERED TEXT
 586    #         needed  : a way to detect when two message widgets have collided.
 587    #                   doesn't sound too difficult... (use winfo -geometry for each widget)
 588
 589    set right 0
 590    for {set rindex 0} {$rindex < $numResources} {incr rindex} {
 591       set left [expr $rindex * $currResourceWidth]
 592       set right [expr $left + $currResourceWidth - 1]
 593       set middle [expr ($left + $right) / 2]
 594
 595       # create a tick line
 596       $WresourcesCanvas create line $middle $top $middle [expr $top+$tickHeight-1] -tag resourcesAxisItemTag
 597
 598       # create a message widget, bind some commands to it, and attach it to the
 599       # canvas via "create window"
 600
 601       set theText $resourceNames($rindex)
 602
 603       message $WresourcesCanvas.message$rindex -text $theText \
 604                                            -justify center -width $currResourceWidth \
 605                                            -font $resourceNameFont
 606       bind $WresourcesCanvas.message$rindex <Enter> \
 607                           {processEnterResource %W}
 608       bind $WresourcesCanvas.message$rindex <Leave> \
 609                           {processExitResource %W}
 610       bind $WresourcesCanvas.message$rindex <ButtonPress> \
 611                           {processClickResource %W}
 612       $WresourcesCanvas create window $middle [expr $top+$tickHeight] \
 613                                          -anchor n -tag resourcesAxisItemTag \
 614                                          -window $WresourcesCanvas.message$rindex
 615    }
 616
 617    # the axis itself--a horizontal line
 618    $WresourcesCanvas create line 0 $top $right $top -tag resourcesAxisItemTag
 619
 620    # Update the scrollbar's scrollregion configuration:
 621    set regionList {0 0 0 0}
 622    set regionList [lreplace $regionList 2 2 $right]
 623    set regionList [lreplace $regionList 3 3 $resourcesAxisHeight]
 624    $WresourcesCanvas configure -scrollregion $regionList
 625
 626    set screenWidth $resourcesAxisWidth
 627
 628    set oldconfig [$W.sbRegion.resourcesAxisScrollbar get]
 629    set oldTotalWidth [lindex $oldconfig 0]
 630
 631    if {$oldTotalWidth != $right} {
 632       # puts stderr "drawResourcesAxis: detected major change in resources ($oldTotalWidth != $right), resetting"
 633       set firstUnit 0
 634    } else {
 635       # no change
 636       set firstUnit [lindex $oldconfig 2]
 637    }
 638
 639    set lastUnit [expr $firstUnit + $screenWidth - 1]
 640    # puts stderr "setting sb: $right $screenWidth $firstUnit $lastUnit"
 641    $W.sbRegion.resourcesAxisScrollbar set $right $screenWidth $firstUnit $lastUnit
 642
 643    # set the maximum width of the window to be $right + $metricsAxisWidth
 644    # wm maxsize . [expr $right + inches2pixels($metricsAxisWidth)] [unlimited-y-size]
 645
 646    set numResourcesDrawn $numResources
 647 }
 648
 649 proc processNewMetricMax {mindex newmaxval} {
 650    # called from barChart.C when y-axis overflow is detected and
 651    # a new max value is chosen
 652    global metricMinValues
 653    global metricMaxValues
 654    global W
 655
 656    set metricMaxValues($mindex) $newmaxval
 657
 658    drawMetricsAxis [getWindowHeight $W.metricsAxisCanvas]
 659 }
 660
 661 proc drawMetricsAxis {metricsAxisHeight} {
 662    # the y axis changes to reflect the units of the current metric(s).
 663    # It is not necessary to call drawMetricsAxis if the window width is
 664    # resized; it IS necessary to call drawMetricsAxis if the window
 665    # height is changed.
 666    # It is not necessary to call drawMetricsAxis if resources are
 667    # added or removed; it IS necessary to call drawMetricsAxis if
 668    # metrics are added or removed.
 669
 670    global W
 671    global numMetrics
 672    global numLabelsDrawn
 673    global metricNames
 674    global metricUnits
 675    global metricUnitTypes
 676    global metricMinValues
 677    global metricMaxValues
 678
 679    # puts stderr "welcome to drawMetricsAxis"
 680
 681    # first, delete all leftover canvas items (those with a metricsAxis tag to them)
 682    $W.metricsAxisCanvas delete metricsAxisTag
 683
 684    # we still have to delete the label widgets, which can't have tags...
 685    set numlabels 3
 686    for {set labelindex 0} {$labelindex < $numLabelsDrawn} {incr labelindex} {
 687       destroy $W.metricsAxisCanvas.label$labelindex
 688    }
 689
 690    # canvas item: the axis itself (a vertical line)
 691    set winHeight $metricsAxisHeight
 692    set winWidth [getWindowWidth $W.metricsAxisCanvas]
 693
 694    set tickWidth 5
 695    set left 5
 696    set right [expr $winWidth - 5]
 697    set tickLeft [expr $right-$tickWidth+1]
 698    set top   5
 699    set bottom [expr $winHeight - 5]
 700    set labelRight [expr $tickLeft]
 701    set labelWidth [expr $labelRight - $left + 1]
 702    set height [expr $bottom - $top + 1]
 703    set tickStep [expr ($height-1) / ($numlabels-1)]
 704
 705    set numericalStep [expr (1.0 * $metricMaxValues(0)-$metricMinValues(0)) / ($numlabels-1)]
 706
 707    # puts stderr "drawMetricsAxis: numericalStep is $numericalStep; metric-min is $metricMinValues(0); metric-max is $metricMaxValues(0)"
 708    # flush stderr
 709
 710    $W.metricsAxisCanvas create line $right $top $right $bottom -tag metricsAxisTag
 711
 712    set labelFont -adobe-courier-medium-r-normal-*-12-120-*-*-*-*-iso8859-1
 713    # draw tick marks, and while we're at it, their associated message widgets
 714    for {set labelindex 0} {$labelindex < $numlabels} {incr labelindex} {
 715       set currY [expr $bottom - round($labelindex*$tickStep)]
 716
 717       $W.metricsAxisCanvas create line $tickLeft $currY $right $currY -tag metricsAxisTag
 718
 719       set labelText [expr $metricMinValues(0) + $labelindex*$numericalStep]
 720       message $W.metricsAxisCanvas.label$labelindex -text $labelText \
 721               -justify right -width $labelWidth \
 722               -font $labelFont
 723
 724       $W.metricsAxisCanvas create window $labelRight $currY -anchor e \
 725                         -tag metricsAxisItemTag \
 726                         -window $W.metricsAxisCanvas.label$labelindex
 727    }
 728
 729    set numLabelsDrawn $numlabels
 730 }
 731
 732 proc drawTitle {} {
 733    # the title changes to reflect the current metric(s)
 734    # currently, only a single metric is supported
 735
 736    global W
 737    global numMetrics
 738    global metricNames
 739    global metricUnits
 740
 741    if {$numMetrics == 0} {
 742       set newTitle "(no metrics currently defined)"
 743    } else {
 744       set newTitle "Metric: $metricNames(0) (Units: $metricUnits(0))"
 745    }
 746
 747    $W.titleLabel configure -text $newTitle
 748 }
 749
 750 proc myConfigureEventHandler {newWidth newHeight} {
 751    #puts stderr "Welcome to myConfigureEventHandler; newWidth=$newWidth; newHeight=$newHeight"
 752    #flush stderr
 753
 754    # rethink how wide the resources should be
 755    rethinkResourceWidths $newWidth
 756
 757    # Call drawResourcesAxis to rethink the scrollbar and to rethink the resource widths
 758    drawResourcesAxis $newWidth
 759
 760    # We only need to redraw the y axis if the window height has changed
 761    # (and at the beginning of the program)
 762    drawMetricsAxis $newHeight
 763
 764    # Redraw the title (only needed if metrics changed)
 765    drawTitle
 766
 767    # if the resources axis has changed then call this: (barChart.C)
 768    resourcesAxisHasChanged $newWidth
 769
 770    # if the y axis has changed then call this: (barChart.C)
 771    metricsAxisHasChanged $newHeight
 772
 773    # inform our C++ code (barChart.C) that a resize has taken place
 774    resizeCallback $newWidth $newHeight
 775 }
 776
 777 proc myExposeEventHandler {} {
 778    # puts stderr "barChart.tcl -- welcome to myExposeEventHandler"
 779    # flush stderr
 780
 781    # all tk widgets redraw automatically (though not 'till the next idle)
 782
 783    # all that's left to do is inform our C++ code of the expose
 784    exposeCallback
 785 }
 786
 787 proc addResource {rName} {
 788    global numResources
 789    global resourceNames
 790    global W
 791
 792    # first, make sure this resource doesn't already exist
 793    for {set rindex 0} {$rindex < $numResources} {incr rindex} {
 794       if {$resourceNames($rindex) == $rName} {
 795          puts stderr "detected a duplicate resource: $rname (ignoring addition request)"
 796          return
 797       }
 798    }
 799
 800    set resourceNames($numResources) $rName
 801    incr numResources
 802
 803    drawResourcesAxis [getWindowWidth $W.bottom.resourcesAxisCanvas]
 804 }
 805
 806 proc delResource {delindex} {
 807    global numMetrics
 808    global numResources
 809    global resourceNames
 810    global clickedOnResource
 811    global clickedOnResourceText
 812    global Wmbar
 813    global W
 814
 815    # first, make sure this resource index is valid
 816    if {$delindex < 0 || $delindex >= $numResources} {
 817       puts stderr "delResource -- ignoring out of bounds index: $delindex"
 818       return
 819    }
 820
 821    if {$clickedOnResourceText == $resourceNames($delindex)} {
 822       set clickedOnResource ""
 823       $Wmbar.resources.m entryconfigure 1 -state disabled \
 824               -label "Remove Selected Resource" \
 825               -command {puts stderr "ignoring unexpected deletion..."}
 826    } else {
 827       puts stderr "delResource -- no mbar changes since $clickedOnResourceText != $resourceNames($delindex)"
 828    }
 829
 830    # inform that visi lib that we don't want to receive anything
 831    # more about this resource
 832    # NOTE: unfortunately, [Dg numResources] etc. will not be
 833    #       lowered, even after this is done!  (******A bug********)
 834    #       The temporary solution is to rigidly test the
 835    #       Valid bit of each metric-resource pair before
 836    #       drawing, etc.
 837    for {set mindex 0} {$mindex < $numMetrics} {incr mindex} {
 838       Dg stop $mindex $delindex
 839    }
 840
 841    # shift resourceNames
 842    for {set rindex $delindex} {$rindex < [expr $numResources - 1]} {incr rindex} {
 843       set resourceNames($rindex) $resourceNames([expr $rindex + 1])
 844    }
 845
 846    set numResources [Dg numresources]
 847       # as mentioned above, the current visi-lib won't
 848       # lower the value by 1...
 849
 850    # callback to barChart.C
 851    resourcesAxisHasChanged
 852
 853    drawResourcesAxis [getWindowWidth $W.bottom.resourcesAxisCanvas]
 854 }
 855
 856 proc delResourceByName {rName} {
 857    global numResources
 858    global resourceNames
 859
 860    # find the appropriate index and call delResource...
 861    for {set rindex 0} {$rindex < $numResources} {incr rindex} {
 862       if {$rName == $resourceNames($rindex)} {
 863          delResource $rindex
 864          return
 865       }
 866    }
 867
 868    puts stderr "delResourceByName: ignoring request to delete resource named: $rName (no such resource)"
 869 }
 870
 871 proc getMetricHints {theMetric} {
 872    # #pragma HACK begin
 873    # return metric unit type, hinted min, hinted max, hinted step
 874    # depending on the metric (a hardcoded temporary hack)
 875    switch $theMetric {
 876       "exec_time"        {return {percentage 0.0 1.0 0.1}}
 877       "hybrid_cost"      {return {real 0.0 1.0 0.1}}
 878       "procedure_calls"  {return {integer 0 1000 100}}
 879       "predicted_cost"   {return {real 0.0 1.0 .1}}
 880       "msgs"             {return {integer 0 10 10}}
 881       "msg_bytes"        {return {integer 0 100 100}}
 882       "pause_time"       {return {percentage 0.0 1.0 .1}}
 883       "msg_bytes_sent"   {return {integer 0 100 100}}
 884       "msg_bytes_recv"   {return {integer 0 100 100}}
 885       "active_processes" {return {integer 0 1 1}}
 886       "sync_ops"         {return {real 0.0 5 1}}
 887       "observed_cost"    {return {real 0.0 1.0 0.1}}
 888       "sync_wait"        {return {integer 0.0 5 1}}
 889       "active_slots"     {return {integer 0.0 2 1}}
 890       "cpu"              {return {real 0.0 1.0 0.1}}
 891    }
 892
 893    puts stderr "NOTICE -- getMetricHints: unexpected metric: $theMetric...continuing"
 894    return {real 0.0 1.0 0.1}
 895    # #pragma HACK done
 896 }
 897
 898 proc addMetric {theName theUnits} {
 899    global numMetrics
 900    global metricNames
 901    global metricUnits
 902    global metricUnitTypes
 903    global metricMinValues
 904    global metricMaxValues
 905    global W
 906
 907    puts stderr "Welcome to addMetric; name is $theName; units are $theUnits"
 908
 909    # first make sure that this metric isn't already present (if so, do nothing)
 910    for {set metricIndex 0} {$metricIndex < $numMetrics} {incr metricIndex} {
 911       if {$metricNames($metricIndex) == $theName} {
 912          puts stderr "addMetric: ignoring request to add $theName (already present)"
 913          return
 914       }
 915    }
 916
 917    # make the addition
 918    set metricNames($numMetrics) $theName
 919    set metricUnits($numMetrics) $theUnits
 920
 921    set theHints [getMetricHints $theName]
 922
 923    set metricUnitTypes($numMetrics) [lindex $theHints 0]
 924    set metricMinValues($numMetrics) [lindex $theHints 1]
 925    set metricMaxValues($numMetrics) [lindex $theHints 2]
 926
 927    incr numMetrics
 928
 929    drawResourcesAxis [getWindowWidth $W.bottom.resourcesAxisCanvas]
 930    drawMetricsAxis [getWindowHeight $W.metricsAxisCanvas]
 931    drawTitle
 932 }
 933
 934 proc delMetric {delIndex} {
 935    global numMetrics
 936    global metricNames
 937    global metricUnits
 938    global W
 939
 940    # first, make sure this metric index is valid
 941    if {$delIndex < 0 || $delIndex >= $numMetrics} {
 942       puts stderr "delMetric: ignoring out of bounds index: $delIndex"
 943       return
 944    }
 945
 946    # shift
 947    for {set mindex $delIndex} {$mindex < [expr $numMetrics-1]} {incr mindex} {
 948       set metricNames($mindex) $metricNames([expr $mindex + 1])
 949       set metricUnits($mindex) $metricUnits([expr $mindex + 1])
 950    }
 951
 952    set numMetrics [expr $numMetrics - 1]
 953
 954    drawTitle
 955    drawResourcesAxis [getWindowWidth $W.bottom.resourcesAxisCanvas]
 956    drawMetricsAxis [getWindowHeight $W.metricsAxisCanvas]
 957
 958    # don't we need to tell paradyn to stop sending us data on
 959    # this metric?
 960 }
 961
 962 proc processNewScrollPosition {newTop} {
 963    # the -command configuration of the scrollbar is fixed to call this procedure.
 964    # This happens whenever scrolling takes place.  We update the x-axis canvas
 965    global WresourcesCanvas
 966    global W
 967
 968    # puts stderr "barChart.tcl: welcome to processNewScrollPosition: newTop is now: $newTop"
 969
 970    if {$newTop < 0} {
 971       set newTop 0
 972    }
 973
 974    # if max <= visible then set newTop 0
 975    set currSettings [$W.sbRegion.resourcesAxisScrollbar get]
 976    set totalSize [lindex $currSettings 0]
 977    set visibleSize [lindex $currSettings 1]
 978
 979    if {$visibleSize > $totalSize} {
 980       set newTop 0
 981    } elseif {[expr $newTop + $visibleSize] > $totalSize} {
 982       set newTop [expr $totalSize - $visibleSize]
 983    }
 984
 985    # update the x-axis canvas
 986    # will automatically generate a call to myXScroll, which then updates the
 987    # look of the scrollbar to reflect the new position...
 988    $WresourcesCanvas xview $newTop
 989
 990    # call our C++ code to update the bars
 991    newScrollPosition $newTop
 992 }
 993
 994 proc myXScroll {totalSize visibleSize left right} {
 995    # the -scrollcommand configuration of the resources axis canvas.
 996    # gets called whenever the canvas view changes or is resized.
 997    # The idea is to give us the opportunity to rethink the scrollbar that
 998    # we are associated with.  Four parameters are passed: total size,
 999    # window size, left, right---arguments which we simply pass to the "set"
1000    # command of the scrollbar
1001
1002    global W
1003
1004    $W.sbRegion.resourcesAxisScrollbar set $totalSize $visibleSize $left $right
1005 }
1006
1007 # ############################################################################
1008 # ############# blt_drag&drop: declare that we are willing and able ##########
1009 # ######### to receive drag n' drops of type "text" (the type may change) ####
1010 # ############################################################################
1011
1012 proc dragAndDropTargetHandler {} {
1013    # according to the drag n' drop interface, this routine will be
1014    # called via a "send" command from the source.  So don't expect
1015    # to see this routine called from elsewhere in this file...
1016
1017    # the variable DragDrop(text) contains what should be added
1018    global DragDrop
1019
1020    # not yet implemented...
1021    puts stderr "Welcome to dragAndDropTargetHandler(); DragDrop(text) is $DragDrop(text)"
1022    addResource $DragDrop(text)
1023 }
1024
1025 #blt_drag&drop target . handler text dragAndDropTargetHandler
1026 #...that cryptic line reads: "declare the window '.' to be a drag n' drop
1027 #   handler for sources of type 'text'; routine dragAndDropTargetHandler
1028 #   gets called (via a "send" from the source...)  Using window '.' means
1029 #   the entire barchart...
1030
1031 # #################### Called by visi library when histos have folded #################
1032
1033 proc DgFoldCallback {} {
1034    puts stderr "FOLD detected..."
1035    flush stderr
1036 }
1037
1038
1039 # ########### Called by visi library when metric/resource space changes. #######
1040 #
1041 # note: this routine is too generic; in the future, we plan to
1042 # implement callbacks that actually tell what was added (as opposed
1043 # to what was already there...)
1044 #
1045 # ###############################################################################
1046
1047 proc DgConfigCallback {} {
1048    # puts stderr "Welcome to DgConfigCallback"
1049    # flush stderr
1050
1051    global W
1052
1053    global numMetrics
1054    global metricNames
1055    global metricUnits
1056    global metricMinValues
1057    global metricMaxValues
1058
1059    global numResources
1060    global numResourcesDrawn
1061    global resourceNames
1062
1063    set numMetrics [Dg nummetrics]
1064    for {set metriclcv 0} {$metriclcv < $numMetrics} {incr metriclcv} {
1065       set metricNames($metriclcv) [Dg metricname  $metriclcv]
1066       set metricUnits($metriclcv) [Dg metricunits $metriclcv]
1067
1068       # note -- the following 2 lines are very dubious for already-existing
1069       #         resources (i.e. we should try to stick with the initial values)
1070       set metricMinValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 1]
1071       set metricMaxValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 2]
1072    }
1073
1074    set numResources [Dg numresources]
1075    for {set resourcelcv 0} {$resourcelcv < $numResources} {incr resourcelcv} {
1076       set resourceNames($resourcelcv) [file tail [Dg resourcename $resourcelcv]]
1077    }
1078
1079    # rethink the layout of the axes
1080    rethinkResourceWidths [getWindowWidth $W.bottom.resourcesAxisCanvas]
1081    drawResourcesAxis [getWindowWidth $W.bottom.resourcesAxisCanvas]
1082    drawMetricsAxis [getWindowHeight $W.metricsAxisCanvas]
1083    drawTitle
1084
1085    # inform our C++ code that stuff has changed
1086    resourcesAxisHasChanged [getWindowWidth $W.bottom.resourcesAxisCanvas]
1087    metricsAxisHasChanged [getWindowHeight $W.metricsAxisCanvas]
1088 }
1089
1090 # #################  AddMetricDialog -- Ask paradyn for another metric #################
1091
1092 proc AddMetricDialog {} {
1093    Dg start "*" "*"
1094 }
1095
1096 # #################  AddResourceDialog -- Ask paradyn for another resource #################
1097
1098 proc AddResourceDialog {} {
1099    Dg start "*" "*"
1100 }
1101
1102 proc ProcessNewSortPrefs {} {
1103    global SortPrefs
1104
1105    # redraw the resources axis
1106    drawResourcesAxis
1107
1108    # redraw the bars (callback to our C++ code)
1109    resourcesAxisHasChanged
1110 }
1111
1112 proc rethinkDataFormat {} {
1113    # invoked when a menu item from among "current, average, total"
1114    # is selected
1115    global W
1116    global DataFormat
1117    global numMetrics
1118    global metricMinValues
1119    global metricMaxValues
1120    global metricNames
1121
1122    # reset y-axis min & max values
1123    for {set metriclcv 0} {$metriclcv < $numMetrics} {incr metriclcv} {
1124       set metricMinValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 1]
1125       set metricMaxValues($metriclcv) [lindex [getMetricHints $metricNames($metriclcv)] 2]
1126    }
1127
1128    # inform our C++ code that the data format has changed
1129    dataFormatHasChanged
1130
1131    # redraw the y axis
1132    drawMetricsAxis [getWindowHeight $W.metricsAxisCanvas]
1133 }
1134
1135 # ######################################################################################
1136 #                           "Main Program"
1137 # ######################################################################################
1138
1139 Initialize