source: branches/1.3/gui/scripts/datatableresult.tcl @ 4706

Last change on this file since 4706 was 3800, checked in by gah, 11 years ago

add -simulation to plotadd calls
File size: 13.3 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2
3# ----------------------------------------------------------------------
4#  COMPONENT: datatableresult - X/Y plot in a ResultSet
5#
6#  This widget is an X/Y plot, meant to view line graphs produced
7#  as output from the run of a Rappture tool.  Use the "add" and
8#  "delete" methods to control the dataobjs showing on the plot.
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
17package require BLT
18
19option add *DataTableResult.width 3i widgetDefault
20option add *DataTableResult.height 3i widgetDefault
21option add *DataTableResult.gridColor #d9d9d9 widgetDefault
22option add *DataTableResult.activeColor blue widgetDefault
23option add *DataTableResult.dimColor gray widgetDefault
24option add *DataTableResult.controlBackground gray widgetDefault
25option add *DataTableResult.font \
26    -*-helvetica-medium-r-normal-*-12-* widgetDefault
27
28option add *DataTableResult*Balloon*Entry.background white widgetDefault
29
30itk::usual TreeView {
31    keep -foreground -cursor
32}
33
34itcl::class Rappture::DataTableResult {
35    inherit itk::Widget
36
37    itk_option define -gridcolor gridColor GridColor ""
38    itk_option define -activecolor activeColor ActiveColor ""
39    itk_option define -dimcolor dimColor DimColor ""
40
41    private variable _tree ""
42
43    constructor {args} {
44        # defined below
45    }
46    destructor {
47        # defined below
48    }
49    public method add {dataobj {settings ""}}
50    public method get {}
51    public method delete {args}
52    public method scale {args} {
53        # Do nothing
54    }
55    public method snap { w h }
56    public method tooltip { desc x y }
57    public method parameters {title args} {
58        # do nothing
59    }
60    public method download {option args}
61
62    protected method Rebuild {}
63
64    private variable _dispatcher "" ;# dispatcher for !events
65    private variable _dlist ""     ;# list of dataobj objects
66    private variable _dataobj2color  ;# maps dataobj => plotting color
67    private variable _dataobj2width  ;# maps dataobj => line width
68    private variable _dataobj2dashes ;# maps dataobj => BLT -dashes list
69    private variable _dataobj2raise  ;# maps dataobj => raise flag 0/1
70    private variable _raised    "";
71    common _downloadPopup          ;# download options from popup
72}
73                                                                               
74itk::usual DataTableResult {
75    keep -background -foreground -cursor -font
76}
77
78# ----------------------------------------------------------------------
79# CONSTRUCTOR
80# ----------------------------------------------------------------------
81itcl::body Rappture::DataTableResult::constructor {args} {
82    if { [catch {
83    Rappture::dispatcher _dispatcher
84    $_dispatcher register !rebuild
85    $_dispatcher dispatch $this !rebuild "[itcl::code $this Rebuild]; list"
86
87    array set _downloadPopup {
88        format csv
89    }
90    option add hull.width hull.height
91    pack propagate $itk_component(hull) no
92
93    set _tree [blt::tree create]
94    Rappture::Scroller $itk_interior.scroller \
95        -xscrollmode auto -yscrollmode auto
96
97    itk_component add treeview {
98        blt::treeview $itk_interior.scroller.tv -borderwidth 1 \
99            -highlightthickness 0 -tree $_tree
100    } {
101        usual
102        ignore -borderwidth -highlightthickness
103    }
104    $itk_component(treeview) style textbox lowered -background grey95
105    $itk_component(treeview) style textbox raised -background white
106    $itk_interior.scroller contents $itk_component(treeview)
107    pack $itk_interior.scroller -fill both -expand yes
108    eval itk_initialize $args
109    } err] != 0} {
110        puts stderr errs=$err
111    }
112}
113
114# ----------------------------------------------------------------------
115# DESTRUCTOR
116# ----------------------------------------------------------------------
117itcl::body Rappture::DataTableResult::destructor {} {
118    if { $_tree != "" } {
119        blt::tree destroy $_tree
120    }
121}
122
123# ----------------------------------------------------------------------
124# USAGE: add <dataobj> ?<settings>?
125#
126# Clients use this to add a dataobj to the plot.  The optional <settings>
127# are used to configure the plot.  Allowed settings are -color,
128# -brightness, -width, -linestyle and -raise.
129# ----------------------------------------------------------------------
130itcl::body Rappture::DataTableResult::add {dataobj {settings ""}} {
131    array set params {
132        -color auto
133        -brightness 0
134        -width 1
135        -type "line"
136        -raise 0
137        -linestyle solid
138        -description ""
139        -param ""
140    }
141    array set params $settings
142    if { $params(-raise) } {
143        set _raised $dataobj
144    }
145    lappend _dlist $dataobj
146    $_dispatcher event -idle !rebuild
147}
148
149# ----------------------------------------------------------------------
150# USAGE: get
151#
152# Clients use this to query the list of objects being plotted, in
153# order from bottom to top of this result.
154# ----------------------------------------------------------------------
155itcl::body Rappture::DataTableResult::get {} {
156    return $_dlist
157}
158
159# ----------------------------------------------------------------------
160# USAGE: delete ?<dataobj1> <dataobj2> ...?
161#
162# Clients use this to delete a dataobj from the plot.  If no dataobjs
163# are specified, then all dataobjs are deleted.
164# ----------------------------------------------------------------------
165itcl::body Rappture::DataTableResult::delete {args} {
166    if {[llength $args] == 0} {
167        set args $_dlist
168    }
169    # delete all specified dataobjs
170    set changed 0
171    foreach dataobj $args {
172        if { $dataobj == $_raised } {
173            set _raised ""
174        }
175        set pos [lsearch -exact $_dlist $dataobj]
176        if {$pos >= 0} {
177            set _dlist [lreplace $_dlist $pos $pos]
178            set changed 1
179        }
180    }
181    set _raised [lindex $_dlist 0]
182    # If anything changed, then rebuild the table
183    if {$changed} {
184        $_dispatcher event -idle !rebuild
185    }
186}
187
188# ----------------------------------------------------------------------
189# USAGE: download coming
190# USAGE: download controls <downloadCommand>
191# USAGE: download now
192#
193# Clients use this method to create a downloadable representation
194# of the plot.  Returns a list of the form {ext string}, where
195# "ext" is the file extension (indicating the type of data) and
196# "string" is the data itself.
197# ----------------------------------------------------------------------
198itcl::body Rappture::DataTableResult::download {option args} {
199    switch $option {
200        coming {
201            # nothing to do
202        }
203        controls {
204            set popup .datatableresultdownload
205            if {![winfo exists .datatableresultdownload]} {
206                # if we haven't created the popup yet, do it now
207                Rappture::Balloon $popup \
208                    -title "[Rappture::filexfer::label downloadWord] as..."
209                set inner [$popup component inner]
210                label $inner.summary -text "" -anchor w
211                pack $inner.summary -side top
212                radiobutton $inner.datatable \
213                    -text "Data as Comma-Separated Values" \
214                    -variable Rappture::DataTableResult::_downloadPopup(format) \
215                    -value csv
216                pack $inner.datatable -anchor w
217                button $inner.go -text [Rappture::filexfer::label download] \
218                    -command [lindex $args 0]
219                pack $inner.go -pady 4
220            } else {
221                set inner [$popup component inner]
222            }
223            set num [llength [get]]
224            set num [expr {($num == 1) ? "1 result" : "$num results"}]
225            $inner.summary configure -text "[Rappture::filexfer::label downloadWord] $num in the following format:"
226            update idletasks ;# fix initial sizes
227            return $popup
228        }
229        now {
230            set popup .datatableresultdownload
231            if {[winfo exists .datatableresultdownload]} {
232                $popup deactivate
233            }
234            switch -- $_downloadPopup(format) {
235                csv {
236                    # reverse the objects so the selected data appears on top
237                    set dlist ""
238                    foreach dataobj [get] {
239                        set dlist [linsert $dlist 0 $dataobj]
240                    }
241
242                    # generate the comma-separated value data for these objects
243                    set csvdata ""
244                    foreach dataobj $dlist {
245                        append csvdata "[string repeat - 60]\n"
246                        append csvdata " [$dataobj hints label]\n"
247                        if {[info exists _dataobj2desc($dataobj)]
248                            && [llength [split $_dataobj2desc($dataobj) \n]] > 1} {
249                            set indent "for:"
250                            foreach line [split $_dataobj2desc($dataobj) \n] {
251                                append csvdata " $indent $line\n"
252                                set indent "    "
253                            }
254                        }
255                        append csvdata "[string repeat - 60]\n"
256
257                        append csvdata "[$dataobj hints xlabel], [$dataobj hints ylabel]\n"
258                        set first 1
259                        foreach comp [$dataobj components] {
260                            if {!$first} {
261                                # blank line between components
262                                append csvdata "\n"
263                            }
264                            set xv [$dataobj mesh $comp]
265                            set yv [$dataobj values $comp]
266                            foreach x [$xv values] y [$yv values] {
267                                append csvdata [format "%20.15g, %20.15g\n" $x $y]
268                            }
269                            set first 0
270                        }
271                        append csvdata "\n"
272                    }
273                    return [list .txt $csvdata]
274                }
275            }
276        }
277        default {
278            error "bad option \"$option\": should be coming, controls, now"
279        }
280    }
281}
282
283# ----------------------------------------------------------------------
284# USAGE: Rebuild
285#
286# Called automatically whenever something changes that affects the
287# data in the widget.  Clears any existing data and rebuilds the
288# widget to display new data.
289# ----------------------------------------------------------------------
290itcl::body Rappture::DataTableResult::Rebuild {} {
291    eval $_tree delete [$_tree children 0]
292   
293    foreach dataobj $_dlist {
294        scan $dataobj "::dataTable%d" suffix
295        incr suffix
296
297        set newtree [$dataobj values]
298        # Copy the data object's tree onto our tree.
299        set dest [$_tree firstchild 0]
300        foreach src [$newtree children 0] {
301            if { $dest == -1 } {
302                set dest [$_tree insert 0]
303            }
304            foreach {name value} [$newtree get $src] {
305                set label "$name \#$suffix"
306                $_tree set $dest $label $value
307                set labels($label) 1
308            }
309            set dest [$_tree nextsibling $dest]
310        }
311    }
312    foreach col [$itk_component(treeview) column names] {
313        if { [string match "BLT TreeView*" $col] } {
314            continue
315        }
316        $itk_component(treeview) column delete $col
317    }
318    $itk_component(treeview) column configure treeView -hide yes
319    set dataobj [lindex $_dlist 0]
320    if { $dataobj != "" } {
321        foreach { label description style } [$dataobj columns] {
322            foreach c [lsort -dictionary [array names labels $label*]] {
323                eval $itk_component(treeview) column insert end [list $c] $style
324                $itk_component(treeview) column bind $c <Enter> \
325                    [itcl::code $this tooltip $description %X %Y]
326                $itk_component(treeview) column bind $c <Leave> \
327                    { Rappture::Tooltip::tooltip cancel }
328            }
329        }   
330    }
331    if { [llength $_dlist] == 1 } {
332        foreach { label description style } [$dataobj columns] {
333            foreach c [lsort -dictionary [array names labels $label*]] {
334                $itk_component(treeview) column configure $c -text $label
335            }
336        }   
337    }
338    if { $_raised != "" } {
339        foreach c [$itk_component(treeview) column names] {
340            $itk_component(treeview) column configure $c -style lowered
341        }
342        scan $_raised "::dataTable%d" suffix
343        incr suffix
344        foreach { label description style } [$_raised columns] {
345            set c "$label \#$suffix"
346            $itk_component(treeview) column configure $c -style raised
347        }
348    }
349}
350
351itcl::body Rappture::DataTableResult::snap { w h } {
352    set g $itk_component(plot)
353    if { $w <= 0 || $h <= 0 } {
354        set w [winfo width $g]
355        set h [winfo height $g]
356    }
357    set img [image create picture -width $w -height $h]
358    $g snap $img -width $w -height $h
359    return $img
360}
361
362itcl::body Rappture::DataTableResult::tooltip { description x y } {
363    Rappture::Tooltip::text $itk_component(treeview) $description
364    Rappture::Tooltip::tooltip pending $itk_component(treeview) @$x,$y
365}
Note: See TracBrowser for help on using the repository browser.