first version of phaseTable
[dyninst.git] / visiClients / phaseTable / tcl / phasetbl.tcl
1 #
2 # $Log: phasetbl.tcl,v $
3 # Revision 1.1  1995/12/15 22:01:56  tamches
4 # first version of phaseTable
5 #
6 #
7
8 if {[string match [winfo depth .] color] == 1} {
9   # always defaults to bisque so reset it to grey
10   . config -bg grey
11    option add *Background grey
12   option add *activeBackground LightGrey
13   option add *activeForeground black
14   option add *Scale.activeForeground grey
15 } else {
16   option add *Background white
17   option add *Foreground black
18 }
19
20 option add *Visi*font *-New*Century*Schoolbook-Bold-R-*-18-*
21 option add *Data*font *-Helvetica-*-r-*-12-* 
22 option add *MyMenu*font *-New*Century*Schoolbook-Bold-R-*-14-*
23 option add *title*font *-New*Century*Schoolbook-Bold-R-*-18-*
24 option add *phaseName*font *-New*Century*Schoolbook-Bold-R-*-14-*
25 option add *phaseStart*font *-New*Century*Schoolbook-Bold-R-*-14-*
26 option add *phaseEnd*font *-New*Century*Schoolbook-Bold-R-*-14-*
27
28 proc getWindowWidth {wName} {
29    # warning!  This routine will return an old number if an important
30    # event (i.e. resize) happened but idle routines haven't yet kicked in.
31    # --> *** In such cases, be sure to grab the latest information directly
32    #         from the event structure instead of calling this routine!!!!
33
34    set result [winfo width $wName]
35    if {$result == 1} {
36       # hack for a window that hasn't yet been mapped
37       set result [winfo reqwidth $wName]
38    }
39
40    return $result
41 }
42
43 proc getWindowHeight {wName} {
44    # warning!  This routine will return an old number if an important
45    # event (i.e. resize) happened but idle routines haven't yet kicked in.
46    # --> *** In such cases, be sure to grab the latest information directly
47    #         from the event structure instead of calling this routine!!!!
48
49    set result [winfo height $wName]
50    if {$result == 1} {
51       # hack for a window that hasn't yet been mapped
52       set result [winfo reqheight $wName]
53    }
54
55    return $result
56 }
57
58 set W .table
59
60 #
61 #  Create the overall frame
62 #
63 frame $W -class Visi -width 4i -height 2i
64
65 #
66 #  Create the title bar, menu bar, and logo at the top
67 #
68 frame $W.top
69 pack $W.top -side top -fill x
70
71 frame $W.top.left 
72 pack $W.top.left -side left -fill both -expand 1
73
74 label $W.top.left.title -relief raised -text "Phase Table" \
75       -foreground white -background Green4
76
77 pack $W.top.left.title -side top -fill both -expand true
78
79 #
80 #  Create the menubar as a frame with many menu buttons
81 #
82 frame $W.top.left.menubar -class MyMenu -borderwidth 2 -relief raised
83 pack $W.top.left.menubar -side top -fill x
84
85 #
86 #  File menu
87
88 menubutton $W.top.left.menubar.file -text "File" -menu $W.top.left.menubar.file.m
89 menu $W.top.left.menubar.file.m
90 $W.top.left.menubar.file.m add command -label "Close" -command Shutdown
91
92 #
93 #  Actions menu
94 #
95 #menubutton $W.top.left.menubar.acts -text "Actions"  \
96 #               -menu $W.top.left.menubar.acts.m
97 #menu $W.top.left.menubar.acts.m
98 #$W.top.left.menubar.acts.m add command -label "Start Phase" -command PhaseDef 
99
100 button $W.top.left.menubar.acts -text "Start Phase"  \
101                 -relief flat -borderwidth 0 -highlightbackground white -command PhaseDef  
102
103
104 #
105 #  Options menu
106 #
107
108 #
109 #  Help menu
110 #
111 menubutton $W.top.left.menubar.help -text "Help" -menu $W.top.left.menubar.help.m
112 menu $W.top.left.menubar.help.m
113 $W.top.left.menubar.help.m add command -label "General" -command "NotImpl"
114 $W.top.left.menubar.help.m add command -label "Context" -command "NotImpl"
115 #$W.top.left.menubar.help.m disable 0
116 #$W.top.left.menubar.help.m disable 1
117
118 #
119 #  Build the menu bar and add to display
120 #
121 pack $W.top.left.menubar.file $W.top.left.menubar.acts -side left -padx 2
122 pack $W.top.left.menubar.help -side right 
123
124 makeLogo $W.top.logo paradynLogo raised 2 HotPink4
125 pack $W.top.logo -side right
126
127
128 frame $W.left 
129 pack   $W.left -side left -fill both -expand true
130
131 #
132 # Left portion of middle: phase name, name canvas
133 #
134 label $W.left.phaseName -text "Phase Name" -foreground Blue 
135 pack  $W.left.phaseName -side top -expand false
136 # expand is false; if the window is made taller, we don't want the extra height
137
138 canvas $W.left.dataCanvas -relief groove \
139         -width 1.3i -height 0.9i
140 pack   $W.left.dataCanvas -side left -fill both -expand true
141
142
143 #
144 # Middle portion of middle: phase start time, data canvas
145 #
146
147 frame $W.middle 
148 pack  $W.middle -side left -fill both -expand true 
149
150 label $W.middle.phaseStart -text "Start Time" -foreground Blue 
151 pack   $W.middle.phaseStart -side top -fill x -expand false
152
153 canvas $W.middle.dataCanvas -relief groove \
154         -width 1.3i -height 0.9i
155 pack  $W.middle.dataCanvas -side top -fill both -expand true 
156
157 #
158 # Right portion of middle: phase end time, data canvas
159 #
160
161 frame $W.right 
162 pack  $W.right -side right -fill both -expand true
163
164 label $W.right.phaseEnd -text "End Time" -foreground Blue 
165 pack   $W.right.phaseEnd -side top -fill x -expand false
166
167
168 canvas $W.right.dataCanvas -relief groove \
169         -width 1.3i -height 0.9i
170 pack  $W.right.dataCanvas -side top -fill both -expand true
171
172
173 #
174 # display everything
175 #
176 pack append . $W {fill expand frame center}
177 wm minsize . 250 100
178 wm title . "Phase Table"
179
180 #
181 #  Helper function for "Close" menu option
182 #
183 proc Shutdown {} {
184   destroy .
185 }
186
187 #
188 #  Issue a warning about missing function
189 #
190 proc NotImpl {} {
191 }
192
193 #
194 #  Called by visi library when histos have folded
195 #
196 proc DgFoldCallback {} {
197
198 }
199
200 #
201 #  Called by visi library when met/res space changes
202 #
203 proc DgConfigCallback {} {
204
205 }
206
207 #
208 # DgValidCallback -- visi calls this when curve becomes valid
209 #
210 proc DgValidCallback {m} {
211   return
212 }
213
214 #
215 #  DgDataCallback -- visi calls this command when new data is available
216 #
217 proc DgDataCallback {bucket} {
218
219 }
220 set xOffset 10 
221 set yOffset 5
222 set widthChange 20
223
224 proc NameUpdate {phaseId} {
225    global W
226    global xOffset 
227    global yOffset 
228    global widthChange
229
230    set theCanvas $W.left.dataCanvas
231
232    set theText [Dg phasename $phaseId] 
233    set yOffset [expr  5 + $phaseId * $widthChange]
234    $theCanvas create text $xOffset $yOffset\
235         -anchor nw \
236         -fill black \
237         -font *-Helvetica-*-r-*-12-* \
238         -justify center \
239         -tag dataTag \
240         -text $theText 
241
242
243    return
244 }
245
246 proc StartUpdate {phaseId} {
247    global W
248    global xOffset 
249    global yOffset 
250    global widthChange
251
252    set theCanvas $W.middle.dataCanvas
253
254    set yOffset [expr  5 + $phaseId * $widthChange]
255    set theText [TimeLabel [expr int([Dg phasestartT $phaseId])]  ] 
256    $theCanvas create text $xOffset $yOffset\
257         -anchor nw \
258         -fill black \
259         -font *-Helvetica-*-r-*-12-* \
260         -justify center \
261         -tag dataTag \
262         -text $theText 
263    return
264 }
265
266 proc EndUpdate {phaseId} {
267    global W
268    global xOffset 
269    global yOffset 
270    global widthChange
271
272    set theCanvas $W.right.dataCanvas
273    
274    # puts stderr "in EndUpdate phaseId and phaseend"
275    # puts stderr $phaseId 
276    set result [Dg phaseendT $phaseId]
277    # puts stderr $result 
278    if {$result == -1} return
279    set theText [TimeLabel [expr int([Dg phaseendT $phaseId])]  ]
280    set yOffset [expr  5 + $phaseId * $widthChange]
281    $theCanvas create text $xOffset $yOffset\
282         -anchor nw \
283         -fill black \
284         -font *-Helvetica-*-r-*-12-* \
285         -justify center \
286         -tag dataTag \
287         -text $theText 
288
289 #   set yOffset [expr $yOffset + 20]
290    return
291 }
292
293 #
294 #  DgPhaseStartCallback -- visi calls this when a phase has started
295 #
296 proc DgPhaseStartCallback {phaseId} {
297    
298    NameUpdate $phaseId
299    StartUpdate $phaseId
300    return
301 }
302
303 #
304 #  DgPhaseEndCallback -- visi calls this when a phase has started
305 #
306 proc DgPhaseEndCallback {phaseId} { 
307    EndUpdate $phaseId
308    return
309 }
310
311 #
312 #  DgPhaseDataCallback -- visi calls this when a phase has started
313 #
314 proc DgPhaseDataCallback {} {
315    
316    set max [expr int([Dg numphases])]
317    for {set phasecount 0} {$phasecount < $max} {incr phasecount} {
318        NameUpdate $phasecount
319        StartUpdate $phasecount
320        if {$phasecount < [expr $max - 1]} {
321            EndUpdate  $phasecount
322        }
323    }
324    
325    return
326 }
327
328
329
330 #
331 #  TimeLabel -- given a time value in seconds, format a nice label
332 #
333 #  note: If called often, this routine should be rewritten in C++.
334 proc TimeLabel {val} {
335   if {($val > 60) && ($val < 3600)} {
336     set min [expr $val / 60]
337     set sec [expr $val - ($min * 60)]
338     return [format "%d m %d s" $min $sec]
339   }
340   if {$val < 60} {
341     return [format "%d s" $val]
342   }
343   if {$val > 3600} {
344     set hr [expr $val / 3600]
345     set left [expr $val - ($hr * 3600)]
346     set min [expr $left / 60]
347     set sec [expr $left - ($min * 60)]
348     return [format "%d h %d m %d s" $hr $min $sec]
349   }
350   return "$val s"
351 }
352
353
354 #
355 # PhaseDef: ask paradyn to start a new phase
356 #
357 proc PhaseDef {} {
358
359   Dg phase 
360
361 }