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