source: branches/blt4/gui/scripts/datatableresult.tcl @ 1985

Last change on this file since 1985 was 1985, 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    protected method FormatColumn { id value format }
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 -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                    # generate the comma-separated value data for these objects
247
248                    # This is at least better than what was there.
249                    # For each datatable object convert the values
250                    # in the tree by loading it into a blt::datatable
251                    # and then exporting the comma separated values
252                    set csvdata ""
253                    foreach dataobj $dlist {
254                        set tree [$dataobj values]
255                        set d0 [blt::datatable create]
256                        package require blt_datatable_tree
257                        $d0 import tree $tree 0
258                        append csvdata "[string repeat - 60]\n"
259                        append csvdata " [$dataobj hints label]\n"
260                        if {[info exists _dataobj2desc($dataobj)]
261                            && [llength [split $_dataobj2desc($dataobj) \n]] > 1} {
262                            set indent "for:"
263                            foreach line [split $_dataobj2desc($dataobj) \n] {
264                                append csvdata " $indent $line\n"
265                                set indent "    "
266                            }
267                        }
268                        append csvdata "[string repeat - 60]\n"
269                        append csvdata [$d0 export csv -columnlabels]
270                        append csvdata "\n"
271                        blt::datatable destroy $d0
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 fmt } [$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                if { $fmt != "" } {
329                    $itk_component(treeview) column configure $c \
330                        -formatcommand [itcl::code $this FormatColumn $fmt]
331                }
332            }
333        }   
334    }
335    if { [llength $_dlist] == 1 } {
336        foreach { label description style format } [$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 format } [$_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}
370
371itcl::body Rappture::DataTableResult::FormatColumn { fmt id value } {
372    return [format $fmt $value]
373}
374
Note: See TracBrowser for help on using the repository browser.