source: branches/1.6/gui/scripts/datatableresult.tcl @ 6131

Last change on this file since 6131 was 5679, checked in by ldelgass, 9 years ago

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