source: branches/1.3/tester/scripts/resultspage.tcl @ 6169

Last change on this file since 6169 was 2081, checked in by mmc, 14 years ago

Part 2 of the major reorganization to group all of the rappture utilties
under a single rappture command. Builds better now. Still need to fix
up the builder to work with the objects in a different location now.
File size: 19.5 KB
Line 
1package require Itk
2
3option add *ResultsPage.width 3.5i widgetDefault
4option add *ResultsPage.height 4i widgetDefault
5option add *ResultsPage.font \
6    -*-helvetica-medium-r-normal-*-12-* widgetDefault
7option add *ResultsPage.codeFont \
8    -*-courier-medium-r-normal-*-12-* widgetDefault
9option add *ResultsPage.textFont \
10    -*-helvetica-medium-r-normal-*-12-* widgetDefault
11option add *ResultsPage.boldTextFont \
12    -*-helvetica-bold-r-normal-*-12-* widgetDefault
13
14itcl::class Rappture::ResultsPage {
15    inherit itk::Widget
16
17    itk_option define -codefont codeFont Font ""
18    itk_option define -textfont textFont Font ""
19    itk_option define -boldtextfont boldTextFont Font ""
20    itk_option define -clearcommand clearCommand ClearCommand ""
21    itk_option define -appname appName AppName ""
22    itk_option define -promptcommand promptCommand PromptCommand ""
23
24    constructor {args} { # defined below }
25    destructor { # defined below }
26
27    public method load {xmlobj}
28    public method clear {args}
29    public method download {option args}
30    public method resultset {}
31
32    protected method _plot {args}
33    protected method _fixResult {}
34    protected method _fixSize {}
35    protected method _resultTooltip {}
36    protected method _autoLabel {xmlobj path title cntVar}
37    protected method _reorder {comps}
38
39    private variable _pages 0
40    private variable _label2page
41    private variable _label2desc
42    private variable _runs ""
43    private variable _lastlabel ""
44    private variable _plotlist ""
45
46}
47
48itk::usual ResultsPage {
49    keep -background -cursor -font
50    #TODO: keep -background -cursor foreground -font
51}
52
53itcl::body Rappture::ResultsPage::constructor {args} {
54
55    itk_component add top {
56        frame $itk_interior.top
57    }
58    pack $itk_component(top) -side top -fill x -pady 8
59
60    itk_component add toplabel {
61        label $itk_component(top).l -text "Result:"
62        #TODO: -font $itk_option(font)
63    }
64    pack $itk_component(toplabel) -side left
65
66    itk_component add resultselector {
67        Rappture::Combobox $itk_component(top).sel -width 10 -editable no
68    } {
69        usual
70        rename -font -textfont textFont Font
71    }
72    pack $itk_component(resultselector) -side left -expand yes -fill x
73    bind $itk_component(resultselector) <<Value>> [itcl::code $this _fixResult]
74    bind $itk_component(resultselector) <Enter> \
75        [itcl::code $this download coming]
76
77    Rappture::Tooltip::for $itk_component(resultselector) \
78        "@[itcl::code $this _resultTooltip]"
79
80    $itk_component(resultselector) choices insert end --- "---"
81
82    itk_component add download {
83        button $itk_component(top).dl -image [Rappture::icon download] \
84            -anchor e -borderwidth 1 -relief flat -overrelief raised \
85            -command [itcl::code $this download start $itk_component(top).dl]
86    }
87    pack $itk_component(download) -side right -padx {4 0}
88    bind $itk_component(download) <Enter> [itcl::code $this download coming]
89
90    $itk_component(resultselector) choices insert end \
91        @download [Rappture::filexfer::label download]
92
93    if {[Rappture::filexfer::enabled]} {
94        Rappture::Tooltip::for $itk_component(download) "Downloads the current result to a new web browser window on your desktop.  From there, you can easily print or save results.
95
96NOTE:  Your web browser must allow pop-ups from this site.  If your output does not appear, look for a 'pop-up blocked' message and enable pop-ups."
97    } else {
98        Rappture::Tooltip::for $itk_component(download) "Saves the current result to a file on your desktop."
99    }
100
101    itk_component add results {
102        Rappture::Panes $itk_interior.pane -sashwidth 1 \
103            -sashrelief solid -sashpadding {4 0}
104    }
105    pack $itk_component(results) -expand yes -fill both
106    set f [$itk_component(results) pane 0]
107
108    itk_component add resultpages {
109        Rappture::Notebook $f.nb
110    }
111    pack $itk_component(resultpages) -expand yes -fill both
112
113    set f [$itk_component(results) insert end -fraction 0.1]
114    itk_component add resultset {
115        Rappture::ResultSet $f.rset \
116            -clearcommand [itcl::code $this clear] \
117            -settingscommand [itcl::code $this _plot]
118    }
119    pack $itk_component(resultset) -expand yes -fill both
120    bind $itk_component(resultset) <<Control>> [itcl::code $this _fixSize]
121    bind $itk_component(results) <Configure> [itcl::code $this _fixSize]
122
123    eval itk_initialize $args
124}
125
126itcl::body Rappture::ResultsPage::destructor {} {
127    foreach obj $_runs {
128        itcl::delete object $obj
129    }
130}
131
132# -----------------------------------------------------------------------
133# CONFIGURATION OPTION: -promptcommand
134#
135# Forward the ResultsPage's promptcommand to the child ResultSet.
136# -----------------------------------------------------------------------
137itcl::configbody Rappture::ResultsPage::promptcommand {
138    $itk_component(resultset) configure \
139        -promptcommand $itk_option(-promptcommand)
140}
141 
142itcl::body Rappture::ResultsPage::_fixResult {} {
143    set name [$itk_component(resultselector) value]
144    set page ""
145    if {"" != $name} {
146        set page [$itk_component(resultselector) translate $name]
147    }
148    if {$page == "@download"} {
149        # put the combobox back to its last value
150        $itk_component(resultselector) component entry configure -state normal
151        $itk_component(resultselector) component entry delete 0 end
152        $itk_component(resultselector) component entry insert end $_lastlabel
153        $itk_component(resultselector) component entry configure -state disabled
154        # perform the actual download
155        download start $itk_component(download)
156    } elseif {$page == "---"} {
157        # put the combobox back to its last value
158        $itk_component(resultselector) component entry configure -state normal
159        $itk_component(resultselector) component entry delete 0 end
160        $itk_component(resultselector) component entry insert end $_lastlabel
161        $itk_component(resultselector) component entry configure -state disabled
162    } elseif {$page != ""} {
163        set _lastlabel $name
164        set win [winfo toplevel $itk_component(hull)]
165        blt::busy hold $win
166        $itk_component(resultpages) current $page
167
168        set f [$itk_component(resultpages) page $page]
169        $f.rviewer plot clear
170        eval $f.rviewer plot add $_plotlist
171        blt::busy release [winfo toplevel $itk_component(hull)]
172    }
173}
174
175itcl::body Rappture::ResultsPage::download {option args} {
176    set title [$itk_component(resultselector) value]
177    set page [$itk_component(resultselector) translate $title]
178
179    switch -- $option {
180        coming {
181            #
182            # Warn result that a download is coming, in case
183            # it needs to take a screen snap.
184            #
185            if {![regexp {^(|@download|---)$} $page]} {
186                set f [$itk_component(resultpages) page $page]
187                $f.rviewer download coming
188            }
189        }
190        controls {
191            # no controls for this download yet
192            return ""
193        }
194        start {
195            set widget $itk_component(download)
196            if {[llength $args] > 0} {
197                set widget [lindex $args 0]
198                if {[catch {winfo class $widget}]} {
199                    set widget $itk_component(download)
200                }
201            }
202            #
203            # See if this download has any controls.  If so, then
204            # post them now and let the user continue the download
205            # after selecting a file format.
206            #
207            if {$page != ""} {
208                set ext ""
209                set f [$itk_component(resultpages) page $page]
210                set arg [itcl::code $this download now $widget]
211                set popup [$f.rviewer download controls $arg]
212                if {"" != $popup} {
213                    $popup activate $widget below
214                } else {
215                    download now $widget
216                }
217            } else {
218                # this shouldn't happen
219                set file error.html
220                set data "<h1>Not Found</h1>There is no result selected."
221            }
222        }
223        now {
224            set widget $itk_component(download)
225            if {[llength $args] > 0} {
226                set widget [lindex $args 0]
227                if {[catch {winfo class $widget}]} {
228                    set widget $itk_component(download)
229                }
230            }
231            #
232            # Perform the actual download.
233            #
234            if {$page != ""} {
235                set ext ""
236                set f [$itk_component(resultpages) page $page]
237                set item [$itk_component(resultselector) value]
238                set result [$f.rviewer download now $widget \
239                    $itk_option(-appname) $item]
240                if { $result == "" } {
241                    return;                # User cancelled the download.
242                }
243                foreach {ext data} $result break
244                if {"" == $ext} {
245                    if {"" != $widget} {
246                        Rappture::Tooltip::cue $widget \
247                            "Can't download this result."
248                    }
249                    return
250                }
251                regsub -all {[\ -\/\:-\@\{-\~]} $title {} title
252                set file "$title$ext"
253            } else {
254                # this shouldn't happen
255                set file error.html
256                set data "<h1>Not Found</h1>There is no result selected."
257            }
258
259            set mesg [Rappture::filexfer::download $data $file]
260            if {[string length $mesg] > 0} {
261                Rappture::Tooltip::cue $widget $mesg
262            }
263        }
264        default {
265            error "bad option \"$option\": should be coming, controls, now, start"
266        }
267    }
268}
269
270itcl::body Rappture::ResultsPage::load {xmlobj} {
271    # look for all output.load children and load them first
272    # each run.xml is loaded as a previous simulation.
273    foreach item [$xmlobj children -type run output.load] {
274        set loadfile [$xmlobj get output.load.$item]
275        set loadobj [Rappture::library $loadfile]
276        load $loadobj
277    }
278
279    foreach item [$xmlobj children -type run output.include] {
280        set id [$xmlobj element -as id output.include.$item]
281        set inclfile [$xmlobj get output.include.$item]
282        set inclobj [Rappture::library $inclfil]
283        foreach c [$inclobj children output] {
284            switch -glob -- $c {
285                # We don't want to include these tags.
286                include* - time* - status* - user* {
287                    continue
288                }
289                default {
290                    set oldid [$inclobj element -as id output.$c]
291                    set oldtype [$inclobj element -as type output.$c]
292                    set newcomp "$oldtype\($id-$oldid\)"
293                    $xmlobj copy output.$newcomp from $inclobj output.$c
294                }
295            }
296        }
297    }
298
299    lappend _runs $xmlobj
300
301    # Detect molecule elements that contain trajectory data and convert
302    # to sequences.
303    # TODO: _trajToSequence $xmlobj output
304
305    # Go through the analysis and find all result sets.
306    set haveresults 0
307    foreach item [_reorder [$xmlobj children output]] {
308        switch -glob -- $item {
309            log* {
310                _autoLabel $xmlobj output.$item "Output Log" counters
311            }
312            number* {
313                _autoLabel $xmlobj output.$item "Number" counters
314            }
315            integer* {
316                _autoLabel $xmlobj output.$item "Integer" counters
317            }
318            string* {
319                _autoLabel $xmlobj output.$item "String" counters
320            }
321            histogram* - curve* - field* - drawing3d* {
322                _autoLabel $xmlobj output.$item "Plot" counters
323            }
324            structure* {
325                _autoLabel $xmlobj output.$item "Structure" counters
326            }
327            table* {
328                _autoLabel $xmlobj output.$item "Energy Levels" counters
329            }
330            sequence* {
331                _autoLabel $xmlobj output.$item "Sequence" counters
332            }
333        }
334        set label [$xmlobj get output.$item.about.group]
335        if {"" == $label} {
336            set label [$xmlobj get output.$item.about.label]
337        }
338
339        set hidden [$xmlobj get output.$item.hide]
340        set hidden [expr {"" != $hidden && $hidden}]
341
342        if {"" != $label && !$hidden} {
343            set haveresults 1
344        }
345    }
346
347    # if there are any valid results, add them to the resultset
348    if {$haveresults} {
349        set index [$itk_component(resultset) add $xmlobj]
350
351        # add each result to a result viewer
352        foreach item [_reorder [$xmlobj children output]] {
353            set label [$xmlobj get output.$item.about.group]
354            if {"" == $label} {
355                set label [$xmlobj get output.$item.about.label]
356            }
357
358            set hidden [$xmlobj get output.$item.hide]
359            set hidden [expr {"" != $hidden && $hidden}]
360
361            if {"" != $label && !$hidden} {
362                if {![info exists _label2page($label)]} {
363                    set name "page[incr _pages]"
364                    set page [$itk_component(resultpages) insert end $name]
365                    set _label2page($label) $page
366                    set _label2desc($label) \
367                        [$xmlobj get output.$item.about.description]
368                    Rappture::ResultViewer $page.rviewer
369                    pack $page.rviewer -expand yes -fill both -pady 4
370
371                    set end [$itk_component(resultselector) \
372                        choices index -value ---]
373                    if {$end < 0} {
374                        set end "end"
375                    }
376                    $itk_component(resultselector) choices insert $end \
377                        $name $label
378                }
379
380                # add/replace the latest result into this viewer
381                set page $_label2page($label)
382
383                if {![info exists reset($page)]} {
384                    $page.rviewer clear $index
385                    set reset($page) 1
386                }
387                $page.rviewer add $index $xmlobj output.$item
388            }
389        }
390    }
391
392    # show the first page by default
393    set max [$itk_component(resultselector) choices size]
394    for {set i 0} {$i < $max} {incr i} {
395        set first [$itk_component(resultselector) choices get -label $i]
396        if {$first != ""} {
397            set page [$itk_component(resultselector) choices get -value $i]
398            set char [string index $page 0]
399            if {$char != "@" && $char != "-"} {
400                $itk_component(resultpages) current $page
401                $itk_component(resultselector) value $first
402                set _lastlabel $first
403                break
404            }
405        }
406    }
407}
408
409# -----------------------------------------------------------------------
410# USAGE: clear ?-nodelete?
411#
412# Discards all results previously loaded into the results page.  Any
413# library objects that have been loaded will be destroyed unless the
414# -nodelete option is used.
415# -----------------------------------------------------------------------
416itcl::body Rappture::ResultsPage::clear {args} {
417    if {[lsearch $args "-nodelete"] == -1} {
418        foreach obj $_runs {
419            itcl::delete object $obj
420        }
421    }
422    set _runs ""
423
424    $itk_component(resultset) clear
425
426    # reset the size of the controls area
427    set ht [winfo height $itk_component(results)]
428    set cntlht [$itk_component(resultset) size -controlarea]
429    set frac [expr {double($cntlht)/$ht}]
430    $itk_component(results) fraction end $frac
431
432    foreach label [array names _label2page] {
433        set page $_label2page($label)
434        $page.rviewer clear
435    }
436    $itk_component(resultselector) value ""
437    $itk_component(resultselector) choices delete 0 end
438    catch {unset _label2page}
439    catch {unset _label2desc}
440    set _plotlist ""
441
442    $itk_component(resultselector) choices insert end --- "---"
443    $itk_component(resultselector) choices insert end \
444        @download [Rappture::filexfer::label download]
445    set _lastlabel ""
446
447    #
448    # HACK ALERT!!
449    # The following statement should be in place, but it causes
450    # vtk to dump core.  Leave it out until we can fix the core dump.
451    # In the mean time, we leak memory...
452    #
453    #$itk_component(resultpages) delete -all
454    #set _pages 0
455
456    # Invoke -clearcommand option
457    if {[string length $itk_option(-clearcommand)] > 0} {
458        uplevel #0 $itk_option(-clearcommand)
459    }
460
461}
462
463itcl::body Rappture::ResultsPage::_resultTooltip {} {
464    set tip ""
465    set name [$itk_component(resultselector) value]
466    if {[info exists _label2desc($name)] &&
467         [string length $_label2desc($name)] > 0} {
468        append tip "$_label2desc($name)\n\n"
469    }
470    if {[array size _label2page] > 1} {
471        append tip "Use this control to display other output results."
472    }
473    return $tip
474}
475
476itcl::body Rappture::ResultsPage::_fixSize {} {
477    set ht [winfo height $itk_component(results)]
478    if {$ht <= 1} { set ht [winfo reqheight $itk_component(results)] }
479    set cntlht [$itk_component(resultset) size -controlarea]
480    set frac [expr {double($cntlht)/$ht}]
481
482    if {$frac < 0.4} {
483        $itk_component(results) fraction end $frac
484    }
485    #_fixSimControl
486}
487
488itcl::body Rappture::ResultsPage::_autoLabel {xmlobj path title cntVar} {
489    upvar $cntVar counters
490
491    set group [$xmlobj get $path.about.group]
492    set label [$xmlobj get $path.about.label]
493    if {"" == $label} {
494        # no label -- make one up using the title specified
495        if {![info exists counters($group-$title)]} {
496            set counters($group-$title) 1
497            set label $title
498        } else {
499            set label "$title (#[incr counters($group-$title)])"
500        }
501        $xmlobj put $path.about.label $label
502    } else {
503        # handle the case of two identical labels in <output>
504        if {![info exists counters($group-$label)]} {
505            set counters($group-$label) 1
506        } else {
507            set label "$label (#[incr counters($group-$label)])"
508            $xmlobj put $path.about.label $label
509        }
510    }
511    return $label
512}
513
514# ----------------------------------------------------------------------
515# USAGE: _plot ?<index> <options> <index> <options>...?
516#
517# Used internally to update the plot shown in the current result
518# viewer whenever the resultset settings have changed.  Causes the
519# desired results to show up on screen.
520# ----------------------------------------------------------------------
521itcl::body Rappture::ResultsPage::_plot {args} {
522    set _plotlist $args
523
524    set page [$itk_component(resultselector) value]
525    set page [$itk_component(resultselector) translate $page]
526    if {"" != $page} {
527        set f [$itk_component(resultpages) page $page]
528        $f.rviewer plot clear
529        foreach {index opts} $_plotlist {
530            $f.rviewer plot add $index $opts
531        }
532    }
533}
534
535# ----------------------------------------------------------------------
536# USAGE: _reorder <compList>
537#
538# Used internally to change the order of a series of output components
539# found in the <output> section.  Moves the <log> elements to the end
540# and returns the updated list.
541# ----------------------------------------------------------------------
542itcl::body Rappture::ResultsPage::_reorder {comps} {
543    set i 0
544    set max [llength $comps]
545    while {$i < $max} {
546        set c [lindex $comps $i]
547        if {[string match log* $c]} {
548            set comps [lreplace $comps $i $i]
549            lappend comps $c
550            incr max -1
551        } else {
552            incr i
553        }
554    }
555    return $comps
556}
557
558itcl::body Rappture::ResultsPage::resultset {} {
559    return $itk_component(resultset)
560}
561
Note: See TracBrowser for help on using the repository browser.