visiClients/tableVisi/tcl/tableVisi.tcl

   1 # tableVisi.tcl
   2 # Ariel Tamches
   3
   4 #
   5 # $Log: tableVisi.tcl,v $
   6 # Revision 1.1  1995/11/04 00:43:12  tamches
   7 # First version of new table visi
   8 #
   9 #
  10
  11 proc initializeTableVisi {} {
  12    if {[winfo depth .] > 1} {
  13    #  . config -bg grey
  14      option add *Background grey
  15      option add *activeBackground LightGrey
  16      option add *activeForeground black
  17      option add *Scale.activeForeground grey
  18    } else {
  19      option add *Background white
  20      option add *Foreground black
  21    }
  22
  23    option add *Visi*font *-New*Century*Schoolbook-Bold-R-*-18-*
  24    option add *Data*font *-Helvetica-*-r-*-12-*
  25    option add *MyMenu*font *-New*Century*Schoolbook-Bold-R-*-14-*
  26
  27    # Create the title bar, menu bar, and logo at the top:
  28    frame .top
  29    pack .top -side top -fill x
  30
  31    frame .top.left
  32    pack .top.left -side left -fill both -expand true
  33
  34    label .top.left.title -relief raised -text "Table Visualization" \
  35          -font *-New*Century*Schoolbook-Bold-R-*-14-* \
  36          -foreground white -background HotPink2
  37    pack .top.left.title -side top -fill both -expand true
  38
  39    # Menus:
  40
  41    frame .top.left.menubar -class MyMenu -borderwidth 2 -relief raised
  42    pack .top.left.menubar -side top -fill x
  43
  44    menubutton .top.left.menubar.file -text "File" -menu .top.left.menubar.file.m
  45    menu .top.left.menubar.file.m -selectcolor cornflowerblue
  46    .top.left.menubar.file.m add command -label "Close Table" -command {destroy .}
  47
  48    menubutton .top.left.menubar.acts -text "Actions" -menu .top.left.menubar.acts.m
  49    menu .top.left.menubar.acts.m  -selectcolor cornflowerblue
  50    .top.left.menubar.acts.m add command -label "Add Entries" -command AddEntry
  51    .top.left.menubar.acts.m add command -label "Delete Selected Entry" -command DelEntry -state disabled
  52
  53    menubutton .top.left.menubar.opts -text "View" -menu .top.left.menubar.opts.m
  54    menu .top.left.menubar.opts.m  -selectcolor cornflowerblue
  55
  56    global LongNames
  57    set LongNames 1
  58    .top.left.menubar.opts.m add check -label "Long Names" -variable LongNames -command {updateNames $LongNames}
  59    .top.left.menubar.opts.m add separator
  60    .top.left.menubar.opts.m add radio -label "Current Values" \
  61            -variable DataFormat \
  62            -value 0 -command formatChanged
  63    .top.left.menubar.opts.m add radio -label "Average Values" \
  64            -variable DataFormat \
  65            -value 1 -command formatChanged
  66    .top.left.menubar.opts.m add radio -label "Total Values" \
  67            -variable DataFormat \
  68            -value 2 -command formatChanged
  69    .top.left.menubar.opts.m add separator
  70    global sortMetrics
  71    set sortMetrics 0
  72    .top.left.menubar.opts.m add radio -label "Don't Sort Metrics" \
  73            -variable sortMetrics -value 0 -command unsortMetrics
  74    .top.left.menubar.opts.m add radio -label "Sort Metrics (ascending)" \
  75            -variable sortMetrics -value 1 -command sortMetrics
  76    .top.left.menubar.opts.m add separator
  77    global sortFoci
  78    set sortFoci 0
  79    .top.left.menubar.opts.m add radio -label "Don't Sort Foci" \
  80            -variable sortFoci -value 0 -command unsortFoci
  81    .top.left.menubar.opts.m add radio -label "Sort Foci (ascending)" \
  82            -variable sortFoci -value 1 -command sortFoci
  83
  84    #  Add menu bar to display
  85    pack .top.left.menubar.file .top.left.menubar.acts .top.left.menubar.opts \
  86         -side left -padx 4
  87
  88    #  Logo:
  89    label .top.logo -relief raised \
  90                      -bitmap @/p/paradyn/core/paradyn/tcl/logo.xbm \
  91                      -foreground HotPink2
  92    pack .top.logo -side right
  93
  94 #   #  Status field at the bottom:
  95 #   canvas .status -relief groove
  96 #   pack   .status -side bottom -fill x -ipady 4 -ipadx 4 -expand false
  97 #
  98 #   label .status.label -text "No Data Yet" \
  99 #           -font *-Helvetica-*-o-*-12-* \
 100 #           -foreground blue -padx 6
 101 #   pack  .status.label -expand true -side top
 102
 103    # scale widget above the status field:
 104    global SignificantDigits
 105    set SignificantDigits 3
 106
 107    scale .scale -orient horizontal -length 280 -from 1 -to 8 \
 108            -tickinterval 1 \
 109            -command "sigFigChange " \
 110            -showvalue false \
 111            -label "Significant Digits:" \
 112            -font *-Helvetica-*-r-*-12-*
 113    pack .scale -side bottom -fill x -expand false
 114    .scale set $SignificantDigits
 115
 116    # Horizontal Scrollbar
 117    scrollbar .horizScrollbar -orient horizontal \
 118            -background gray -activebackground gray -relief sunken \
 119            -command horizScrollbarNewScrollPosition
 120    pack .horizScrollbar -side bottom -fill x
 121
 122    # Vertical Scrollbar:
 123    scrollbar .vertScrollbar -orient vertical \
 124            -background gray -activebackground gray -relief sunken \
 125            -command vertScrollbarNewScrollPosition
 126    pack .vertScrollbar -side left -fill y -expand false
 127
 128    # Body (drawn by C++ code -- metrics, units, foci, cells):
 129    frame .body -width 400 -height 220
 130    pack  .body -fill both -expand true
 131
 132    bind .body <Configure> {tableVisiConfigure}
 133    bind .body <Expose>    {tableVisiExpose}
 134
 135    wm minsize . 300 200
 136    wm title . "Table Visualization"
 137 }
 138
 139 #  AddEntry -- Ask paradyn to start a new curve
 140 proc AddEntry {} {
 141   Dg start "*" "*"
 142 }
 143
 144 #  DelEntry -- Ask paradyn to stop a curve
 145 proc DelEntry {} {
 146   puts stderr "Delete Entry not yet implemented"
 147 }
 148
 149 #  Called by visi library when histos have folded
 150 #    we just update the status line and keep on going
 151 #proc DgFoldCallback {} {
 152 #  UpdateStatus
 153 #}
 154
 155 #
 156 #  DgPhaseStartCallback -- visi calls this when a phase has started
 157 #
 158 proc DgPhaseStartCallback {phaseId} {
 159    puts stderr "welcome to DgPhaseStartCallback (tcl code)"
 160    return
 161 }
 162
 163 #
 164 #  DgPhaseEndCallback -- visi calls this when a phase has started
 165 #
 166 proc DgPhaseEndCallback {phaseId} {
 167    puts stderr "welcome to DgPhaseEndCallback (tcl code)"
 168    return
 169 }
 170
 171 #
 172 #  DgPhaseDataCallback -- visi calls this when a phase has started
 173 #
 174 proc DgPhaseDataCallback {} {
 175    puts stderr "welcome to DgPhaseEndCallback (tcl code)"
 176    return
 177 }
 178
 179 #
 180 #  Update the status line
 181 #
 182 proc UpdateStatus {} {
 183   global DataFormat W
 184   global Callbacks UpdateLimit lastBucket
 185
 186   set bw [Dg binwidth]
 187
 188   .status.label configure -text [format "Time: %-10s  Format: %s" [TimeLabel [expr int($bw * $lastBucket)]] $DataFormat]
 189 }
 190
 191 #
 192 #  GetValue asks visi library for the data value for the met/res pair
 193 #    we ask visi for the data in the correct DataFormat
 194 #
 195 #proc GetValue {m r bucket} {
 196 #  global DataFormat
 197 #  global numMetrics numResources
 198 #
 199 #   if {![Dg valid $m $r] || ![Dg enabled $m $r]} {
 200 #      # there is a hole in valid datagrid entries -- happens all the time
 201 #      return ""
 202 #   }
 203 #
 204 #   if {[string match $DataFormat Instantaneous]} {
 205 #      return [Dg value $m $r $bucket]
 206 #   } elseif {[string match $DataFormat Average]} {
 207 #      return [Dg aggregate $m $r]
 208 #   } elseif {[string match $DataFormat Sum]} {
 209 #      return [Dg sum $m $r]
 210 #   } else {
 211 #      puts stderr "GetValue: unknown data format: $DataFormat"
 212 #      return 0
 213 #   }
 214 #}
 215
 216 #
 217 # DgValidCallback -- visi calls this when curve becomes valid
 218 #
 219 #proc DgValidCallback {m} {
 220 #  return
 221 #  puts stderr "Bucket $m is now valid"
 222 #}
 223
 224 set UpdateCounter 0
 225 set UpdateLimit 1
 226
 227 # TimeToUpdate - returns true (1) iff it is time to redraw
 228 #                the status (amount of time) at the bottom of the screen
 229 proc TimeToUpdate {} {
 230   global UpdateCounter UpdateLimit
 231
 232   if {$UpdateCounter <= 0} {
 233     set UpdateCounter [expr $UpdateLimit / [Dg binwidth]]
 234     return 1
 235   } else {
 236     set UpdateCounter [expr $UpdateCounter - 1]
 237     return 0
 238   }
 239 }
 240
 241 set Callbacks 0
 242
 243 #
 244 #  DgDataCallback -- visi calls this command when new data is available
 245 #    we fill in all of the data labels with the new data values
 246 #
 247 #proc DgDataCallback {bucket} {
 248 #   global Callbacks
 249 #
 250 #   incr Callbacks
 251 #   if {[TimeToUpdate]} {
 252 #      DataUpdate $bucket
 253 #      UpdateStatus
 254 #   }
 255 #}
 256
 257 #
 258 #  TimeLabel -- given a time value in seconds, format a nice label
 259 #
 260 #  note: If called often, this routine should be rewritten in C++.
 261 proc TimeLabel {val} {
 262   if {($val > 60) && ($val < 3600)} {
 263     set min [expr $val / 60]
 264     set sec [expr $val - ($min * 60)]
 265     return [format "%d m %d s" $min $sec]
 266   }
 267   if {$val < 60} {
 268     return [format "%d s" $val]
 269   }
 270   if {$val > 3600} {
 271     set hr [expr $val / 3600]
 272     set left [expr $val - ($hr * 3600)]
 273     set min [expr $left / 60]
 274     set sec [expr $left - ($min * 60)]
 275     return [format "%d h %d m %d s" $hr $min $sec]
 276   }
 277   return "$val s"
 278 }
 279
 280 initializeTableVisi