source: trunk/gui/scripts/resultset.tcl @ 11

Last change on this file since 11 was 11, checked in by mmc, 19 years ago

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.
File size: 22.6 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: ResultSet - controls for a collection of related results
3#
4#  This widget stores a collection of results that all represent
5#  the same quantity, but for various ranges of input values.
6#  It also manages the controls to select and visualize the data.
7# ======================================================================
8#  AUTHOR:  Michael McLennan, Purdue University
9#  Copyright (c) 2004-2005
10#  Purdue Research Foundation, West Lafayette, IN
11# ======================================================================
12package require Itk
13
14option add *ResultSet.width 4i widgetDefault
15option add *ResultSet.height 4i widgetDefault
16option add *ResultSet.colors {blue #000066} widgetDefault
17option add *ResultSet.toggleBackground gray widgetDefault
18option add *ResultSet.toggleForeground white widgetDefault
19option add *ResultSet.textFont \
20    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
21option add *ResultSet.boldFont \
22    -*-helvetica-bold-r-normal-*-*-120-* widgetDefault
23
24itcl::class Rappture::ResultSet {
25    inherit itk::Widget
26
27    itk_option define -colors colors Colors ""
28    itk_option define -togglebackground toggleBackground Background ""
29    itk_option define -toggleforeground toggleForeground Foreground ""
30    itk_option define -textfont textFont Font ""
31    itk_option define -boldfont boldFont Font ""
32    itk_option define -clearcommand clearCommand ClearCommand ""
33    itk_option define -settingscommand settingsCommand SettingsCommand ""
34    itk_option define -promptcommand promptCommand PromptCommand ""
35
36    constructor {args} { # defined below }
37    destructor { # defined below }
38
39    public method add {xmlobj}
40    public method clear {}
41    public method contains {xmlobj}
42    public method size {{what -results}}
43
44    protected method _doClear {}
45    protected method _doSettings {{cmd ""}}
46    protected method _fixControls {args}
47    protected method _fixSettings {args}
48    protected method _doPrompt {state}
49    protected method _toggleAll {path widget}
50
51    private variable _dispatcher ""  ;# dispatchers for !events
52    private variable _results ""     ;# tuple of known results
53    private variable _recent ""      ;# most recent result in _results
54    private variable _plotall ""     ;# column with "All" active
55    private variable _col2widget     ;# maps column name => control widget
56    private variable _spectrum ""    ;# color spectrum for "All" active
57    private variable _counter 0      ;# counter for unique control names
58}
59                                                                               
60itk::usual ResultSet {
61    keep -background -foreground -cursor -font
62}
63
64# ----------------------------------------------------------------------
65# CONSTRUCTOR
66# ----------------------------------------------------------------------
67itcl::body Rappture::ResultSet::constructor {args} {
68    option add hull.width hull.height
69    pack propagate $itk_component(hull) no
70
71    # create a dispatcher for events
72    Rappture::dispatcher _dispatcher
73    $_dispatcher register !fixcntls
74    $_dispatcher dispatch $this !fixcntls \
75        [itcl::code $this _fixControls]
76    $_dispatcher register !settings
77    $_dispatcher dispatch $this !settings \
78        [itcl::code $this _fixSettings]
79
80    # create a list of tuples for data
81    set _results [Rappture::Tuples ::#auto]
82    $_results column insert end -name xmlobj -label "top-level XML object"
83
84
85    itk_component add cntls {
86        frame $itk_interior.cntls
87    }
88    pack $itk_component(cntls) -fill x
89
90    itk_component add clear {
91        button $itk_component(cntls).clear -text "Clear" -state disabled \
92            -relief flat -overrelief raised \
93            -command [itcl::code $this _doClear]
94    }
95    pack $itk_component(clear) -side right
96    Rappture::Tooltip::for $itk_component(clear) \
97        "Clears all results collected so far."
98
99    itk_component add status {
100        label $itk_component(cntls).status -anchor w -text "No results"
101    }
102    pack $itk_component(status) -side left -expand yes -fill x
103
104    itk_component add scroller {
105        Rappture::Scroller $itk_interior.scroller \
106            -xscrollmode off -yscrollmode auto -height 1i
107    }
108    pack $itk_component(scroller) -expand yes -fill both
109
110    eval itk_initialize $args
111
112    # color spectrum for plotting "All" results
113    set c1 [lindex $itk_option(-colors) 0]
114    set c0 [lindex $itk_option(-colors) 1]
115    if {"" == $c0} { set c0 #d9d9d9 }
116    set _spectrum [Rappture::Spectrum ::#auto [list 0 $c0 1 $c1]]
117}
118
119# ----------------------------------------------------------------------
120# DESTRUCTOR
121# ----------------------------------------------------------------------
122itcl::body Rappture::ResultSet::destructor {} {
123    itcl::delete object $_results
124    itcl::delete object $_spectrum
125}
126
127# ----------------------------------------------------------------------
128# USAGE: add <xmlobj>
129#
130# Adds a new result to this result set.  Scans through all existing
131# results to look for a difference compared to previous results.
132# Returns an instruction to the caller, indicating how the various
133# data objects for this result set should be added to their result
134# viewers.
135# ----------------------------------------------------------------------
136itcl::body Rappture::ResultSet::add {xmlobj} {
137    # make sure we fix up controls at some point
138    $_dispatcher event -idle !fixcntls
139
140    #
141    # If this is the first result, then there are no diffs.
142    # Add it right in.
143    #
144    set xmlobj0 [$_results get -format xmlobj end]
145    if {"" == $xmlobj0} {
146        # first element -- always add
147        $_results insert end [list $xmlobj]
148        set _recent $xmlobj
149        $itk_component(status) configure -text "1 result"
150        $itk_component(clear) configure -state normal
151        return "add"
152    }
153
154    #
155    # Compare this new object against the last XML object in the
156    # results set.  If it has a difference, make sure that there
157    # is a column to represent the quantity with the difference.
158    #
159    foreach {op vpath oldval newval} [$xmlobj0 diff $xmlobj] {
160        if {[$xmlobj get $vpath.about.diffs] == "ignore"} {
161            continue
162        }
163        if {$op == "+" || $op == "-"} {
164            # ignore differences where parameters come and go
165            # such differences make it hard to work controls
166            continue
167        }
168        if {[$_results column names $vpath] == ""} {
169            # no column for this quantity yet
170            $_results column insert end -name $vpath -default $oldval
171        }
172    }
173
174    # build a tuple for this new object
175    set op "add"
176    set cols ""
177    set tuple ""
178    foreach col [lrange [$_results column names] 1 end] {
179        lappend cols $col
180        set raw [lindex [Rappture::LibraryObj::value $xmlobj $col] 0]
181        lappend tuple $raw  ;# use the "raw" (user-readable) label
182    }
183
184    # find a matching tuple? then replace it -- only need one
185    if {[llength $cols] > 0} {
186        set ilist [$_results find -format $cols -- $tuple]
187    } else {
188        set ilist 0  ;# no diffs -- must match first entry
189    }
190
191    # add all remaining columns for this new entry
192    set tuple [linsert $tuple 0 $xmlobj]
193
194    if {[llength $ilist] > 0} {
195        if {[llength $ilist] > 1} {
196            error "why so many matching results?"
197        }
198
199        # overwrite the first matching entry
200        set i [lindex $ilist 0]
201        $_results put $i $tuple
202        set _recent $xmlobj
203        set op "replace $i"
204
205    } else {
206        $_results insert end $tuple
207        set _recent $xmlobj
208    }
209
210    if {[$_results size] == 1} {
211        $itk_component(status) configure -text "1 result"
212    } else {
213        $itk_component(status) configure -text "[$_results size] results"
214    }
215    $itk_component(clear) configure -state normal
216
217    return $op
218}
219
220# ----------------------------------------------------------------------
221# USAGE: clear
222#
223# Clears all results in this result set.
224# ----------------------------------------------------------------------
225itcl::body Rappture::ResultSet::clear {} {
226    _doSettings
227
228    # delete all adjuster controls
229    set f [$itk_component(scroller) contents frame]
230    foreach w [winfo children $f] {
231        destroy $w
232    }
233    catch {unset _col2widget}
234    set _counter 0
235
236    # don't need to scroll adjustor controls right now
237    $itk_component(scroller) configure -yscrollmode off
238
239    # clear out all results
240    $_results delete 0 end
241    eval $_results column delete [lrange [$_results column names] 1 end]
242    set _recent ""
243
244    # update status and Clear button
245    $itk_component(status) configure -text "No results"
246    $itk_component(clear) configure -state disabled
247    $_dispatcher event -idle !fixcntls
248}
249
250# ----------------------------------------------------------------------
251# USAGE: contains <xmlobj>
252#
253# Checks to see if the given <xmlobj> is already represented by
254# some result in this result set.  This comes in handy when checking
255# to see if an input case is already covered.
256#
257# Returns 1 if the result set already contains this result, and
258# 0 otherwise.
259# ----------------------------------------------------------------------
260itcl::body Rappture::ResultSet::contains {xmlobj} {
261    # no results? then this must be new
262    if {[$_results size] == 0} {
263        return 0
264    }
265
266    #
267    # Compare this new object against the last XML object in the
268    # results set.  If it has a difference, make sure that there
269    # is a column to represent the quantity with the difference.
270    #
271    set xmlobj0 [$_results get -format xmlobj end]
272    foreach {op vpath oldval newval} [$xmlobj0 diff $xmlobj] {
273        if {[$xmlobj get $vpath.about.diffs] == "ignore"} {
274            continue
275        }
276        if {$op == "+" || $op == "-"} {
277            # ignore differences where parameters come and go
278            # such differences make it hard to work controls
279            continue
280        }
281        if {[$_results column names $vpath] == ""} {
282            # no column for this quantity yet
283            return 0
284        }
285    }
286
287    #
288    # If we got this far, then look through existing results for
289    # matching tuples, then check each one for diffs.
290    #
291    set format ""
292    set tuple ""
293    foreach col [lrange [$_results column names] 1 end] {
294        lappend format $col
295        set raw [lindex [Rappture::LibraryObj::value $xmlobj $col] 0]
296        lappend tuple $raw  ;# use the "raw" (user-readable) label
297    }
298    if {[llength $format] > 0} {
299        set ilist [$_results find -format $format -- $tuple]
300    } else {
301        set ilist 0  ;# no diffs -- must match first entry
302    }
303
304    foreach i $ilist {
305        set xmlobj0 [$_results get -format xmlobj $i]
306        set diffs [$xmlobj0 diff $xmlobj]
307        if {[llength $diffs] == 0} {
308            # no diffs -- already contained here
309            return 1
310        }
311    }
312
313    # must be some differences
314    return 0
315}
316
317
318# ----------------------------------------------------------------------
319# USAGE: size ?-results|-controls?
320#
321# Returns the number of results or the number of controls in this
322# result set.
323# ----------------------------------------------------------------------
324itcl::body Rappture::ResultSet::size {{what -results}} {
325    switch -- $what {
326        -results {
327            return [$_results size]
328        }
329        -controls {
330            return [array size _col2widget]
331        }
332        default {
333            error "bad option \"$what\": should be -results or -controls"
334        }
335    }
336}
337
338# ----------------------------------------------------------------------
339# USAGE: _doClear
340#
341# Invoked automatically when the user presses the Clear button.
342# Invokes the -clearcommand to clear all data from this resultset
343# and all other resultsets in an Analyzer.
344# ----------------------------------------------------------------------
345itcl::body Rappture::ResultSet::_doClear {} {
346    if {[string length $itk_option(-clearcommand)] > 0} {
347        uplevel #0 $itk_option(-clearcommand)
348    }
349}
350
351# ----------------------------------------------------------------------
352# USAGE: _doSettings ?<command>?
353#
354# Used internally whenever the result selection changes to invoke
355# the -settingscommand.  This will notify some external widget, which
356# with perform the plotting action specified in the <command>.
357# ----------------------------------------------------------------------
358itcl::body Rappture::ResultSet::_doSettings {{cmd ""}} {
359    if {[string length $itk_option(-settingscommand)] > 0} {
360        uplevel #0 $itk_option(-settingscommand) $cmd
361    }
362}
363
364# ----------------------------------------------------------------------
365# USAGE: _fixControls ?<eventArgs...>?
366#
367# Called automatically at the idle point after one or more results
368# have been added to this result set.  Scans through all existing
369# data and updates controls used to select the data.
370# ----------------------------------------------------------------------
371itcl::body Rappture::ResultSet::_fixControls {args} {
372    set f [$itk_component(scroller) contents frame]
373    grid columnconfigure $f 1 -weight 1
374
375    if {[$_results size] == 0} {
376        return
377    }
378
379    #
380    # Scan through all columns in the data and create any
381    # controls that just appeared.
382    #
383    foreach col [lrange [$_results column names] 1 end] {
384        set xmlobj [$_results get -format xmlobj 0]
385
386        #
387        # If this column doesn't have a control yet, then
388        # create one.
389        #
390        if {![info exists _col2widget($col)]} {
391            # add an "All" button to plot all results
392            label $f.all$_counter -text "All" -padx 8 \
393                -borderwidth 1 -relief raised -font $itk_option(-textfont)
394            grid $f.all$_counter -row $_counter -column 0 \
395                -padx 8 -pady 2 -sticky nsew
396            Rappture::Tooltip::for $f.all$_counter "Plot all values for this quantity"
397
398            bind $f.all$_counter <ButtonPress> \
399                [itcl::code $this _toggleAll $col $f.all$_counter]
400
401            # search for the first XML object with this element defined
402            foreach xmlobj [$_results get -format xmlobj] {
403                set str [$xmlobj get $col.about.label]
404                if {"" == $str} {
405                    set str [$xmlobj element -as id $col]
406                }
407                if {"" != $str} {
408                    break
409                }
410            }
411
412            if {"" != $str} {
413                set w $f.label$_counter
414                label $w -text $str -anchor w -font $itk_option(-boldfont)
415                grid $w -row $_counter -column 1 -sticky w
416
417                grid $f.all$_counter -rowspan 2
418                Rappture::Tooltip::for $f.all$_counter "Plot all values for $str"
419                incr _counter
420            }
421
422            set w $f.cntl$_counter
423            Rappture::Radiodial $w \
424                -activelinecolor [lindex $itk_option(-colors) 0]
425            grid $w -row $_counter -column 1 -sticky ew
426            bind $w <<Value>> \
427                [itcl::code $_dispatcher event -after 100 !settings]
428            set _col2widget($col) $w
429
430            incr _counter
431            grid rowconfigure $f $_counter -minsize 4
432            incr _counter
433
434            $itk_component(scroller) configure -yscrollmode auto
435
436            # let clients know that a new control appeared
437            # so they can fix the overall size accordingly
438            event generate $itk_component(hull) <<Control>>
439        }
440
441        #
442        # Determine the unique values for this column and load
443        # them into the control.
444        #
445        catch {unset values}
446        set havenums 1
447        set vlist ""
448        foreach rec [$_results get -format [list xmlobj $col]] {
449            set xo [lindex $rec 0]
450            set v [lindex $rec 1]
451
452            if {![info exists values($v)]} {
453                lappend vlist $v
454                foreach {raw norm} [Rappture::LibraryObj::value $xo $col] break
455                set values($v) $norm
456
457                if {$havenums && ![string is double $norm]} {
458                    set havenums 0
459                }
460            }
461        }
462
463        if {!$havenums} {
464            # don't have normalized nums? then sort and create nums
465            catch {unset values}
466
467            set n 0
468            foreach v [lsort $vlist] {
469                set values($v) [incr n]
470            }
471        }
472
473        # load the results into the control
474        set w $_col2widget($col)
475        $w clear
476        foreach v [array names values] {
477            $w add $v $values($v)
478        }
479    }
480
481    #
482    # Set all controls to the settings of the most recent
483    # addition.
484    #
485    if {"" != $_recent} {
486        foreach col [array names _col2widget] {
487            set raw [lindex [Rappture::LibraryObj::value $_recent $col] 0]
488            $_col2widget($col) current $raw
489        }
490    }
491
492    # fix the settings after everything settles
493    $_dispatcher event -after 100 !settings
494}
495
496# ----------------------------------------------------------------------
497# USAGE: _fixSettings ?<eventArgs...>?
498#
499# Called automatically at the idle point after a control has changed
500# to load new data into the plotting area at the top of this result
501# set.  Extracts the current tuple of control values from the control
502# area, then finds the corresponding data values.  Loads the data
503# by invoking a -settingscommand callback with parameters that
504# describe what data should be plotted.
505# ----------------------------------------------------------------------
506itcl::body Rappture::ResultSet::_fixSettings {args} {
507    _doPrompt off
508
509    switch -- [$_results size] {
510        0 {
511            # no data? then do nothing
512            return
513        }
514        1 {
515            # only one data set? then plot it
516            set color [lindex $itk_option(-colors) 0]
517            _doSettings [list 0 [list -color $color -width 2]]
518            return
519        }
520    }
521
522    #
523    # Search for tuples matching the current setting and
524    # plot them.
525    #
526    set format ""
527    set tuple ""
528    foreach col [lrange [$_results column names] 1 end] {
529        if {$col != $_plotall} {
530            lappend format $col
531            set w $_col2widget($col)
532            lappend tuple [$w get current]
533        }
534    }
535
536    if {"" != $format} {
537        set ilist [$_results find -format $format -- $tuple]
538    } else {
539        set ilist [$_results find]
540    }
541
542    if {[llength $ilist] > 0} {
543        # search for the result for these settings
544        set format ""
545        set tuple ""
546        foreach col [lrange [$_results column names] 1 end] {
547            lappend format $col
548            set w $_col2widget($col)
549            lappend tuple [$w get current]
550        }
551        set icurr [$_results find -format $format -- $tuple]
552
553        # no data for these settings? prompt the user to simulate
554        if {"" == $icurr} {
555            _doPrompt on
556        }
557
558        if {[llength $ilist] == 1} {
559            # single result -- always use active color
560            set i [lindex $ilist 0]
561            set color [lindex $itk_option(-colors) 0]
562            set plist [list $i [list -color $color -width 2]]
563        } else {
564            #
565            # Get the color for all points according to
566            # the color spectrum.
567            #
568            set plist ""
569            foreach i $ilist {
570                set v [lindex [$_results get -format $_plotall $i] 0]
571                set color [$_col2widget($_plotall) color $v]
572
573                if {$i == $icurr} {
574                    lappend plist $i [list -color $color -width 3 -raise 1]
575                } else {
576                    lappend plist $i [list -color $color -width 1]
577                }
578            }
579        }
580
581        #
582        # Load up the matching plots
583        #
584        _doSettings $plist
585    } else {
586        # prompt the user to simulate these settings
587        _doPrompt on
588    }
589}
590
591# ----------------------------------------------------------------------
592# USAGE: _doPrompt <state>
593#
594# Used internally whenever the current settings represent a point
595# with no data.  Invokes the -promptcommand with an explanation of
596# the missing data, prompting the user to simulate it.
597# ----------------------------------------------------------------------
598itcl::body Rappture::ResultSet::_doPrompt {state} {
599    if {[string length $itk_option(-promptcommand)] > 0} {
600        if {$state} {
601            set message "No data for these settings"
602            set settings ""
603            foreach col [lrange [$_results column names] 1 end] {
604                set w $_col2widget($col)
605                set val [$w get current]
606                lappend settings $col $val
607            }
608            uplevel #0 $itk_option(-promptcommand) [list on $message $settings]
609        } else {
610            uplevel #0 $itk_option(-promptcommand) off
611        }
612    }
613}
614
615# ----------------------------------------------------------------------
616# USAGE: _toggleAll <path> <widget>
617#
618# Called automatically whenever the user clicks on an "All" button.
619# Toggles the button between its on/off states.  In the "on" state,
620# all results associated with the <path> are sent to the result viewer.
621# ----------------------------------------------------------------------
622itcl::body Rappture::ResultSet::_toggleAll {path widget} {
623    if {[$widget cget -relief] == "sunken"} {
624        $widget configure -relief raised \
625            -background $itk_option(-background) \
626            -foreground $itk_option(-foreground)
627
628        set color [lindex $itk_option(-colors) 0]
629        $_col2widget($path) configure -activelinecolor $color
630
631        set _plotall ""
632    } else {
633        if {"" != $_plotall} {
634            set color [lindex $itk_option(-colors) 0]
635            $_col2widget($_plotall) configure -activelinecolor $color
636        }
637
638        # pop out all other "All" buttons
639        set f [$itk_component(scroller) contents frame]
640        for {set i 0} {$i < $_counter} {incr i} {
641            if {[winfo exists $f.all$i]} {
642                $f.all$i configure -relief raised \
643                    -background $itk_option(-background) \
644                    -foreground $itk_option(-foreground)
645            }
646        }
647
648        # push this one in
649        $widget configure -relief sunken \
650            -background $itk_option(-togglebackground) \
651            -foreground $itk_option(-toggleforeground)
652
653        # switch the "All" context to this path
654        set _plotall $path
655        $_col2widget($path) configure -activelinecolor $_spectrum
656    }
657    $_dispatcher event -idle !settings
658}
659
660# ----------------------------------------------------------------------
661# CONFIGURATION OPTION: -colors
662# ----------------------------------------------------------------------
663itcl::configbody Rappture::ResultSet::colors {
664    if {"" != $_spectrum} {
665        set c1 [lindex $itk_option(-colors) 0]
666        set c0 [lindex $itk_option(-colors) 1]
667        if {"" == $c0} { set c0 #d9d9d9 }
668
669        $_spectrum delete 0 end
670        $_spectrum insert end 0 $c0 1 $c1
671    }
672}
Note: See TracBrowser for help on using the repository browser.