source: trunk/gui/scripts/datatableresult.tcl @ 3394

Last change on this file since 3394 was 3330, checked in by gah, 11 years ago

merge (by hand) with Rappture1.2 branch
File size: 13.5 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    foreach {opt val} $settings {
142        if {![info exists params($opt)]} {
143            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
144        }
145        set params($opt) $val
146    }
147    if { $params(-raise) } {
148        set _raised $dataobj
149    }
150    lappend _dlist $dataobj
151    $_dispatcher event -idle !rebuild
152}
153
154# ----------------------------------------------------------------------
155# USAGE: get
156#
157# Clients use this to query the list of objects being plotted, in
158# order from bottom to top of this result.
159# ----------------------------------------------------------------------
160itcl::body Rappture::DataTableResult::get {} {
161    return $_dlist
162}
163
164# ----------------------------------------------------------------------
165# USAGE: delete ?<dataobj1> <dataobj2> ...?
166#
167# Clients use this to delete a dataobj from the plot.  If no dataobjs
168# are specified, then all dataobjs are deleted.
169# ----------------------------------------------------------------------
170itcl::body Rappture::DataTableResult::delete {args} {
171    if {[llength $args] == 0} {
172        set args $_dlist
173    }
174    # delete all specified dataobjs
175    set changed 0
176    foreach dataobj $args {
177        if { $dataobj == $_raised } {
178            set _raised ""
179        }
180        set pos [lsearch -exact $_dlist $dataobj]
181        if {$pos >= 0} {
182            set _dlist [lreplace $_dlist $pos $pos]
183            set changed 1
184        }
185    }
186    set _raised [lindex $_dlist 0]
187    # If anything changed, then rebuild the table
188    if {$changed} {
189        $_dispatcher event -idle !rebuild
190    }
191}
192
193# ----------------------------------------------------------------------
194# USAGE: download coming
195# USAGE: download controls <downloadCommand>
196# USAGE: download now
197#
198# Clients use this method to create a downloadable representation
199# of the plot.  Returns a list of the form {ext string}, where
200# "ext" is the file extension (indicating the type of data) and
201# "string" is the data itself.
202# ----------------------------------------------------------------------
203itcl::body Rappture::DataTableResult::download {option args} {
204    switch $option {
205        coming {
206            # nothing to do
207        }
208        controls {
209            set popup .datatableresultdownload
210            if {![winfo exists .datatableresultdownload]} {
211                # if we haven't created the popup yet, do it now
212                Rappture::Balloon $popup \
213                    -title "[Rappture::filexfer::label downloadWord] as..."
214                set inner [$popup component inner]
215                label $inner.summary -text "" -anchor w
216                pack $inner.summary -side top
217                radiobutton $inner.datatable \
218                    -text "Data as Comma-Separated Values" \
219                    -variable Rappture::DataTableResult::_downloadPopup(format) \
220                    -value csv
221                pack $inner.datatable -anchor w
222                button $inner.go -text [Rappture::filexfer::label download] \
223                    -command [lindex $args 0]
224                pack $inner.go -pady 4
225            } else {
226                set inner [$popup component inner]
227            }
228            set num [llength [get]]
229            set num [expr {($num == 1) ? "1 result" : "$num results"}]
230            $inner.summary configure -text "[Rappture::filexfer::label downloadWord] $num in the following format:"
231            update idletasks ;# fix initial sizes
232            return $popup
233        }
234        now {
235            set popup .datatableresultdownload
236            if {[winfo exists .datatableresultdownload]} {
237                $popup deactivate
238            }
239            switch -- $_downloadPopup(format) {
240                csv {
241                    # reverse the objects so the selected data appears on top
242                    set dlist ""
243                    foreach dataobj [get] {
244                        set dlist [linsert $dlist 0 $dataobj]
245                    }
246
247                    # generate the comma-separated value data for these objects
248                    set csvdata ""
249                    foreach dataobj $dlist {
250                        append csvdata "[string repeat - 60]\n"
251                        append csvdata " [$dataobj hints label]\n"
252                        if {[info exists _dataobj2desc($dataobj)]
253                            && [llength [split $_dataobj2desc($dataobj) \n]] > 1} {
254                            set indent "for:"
255                            foreach line [split $_dataobj2desc($dataobj) \n] {
256                                append csvdata " $indent $line\n"
257                                set indent "    "
258                            }
259                        }
260                        append csvdata "[string repeat - 60]\n"
261
262                        append csvdata "[$dataobj hints xlabel], [$dataobj hints ylabel]\n"
263                        set first 1
264                        foreach comp [$dataobj components] {
265                            if {!$first} {
266                                # blank line between components
267                                append csvdata "\n"
268                            }
269                            set xv [$dataobj mesh $comp]
270                            set yv [$dataobj values $comp]
271                            foreach x [$xv values] y [$yv values] {
272                                append csvdata [format "%20.15g, %20.15g\n" $x $y]
273                            }
274                            set first 0
275                        }
276                        append csvdata "\n"
277                    }
278                    return [list .txt $csvdata]
279                }
280            }
281        }
282        default {
283            error "bad option \"$option\": should be coming, controls, now"
284        }
285    }
286}
287
288# ----------------------------------------------------------------------
289# USAGE: Rebuild
290#
291# Called automatically whenever something changes that affects the
292# data in the widget.  Clears any existing data and rebuilds the
293# widget to display new data.
294# ----------------------------------------------------------------------
295itcl::body Rappture::DataTableResult::Rebuild {} {
296    eval $_tree delete [$_tree children 0]
297   
298    foreach dataobj $_dlist {
299        scan $dataobj "::dataTable%d" suffix
300        incr suffix
301
302        set newtree [$dataobj values]
303        # Copy the data object's tree onto our tree.
304        set dest [$_tree firstchild 0]
305        foreach src [$newtree children 0] {
306            if { $dest == -1 } {
307                set dest [$_tree insert 0]
308            }
309            foreach {name value} [$newtree get $src] {
310                set label "$name \#$suffix"
311                $_tree set $dest $label $value
312                set labels($label) 1
313            }
314            set dest [$_tree nextsibling $dest]
315        }
316    }
317    foreach col [$itk_component(treeview) column names] {
318        if { [string match "BLT TreeView*" $col] } {
319            continue
320        }
321        $itk_component(treeview) column delete $col
322    }
323    $itk_component(treeview) column configure treeView -hide yes
324    set dataobj [lindex $_dlist 0]
325    if { $dataobj != "" } {
326        foreach { label description style } [$dataobj columns] {
327            foreach c [lsort -dictionary [array names labels $label*]] {
328                eval $itk_component(treeview) column insert end [list $c] $style
329                $itk_component(treeview) column bind $c <Enter> \
330                    [itcl::code $this tooltip $description %X %Y]
331                $itk_component(treeview) column bind $c <Leave> \
332                    { Rappture::Tooltip::tooltip cancel }
333            }
334        }   
335    }
336    if { [llength $_dlist] == 1 } {
337        foreach { label description style } [$dataobj columns] {
338            foreach c [lsort -dictionary [array names labels $label*]] {
339                $itk_component(treeview) column configure $c -text $label
340            }
341        }   
342    }
343    if { $_raised != "" } {
344        foreach c [$itk_component(treeview) column names] {
345            $itk_component(treeview) column configure $c -style lowered
346        }
347        scan $_raised "::dataTable%d" suffix
348        incr suffix
349        foreach { label description style } [$_raised columns] {
350            set c "$label \#$suffix"
351            $itk_component(treeview) column configure $c -style raised
352        }
353    }
354}
355
356itcl::body Rappture::DataTableResult::snap { w h } {
357    set g $itk_component(plot)
358    if { $w <= 0 || $h <= 0 } {
359        set w [winfo width $g]
360        set h [winfo height $g]
361    }
362    set img [image create picture -width $w -height $h]
363    $g snap $img -width $w -height $h
364    return $img
365}
366
367itcl::body Rappture::DataTableResult::tooltip { description x y } {
368    Rappture::Tooltip::text $itk_component(treeview) $description
369    Rappture::Tooltip::tooltip pending $itk_component(treeview) @$x,$y
370}
Note: See TracBrowser for help on using the repository browser.