First version of new table visi
[dyninst.git] / 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