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