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

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