source: branches/r9/gui/scripts/resultviewer.tcl @ 5106

Last change on this file since 5106 was 4261, checked in by gah, 10 years ago

initial map object

File size: 20.5 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: ResultViewer - plots a collection of related results
4#
5#  This widget plots a collection of results that all represent
6#  the same quantity, but for various ranges of input values.  It
7#  is normally used as part of an Analyzer, to plot the various
8#  results selected by a ResultSet.
9# ======================================================================
10#  AUTHOR:  Michael McLennan, Purdue University
11#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
12#
13#  See the file "license.terms" for information on usage and
14#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
15# ======================================================================
16package require Itk
17
18itcl::class Rappture::ResultViewer {
19    inherit itk::Widget
20
21    itk_option define -width width Width 4i
22    itk_option define -height height Height 4i
23    itk_option define -colors colors Colors ""
24    itk_option define -clearcommand clearCommand ClearCommand ""
25    itk_option define -simulatecommand simulateCommand SimulateCommand ""
26
27    constructor {args} {
28        # defined below
29    }
30    destructor {
31        # defined below
32    }
33    public method add {index xmlobj path}
34    public method clear {{index ""}}
35    public method value {xmlobj}
36
37    public method plot {option args}
38    public method download {option args}
39
40    protected method _plotAdd {xmlobj {settings ""}}
41    protected method _fixScale {args}
42    protected method _xml2data {xmlobj path}
43    protected method _cleanIndex {index}
44
45    private variable _dispatcher ""  ;# dispatchers for !events
46    private variable _mode ""        ;# current plotting mode (xy, etc.)
47    private variable _mode2widget    ;# maps plotting mode => widget
48    private variable _dataslots ""   ;# list of all data objects in this widget
49    private variable _xml2data       ;# maps xmlobj => data obj in _dataslots
50}
51
52itk::usual ResultViewer {
53    keep -background -foreground -cursor -font
54}
55
56# ----------------------------------------------------------------------
57# CONSTRUCTOR
58# ----------------------------------------------------------------------
59itcl::body Rappture::ResultViewer::constructor {args} {
60    # create a dispatcher for events
61    Rappture::dispatcher _dispatcher
62    $_dispatcher register !scale
63    $_dispatcher dispatch $this !scale \
64        [itcl::code $this _fixScale]
65
66    eval itk_initialize $args
67}
68
69# ----------------------------------------------------------------------
70# DESTRUCTOR
71# ----------------------------------------------------------------------
72itcl::body Rappture::ResultViewer::destructor {} {
73    foreach slot $_dataslots {
74        foreach obj $slot {
75            itcl::delete object $obj
76        }
77    }
78}
79
80# ----------------------------------------------------------------------
81# USAGE: add <index> <xmlobj> <path>
82#
83# Adds a new result to this result viewer at the specified <index>.
84# Data is taken from the <xmlobj> object at the <path>.
85# ----------------------------------------------------------------------
86itcl::body Rappture::ResultViewer::add {index xmlobj path} {
87    set index [_cleanIndex $index]
88    set dobj [_xml2data $xmlobj $path]
89
90    #
91    # If the index doesn't exist, then fill in empty slots and
92    # make it exist.
93    #
94    for {set i [llength $_dataslots]} {$i <= $index} {incr i} {
95        lappend _dataslots ""
96    }
97    set slot [lindex $_dataslots $index]
98    lappend slot $dobj
99    set _dataslots [lreplace $_dataslots $index $index $slot]
100
101    $_dispatcher event -idle !scale
102}
103
104# ----------------------------------------------------------------------
105# USAGE: clear ?<index>|<xmlobj>?
106#
107# Clears one or all results in this result viewer.  If a particular
108# <index> is specified, then all data objects at that index are
109# deleted.  If a particular <xmlobj> is specified, then all data
110# objects related to that <xmlobj> are removed--regardless of whether
111# they reside at one or more indices.
112# ----------------------------------------------------------------------
113itcl::body Rappture::ResultViewer::clear {{index ""}} {
114    if {$index ne ""} {
115        # clear one result
116        if {[catch {_cleanIndex $index} i] == 0} {
117            if {$i >= 0 && $i < [llength $_dataslots]} {
118                set slot [lindex $_dataslots $i]
119                foreach dobj $slot {
120                    if {"" != $_mode} {
121                        $_mode2widget($_mode) delete $dobj
122                    }
123                    itcl::delete object $dobj
124                }
125                set _dataslots [lreplace $_dataslots $i $i ""]
126                $_dispatcher event -idle !scale
127            }
128        } else {
129            foreach key [array names _xml2data $index-*] {
130                set dobj $_xml2data($key)
131
132                # search for and remove all references to this data object
133                for {set n 0} {$n < [llength $_dataslots]} {incr n} {
134                    set slot [lindex $_dataslots $n]
135                    set pos [lsearch -exact $slot $dobj]
136                    if {$pos >= 0} {
137                        set slot [lreplace $slot $pos $pos]
138                        set _dataslots [lreplace $_dataslots $n $n $slot]
139                        $_dispatcher event -idle !scale
140                    }
141                }
142
143                if {"" != $_mode} {
144                    $_mode2widget($_mode) delete $dobj
145                }
146                # destroy the object and forget it
147                itcl::delete object $dobj
148                unset _xml2data($key)
149            }
150        }
151    } else {
152        # clear all results
153        plot clear
154        foreach slot $_dataslots {
155            foreach dobj $slot {
156                itcl::delete object $dobj
157            }
158        }
159        set _dataslots ""
160        catch {unset _xml2data}
161    }
162}
163
164# ----------------------------------------------------------------------
165# USAGE: value <xmlobj>
166#
167# Convenience method for showing a single value.  Loads the value
168# into the widget via add/clear, then immediately plots the value.
169# This makes the widget consistent with other widgets, such as
170# the DeviceEditor, etc.
171# ----------------------------------------------------------------------
172itcl::body Rappture::ResultViewer::value {xmlobj} {
173    clear
174    if {"" != $xmlobj} {
175        add 0 $xmlobj ""
176        plot add 0 ""
177    }
178}
179
180# ----------------------------------------------------------------------
181# USAGE: plot add ?<simnum> <settings> <simnum> <settings> ...?
182# USAGE: plot clear
183#
184# Used to manipulate the contents of this viewer.  The "plot clear"
185# command clears the current viewer.  Data is still stored in the
186# widget, but the results are not shown on screen.  The "plot add"
187# command adds the data at the specified <simnum> to the plot.  Each
188# <simnum> is the simulation number, like "#1", "#2", "#3", etc.  If
189# the optional <settings> are specified, then they are applied
190# to the plot; otherwise, default settings are used.
191# ----------------------------------------------------------------------
192itcl::body Rappture::ResultViewer::plot {option args} {
193    switch -- $option {
194        add {
195            set params ""
196            foreach {index opts} $args {
197                if {$index == "params"} {
198                    set params $opts
199                    continue
200                }
201
202                set index [_cleanIndex $index]
203                lappend opts "-simulation" [expr $index + 1]
204                set reset "-color autoreset"
205                set slot [lindex $_dataslots $index]
206                foreach dobj $slot {
207                    set settings ""
208                    # start with color reset, only for first object in series
209                    if {"" != $reset} {
210                        set settings $reset
211                        set reset ""
212                    }
213                    # add default settings from data object
214                    if {[catch {$dobj hints style} style] == 0} {
215                        eval lappend settings $style
216                    }
217                    if {[catch {$dobj hints type} type] == 0} {
218                        if {"" != $type} {
219                            eval lappend settings "-type $type"
220                        }
221                    }
222                    # add override settings passed in here
223                    eval lappend settings $opts
224                    _plotAdd $dobj $settings
225                }
226            }
227            if {"" != $params && "" != $_mode} {
228                eval $_mode2widget($_mode) parameters $params
229            }
230        }
231        clear {
232            # clear the contents of the current mode
233            if {"" != $_mode} {
234                $_mode2widget($_mode) delete
235            }
236        }
237        default {
238            error "bad option \"$option\": should be add or clear"
239        }
240    }
241}
242
243# ----------------------------------------------------------------------
244# USAGE: _plotAdd <dataobj> <settings>
245#
246# Used internally to add a <dataobj> representing some data to
247# the plot at the top of this widget.  The data is added to the
248# current plot.  Use the "clear" function to clear before adding
249# new data.
250# ----------------------------------------------------------------------
251itcl::body Rappture::ResultViewer::_plotAdd {dataobj {settings ""}} {
252    switch -- [$dataobj info class] {
253        ::Rappture::DataTable {
254            set mode "datatable"
255            if {![info exists _mode2widget($mode)]} {
256                set w $itk_interior.datatable
257                Rappture::DataTableResult $w
258                set _mode2widget($mode) $w
259            }
260        }
261        ::Rappture::Drawing {
262            set mode "vtkviewer"
263            if {![info exists _mode2widget($mode)]} {
264                set servers [Rappture::VisViewer::GetServerList "vtkvis"]
265                set w $itk_interior.vtkviewer
266                Rappture::VtkViewer $w $servers
267                set _mode2widget($mode) $w
268            }
269        }
270        ::Rappture::Histogram {
271            set mode "histogram"
272            if {![info exists _mode2widget($mode)]} {
273                set w $itk_interior.histogram
274                Rappture::HistogramResult $w
275                set _mode2widget($mode) $w
276            }
277        }
278        ::Rappture::Curve {
279            set type [$dataobj hints type]
280            set mode "xy"
281            if { $type == "bars" } {
282                if {![info exists _mode2widget($mode)]} {
283                    set w $itk_interior.xy
284                    Rappture::BarchartResult $w
285                    set _mode2widget($mode) $w
286                }
287            } else {
288                if {![info exists _mode2widget($mode)]} {
289                    set w $itk_interior.xy
290                    Rappture::XyResult $w
291                    set _mode2widget($mode) $w
292                }
293            }
294        }
295        ::Rappture::Map {
296            if { ![$dataobj isvalid] } {
297                return;                 # Ignore invalid map objects.
298            }
299            set mode "map"
300            if {![info exists _mode2widget($mode)]} {
301                set servers [Rappture::VisViewer::GetServerList "geovis"]
302                set w $itk_interior.$mode
303                Rappture::MapViewer $w $servers
304                set _mode2widget($mode) $w
305            }
306        }
307        ::Rappture::Field {
308            if { ![$dataobj isvalid] } {
309                return;                 # Ignore invalid field objects.
310            }
311            set dims [lindex [lsort [$dataobj components -dimensions]] end]
312            switch -- $dims {
313                1D {
314                    set mode "xy"
315                    if {![info exists _mode2widget($mode)]} {
316                        set w $itk_interior.xy
317                        Rappture::XyResult $w
318                        set _mode2widget($mode) $w
319                    }
320                }
321                default {
322                    set mode [$dataobj viewer]
323                    if {![info exists _mode2widget($mode)]} {
324                        set w $itk_interior.$mode
325                        if { ![winfo exists $w] } {
326                            Rappture::FieldResult $w -mode $mode
327                        }
328                        set _mode2widget($mode) $w
329                    }
330                }
331            }
332        }
333        ::Rappture::Mesh {
334            if { ![$dataobj isvalid] } {
335                return;                 # Ignore invalid mesh objects.
336            }
337            set mode "vtkmeshviewer"
338            if {![info exists _mode2widget($mode)]} {
339                set servers [Rappture::VisViewer::GetServerList "vtkvis"]
340                set w $itk_interior.$mode
341                Rappture::VtkMeshViewer $w $servers
342                set _mode2widget($mode) $w
343            }
344        }
345        ::Rappture::Table {
346            set cols [Rappture::EnergyLevels::columns $dataobj]
347            if {"" != $cols} {
348                set mode "energies"
349                if {![info exists _mode2widget($mode)]} {
350                    set w $itk_interior.energies
351                    Rappture::EnergyLevels $w
352                    set _mode2widget($mode) $w
353                }
354            }
355        }
356        ::Rappture::LibraryObj {
357            switch -- [$dataobj element -as type] {
358                string - log {
359                    set mode "log"
360                    if {![info exists _mode2widget($mode)]} {
361                        set w $itk_interior.log
362                        Rappture::TextResult $w
363                        set _mode2widget($mode) $w
364                    }
365                }
366                structure {
367                    set mode "structure"
368                    if {![info exists _mode2widget($mode)]} {
369                        set w $itk_interior.struct
370                        Rappture::DeviceResult $w
371                        set _mode2widget($mode) $w
372                    }
373                }
374                number - integer {
375                    set mode "number"
376                    if {![info exists _mode2widget($mode)]} {
377                        set w $itk_interior.number
378                        Rappture::NumberResult $w
379                        set _mode2widget($mode) $w
380                    }
381                }
382                boolean - choice {
383                    set mode "value"
384                    if {![info exists _mode2widget($mode)]} {
385                        set w $itk_interior.value
386                        Rappture::ValueResult $w
387                        set _mode2widget($mode) $w
388                    }
389                }
390            }
391        }
392        ::Rappture::Image {
393            set mode "image"
394            if {![info exists _mode2widget($mode)]} {
395                set w $itk_interior.image
396                Rappture::ImageResult $w
397                set _mode2widget($mode) $w
398            }
399        }
400        ::Rappture::Sequence {
401            set mode "sequence"
402            if {![info exists _mode2widget($mode)]} {
403                set w $itk_interior.image
404                Rappture::SequenceResult $w
405                set _mode2widget($mode) $w
406            }
407        }
408        default {
409            error "don't know how to plot <$type> data [$dataobj info class]"
410        }
411    }
412
413    if {$mode != $_mode && $_mode != ""} {
414        set nactive [llength [$_mode2widget($_mode) get]]
415        if {$nactive > 0} {
416            return  ;# mixing data that doesn't mix -- ignore it!
417        }
418    }
419    # Are we plotting in a new mode? then change widgets
420    if {$_mode2widget($mode) != [pack slaves $itk_interior]} {
421        # remove any current window
422        foreach w [pack slaves $itk_interior] {
423            pack forget $w
424        }
425        pack $_mode2widget($mode) -expand yes -fill both
426
427        set _mode $mode
428        $_dispatcher event -idle !scale
429    }
430    $_mode2widget($mode) add $dataobj $settings
431}
432
433# ----------------------------------------------------------------------
434# USAGE: _fixScale ?<eventArgs>...?
435#
436# Invoked automatically whenever a new dataset is added to fix the
437# overall scales of the viewer.  This makes the visualizer consistent
438# across all <dataobj> in this widget, so that it can plot all
439# available data.
440# ----------------------------------------------------------------------
441itcl::body Rappture::ResultViewer::_fixScale {args} {
442    if {"" != $_mode} {
443        set dlist ""
444        foreach slot $_dataslots {
445            foreach dobj $slot {
446                lappend dlist $dobj
447            }
448        }
449        eval $_mode2widget($_mode) scale $dlist
450    }
451}
452
453# ----------------------------------------------------------------------
454# USAGE: download coming
455# USAGE: download controls <downloadCommand>
456# USAGE: download now
457#
458# Clients use this method to create a downloadable representation
459# of the plot.  Returns a list of the form {ext string}, where
460# "ext" is the file extension (indicating the type of data) and
461# "string" is the data itself.
462# ----------------------------------------------------------------------
463itcl::body Rappture::ResultViewer::download {option args} {
464    if {"" == $_mode} {
465        return ""
466    }
467    return [eval $_mode2widget($_mode) download $option $args]
468}
469
470# ----------------------------------------------------------------------
471# USAGE: _xml2data <xmlobj> <path>
472#
473# Used internally to create a data object for the data at the
474# specified <path> in the <xmlobj>.
475# ----------------------------------------------------------------------
476itcl::body Rappture::ResultViewer::_xml2data {xmlobj path} {
477    if {[info exists _xml2data($xmlobj-$path)]} {
478        return $_xml2data($xmlobj-$path)
479    }
480
481    set type [$xmlobj element -as type $path]
482    switch -- $type {
483        curve {
484            set dobj [Rappture::Curve ::#auto $xmlobj $path]
485        }
486        datatable {
487            set dobj [Rappture::DataTable ::#auto $xmlobj $path]
488        }
489        histogram {
490            set dobj [Rappture::Histogram ::#auto $xmlobj $path]
491        }
492        field {
493            set dobj [Rappture::Field ::#auto $xmlobj $path]
494        }
495        map {
496            set dobj [Rappture::Map ::#auto $xmlobj $path]
497        }
498        mesh {
499            set dobj [Rappture::Mesh ::#auto $xmlobj $path]
500        }
501        table {
502            set dobj [Rappture::Table ::#auto $xmlobj $path]
503        }
504        image {
505            set dobj [Rappture::Image ::#auto $xmlobj $path]
506        }
507        sequence {
508            set dobj [Rappture::Sequence ::#auto $xmlobj $path]
509        }
510        string - log {
511            set dobj [$xmlobj element -as object $path]
512        }
513        structure {
514            set dobj [$xmlobj element -as object $path]
515        }
516        number - integer - boolean - choice {
517            set dobj [$xmlobj element -as object $path]
518        }
519        drawing3d - drawing {
520            set dobj [Rappture::Drawing ::#auto $xmlobj $path]
521        }
522        time - status {
523            set dobj ""
524        }
525        default {
526            error "don't know how to plot <$type> data path=$path"
527        }
528    }
529
530    # store the mapping xmlobj=>dobj so we can find this result later
531    if {$dobj ne ""} {
532        set _xml2data($xmlobj-$path) $dobj
533    }
534    return $dobj
535}
536
537# ----------------------------------------------------------------------
538# USAGE: _cleanIndex <index>
539#
540# Used internally to create a data object for the data at the
541# specified <path> in the <xmlobj>.
542# ----------------------------------------------------------------------
543itcl::body Rappture::ResultViewer::_cleanIndex {index} {
544    set index [lindex $index 0]
545    if {[regexp {^#([0-9]+)} $index match num]} {
546        return [expr {$num-1}]  ;# start from 0 instead of 1
547    } elseif {[string is integer -strict $index]} {
548        return $index
549    }
550    error "bad plot index \"$index\": should be 0,1,2,... or #1,#2,#3,..."
551}
552
553# ----------------------------------------------------------------------
554# CONFIGURATION OPTION: -width
555# ----------------------------------------------------------------------
556itcl::configbody Rappture::ResultViewer::width {
557    set w [winfo pixels $itk_component(hull) $itk_option(-width)]
558    set h [winfo pixels $itk_component(hull) $itk_option(-height)]
559    if {$w == 0 || $h == 0} {
560        pack propagate $itk_component(hull) yes
561    } else {
562        component hull configure -width $w -height $h
563        pack propagate $itk_component(hull) no
564    }
565}
566
567# ----------------------------------------------------------------------
568# CONFIGURATION OPTION: -height
569# ----------------------------------------------------------------------
570itcl::configbody Rappture::ResultViewer::height {
571    set h [winfo pixels $itk_component(hull) $itk_option(-height)]
572    set w [winfo pixels $itk_component(hull) $itk_option(-width)]
573    if {$w == 0 || $h == 0} {
574        pack propagate $itk_component(hull) yes
575    } else {
576        component hull configure -width $w -height $h
577        pack propagate $itk_component(hull) no
578    }
579}
Note: See TracBrowser for help on using the repository browser.