source: trunk/gui/scripts/valueresult.tcl @ 1342

Last change on this file since 1342 was 1342, checked in by gah, 16 years ago

preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%

File size: 8.3 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: ValueResult - Log output for ResultSet
3#
4#  This widget is used to show text output in a ResultSet.  The log
5#  output from a tool, for example, is rendered as a ValueResult.
6# ======================================================================
7#  AUTHOR:  Michael McLennan, Purdue University
8#  Copyright (c) 2004-2005  Purdue Research Foundation
9#
10#  See the file "license.terms" for information on usage and
11#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
12# ======================================================================
13package require Itk
14package require BLT
15
16option add *ValueResult.font \
17    -*-helvetica-medium-r-normal-*-12-* widgetDefault
18
19itcl::class Rappture::ValueResult {
20    inherit itk::Widget
21
22    constructor {args} { # defined below }
23
24    public method add {dataobj {settings ""}}
25    public method get {}
26    public method delete {args}
27    public method scale {args}
28    public method parameters {title args} { # do nothing }
29    public method download {option args}
30
31    protected method _rebuild {}
32
33    private variable _dispatcher "" ;# dispatcher for !events
34
35    private variable _dlist ""    ;# list of data objects being displayed
36    private variable _dobj2color  ;# maps data object => color
37    private variable _dobj2raise  ;# maps data object => raise flag 0/1
38    private variable _dobj2desc   ;# maps data object => description
39}
40                                                                               
41itk::usual ValueResult {
42    keep -background -foreground -cursor -font
43}
44
45# ----------------------------------------------------------------------
46# CONSTRUCTOR
47# ----------------------------------------------------------------------
48itcl::body Rappture::ValueResult::constructor {args} {
49    Rappture::dispatcher _dispatcher
50    $_dispatcher register !rebuild
51    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
52
53    itk_component add scroller {
54        Rappture::Scroller $itk_interior.scroller \
55            -xscrollmode auto -yscrollmode auto
56    }
57    pack $itk_component(scroller) -expand yes -fill both
58
59    itk_component add html {
60        Rappture::HTMLviewer $itk_component(scroller).html
61    }
62    $itk_component(scroller) contents $itk_component(html)
63
64    eval itk_initialize $args
65}
66
67# ----------------------------------------------------------------------
68# USAGE: add <dataobj> ?<settings>?
69#
70# Clients use this to add a data object to the plot.  If the optional
71# <settings> are specified, then the are applied to the data.  Allowed
72# settings are -color and -brightness, -width, -linestyle and -raise.
73# (Many of these are ignored.)
74# ----------------------------------------------------------------------
75itcl::body Rappture::ValueResult::add {dataobj {settings ""}} {
76    array set params {
77        -color ""
78        -brightness 0
79        -width ""
80        -linestyle ""
81        -raise 0
82        -description ""
83        -param ""
84    }
85    foreach {opt val} $settings {
86        if {![info exists params($opt)]} {
87            error "bad setting \"$opt\": should be [join [lsort [array names params]] {, }]"
88        }
89        set params($opt) $val
90    }
91    if {$params(-color) == "auto" || $params(-color) == "autoreset"} {
92        # can't handle -autocolors yet
93        set params(-color) black
94    }
95
96    if {"" != $dataobj} {
97        # find the value and assign it with the proper coloring
98        if {"" != $params(-color) && "" != $params(-brightness)
99              && $params(-brightness) != 0} {
100            set params(-color) [Rappture::color::brightness \
101                $params(-color) $params(-brightness)]
102        }
103
104        set pos [lsearch -exact $dataobj $_dlist]
105        if {$pos < 0} {
106            lappend _dlist $dataobj
107            set _dobj2color($dataobj) $params(-color)
108            set _dobj2raise($dataobj) $params(-raise)
109            set _dobj2desc($dataobj) $params(-description)
110            $_dispatcher event -idle !rebuild
111        }
112    }
113}
114
115# ----------------------------------------------------------------------
116# USAGE: get
117#
118# Clients use this to query the list of objects being plotted, in
119# order from bottom to top of this result.
120# ----------------------------------------------------------------------
121itcl::body Rappture::ValueResult::get {} {
122    # put the dataobj list in order according to -raise options
123    set dlist $_dlist
124    foreach obj $dlist {
125        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
126            set i [lsearch -exact $dlist $obj]
127            if {$i >= 0} {
128                set dlist [lreplace $dlist $i $i]
129                lappend dlist $obj
130            }
131        }
132    }
133    return $dlist
134}
135
136# ----------------------------------------------------------------------
137# USAGE: delete ?<curve1> <curve2> ...?
138#
139# Clients use this to delete a curve from the plot.  If no curves
140# are specified, then all curves are deleted.
141# ----------------------------------------------------------------------
142itcl::body Rappture::ValueResult::delete {args} {
143    if {[llength $args] == 0} {
144        set args $_dlist
145    }
146
147    # delete all specified objects
148    set changed 0
149    foreach obj $args {
150        set pos [lsearch -exact $_dlist $obj]
151        if {$pos >= 0} {
152            set _dlist [lreplace $_dlist $pos $pos]
153            catch {unset _dobj2color($obj)}
154            catch {unset _dobj2raise($obj)}
155            catch {unset _dobj2desc($obj)}
156            set changed 1
157        }
158    }
159
160    # if anything changed, then rebuild the plot
161    if {$changed} {
162        $_dispatcher event -idle !rebuild
163    }
164}
165
166# ----------------------------------------------------------------------
167# USAGE: scale ?<curve1> <curve2> ...?
168#
169# Sets the default limits for the overall plot according to the
170# limits of the data for all of the given <curve> objects.  This
171# accounts for all curves--even those not showing on the screen.
172# Because of this, the limits are appropriate for all curves as
173# the user scans through data in the ResultSet viewer.
174# ----------------------------------------------------------------------
175itcl::body Rappture::ValueResult::scale {args} {
176    # nothing to do for values
177}
178
179# ----------------------------------------------------------------------
180# USAGE: download coming
181# USAGE: download controls <downloadCommand>
182# USAGE: download now
183#
184# Clients use this method to create a downloadable representation
185# of the plot.  Returns a list of the form {ext string}, where
186# "ext" is the file extension (indicating the type of data) and
187# "string" is the data itself.
188# ----------------------------------------------------------------------
189itcl::body Rappture::ValueResult::download {option args} {
190    switch $option {
191        coming {
192            # nothing to do
193        }
194        controls {
195            # no controls for this download yet
196            return ""
197        }
198        now {
199            if {[llength $_dlist] == 1} {
200                set lstr [$_dlist get about.label]
201                set mesg "$lstr [$_dlist get current]"
202            } else {
203                set mesg ""
204                foreach obj $_dlist {
205                    set lstr [$obj get about.label]
206                    append mesg "$lstr [$obj get current]\n"
207                    if {[string length $_dobj2desc($obj)] > 0} {
208                        foreach line [split $_dobj2desc($obj) \n] {
209                            append mesg " * $line\n"
210                        }
211                        append mesg "\n"
212                    }
213                }
214            }
215            return [list .txt $mesg]
216        }
217        default {
218            error "bad option \"$option\": should be coming, controls, now"
219        }
220    }
221}
222
223# ----------------------------------------------------------------------
224# USAGE: _rebuild
225#
226# Used internally to rebuild the contents of this widget
227# whenever the data within it changes.  Shows the value
228# for the topmost data object in its associated color.
229# ----------------------------------------------------------------------
230itcl::body Rappture::ValueResult::_rebuild {} {
231    set html "<html><body>"
232
233    set obj [lindex $_dlist 0]
234    if {"" != $obj} {
235        set label [$obj get about.label]
236        if {"" != $label && [string index $label end] != ":"} {
237            append label ":"
238        }
239        append html "<h3>$label</h3>\n"
240    }
241
242    foreach obj $_dlist {
243        if {$_dobj2raise($obj)} {
244            set bold0 "<b>"
245            set bold1 "</b>"
246            set bg "background:#ffffcc; border:1px solid #cccccc;"
247        } else {
248            set bold0 ""
249            set bold1 ""
250            set bg ""
251        }
252        if {$_dobj2color($obj) != ""} {
253            set color0 "<font style=\"color: $_dobj2color($obj)\">"
254            set color1 "</font>"
255        } else {
256            set color0 ""
257            set color1 ""
258        }
259
260        append html "<div style=\"margin:8px; padding:4px; $bg\">${bold0}${color0}[$obj get current]${color1}${bold1}"
261        if {$_dobj2raise($obj) && [string length $_dobj2desc($obj)] > 0} {
262            foreach line [split $_dobj2desc($obj) \n] {
263                append html "<li style=\"margin-left:12px;\">$line</li>\n"
264            }
265        }
266        append html "</div>"
267    }
268    append html "</body></html>"
269    $itk_component(html) load $html
270}
Note: See TracBrowser for help on using the repository browser.