[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[1920] | 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 |
---|
[3177] | 11 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[1920] | 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 | # ====================================================================== |
---|
| 16 | package require Itk |
---|
| 17 | package require BLT |
---|
| 18 | |
---|
| 19 | option add *DataTableResult.width 3i widgetDefault |
---|
| 20 | option add *DataTableResult.height 3i widgetDefault |
---|
| 21 | option add *DataTableResult.gridColor #d9d9d9 widgetDefault |
---|
| 22 | option add *DataTableResult.activeColor blue widgetDefault |
---|
| 23 | option add *DataTableResult.dimColor gray widgetDefault |
---|
| 24 | option add *DataTableResult.controlBackground gray widgetDefault |
---|
| 25 | option add *DataTableResult.font \ |
---|
| 26 | -*-helvetica-medium-r-normal-*-12-* widgetDefault |
---|
| 27 | |
---|
| 28 | option add *DataTableResult*Balloon*Entry.background white widgetDefault |
---|
| 29 | |
---|
| 30 | itk::usual TreeView { |
---|
| 31 | keep -foreground -cursor |
---|
| 32 | } |
---|
| 33 | |
---|
| 34 | itcl::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} { |
---|
[1929] | 44 | # defined below |
---|
[1920] | 45 | } |
---|
| 46 | destructor { |
---|
[1929] | 47 | # defined below |
---|
[1920] | 48 | } |
---|
| 49 | public method add {dataobj {settings ""}} |
---|
| 50 | public method get {} |
---|
| 51 | public method delete {args} |
---|
| 52 | public method scale {args} { |
---|
[1929] | 53 | # Do nothing |
---|
[1920] | 54 | } |
---|
| 55 | public method snap { w h } |
---|
| 56 | public method tooltip { desc x y } |
---|
| 57 | public method parameters {title args} { |
---|
[1929] | 58 | # do nothing |
---|
[1920] | 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 |
---|
[2744] | 70 | private variable _raised ""; |
---|
[1920] | 71 | common _downloadPopup ;# download options from popup |
---|
| 72 | } |
---|
| 73 | |
---|
| 74 | itk::usual DataTableResult { |
---|
| 75 | keep -background -foreground -cursor -font |
---|
| 76 | } |
---|
| 77 | |
---|
| 78 | # ---------------------------------------------------------------------- |
---|
| 79 | # CONSTRUCTOR |
---|
| 80 | # ---------------------------------------------------------------------- |
---|
| 81 | itcl::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 \ |
---|
[1929] | 95 | -xscrollmode auto -yscrollmode auto |
---|
[1920] | 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} { |
---|
[1929] | 110 | puts stderr errs=$err |
---|
[1920] | 111 | } |
---|
| 112 | } |
---|
| 113 | |
---|
| 114 | # ---------------------------------------------------------------------- |
---|
| 115 | # DESTRUCTOR |
---|
| 116 | # ---------------------------------------------------------------------- |
---|
| 117 | itcl::body Rappture::DataTableResult::destructor {} { |
---|
| 118 | if { $_tree != "" } { |
---|
[1929] | 119 | blt::tree destroy $_tree |
---|
[1920] | 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 | # ---------------------------------------------------------------------- |
---|
| 130 | itcl::body Rappture::DataTableResult::add {dataobj {settings ""}} { |
---|
| 131 | array set params { |
---|
[1929] | 132 | -color auto |
---|
| 133 | -brightness 0 |
---|
| 134 | -width 1 |
---|
| 135 | -type "line" |
---|
| 136 | -raise 0 |
---|
| 137 | -linestyle solid |
---|
| 138 | -description "" |
---|
| 139 | -param "" |
---|
[1920] | 140 | } |
---|
[3799] | 141 | array set params $settings |
---|
[1920] | 142 | if { $params(-raise) } { |
---|
[1929] | 143 | set _raised $dataobj |
---|
[1920] | 144 | } |
---|
| 145 | lappend _dlist $dataobj |
---|
| 146 | $_dispatcher event -idle !rebuild |
---|
| 147 | } |
---|
| 148 | |
---|
| 149 | # ---------------------------------------------------------------------- |
---|
| 150 | # USAGE: get |
---|
| 151 | # |
---|
| 152 | # Clients use this to query the list of objects being plotted, in |
---|
| 153 | # order from bottom to top of this result. |
---|
| 154 | # ---------------------------------------------------------------------- |
---|
| 155 | itcl::body Rappture::DataTableResult::get {} { |
---|
| 156 | return $_dlist |
---|
| 157 | } |
---|
| 158 | |
---|
| 159 | # ---------------------------------------------------------------------- |
---|
| 160 | # USAGE: delete ?<dataobj1> <dataobj2> ...? |
---|
| 161 | # |
---|
| 162 | # Clients use this to delete a dataobj from the plot. If no dataobjs |
---|
| 163 | # are specified, then all dataobjs are deleted. |
---|
| 164 | # ---------------------------------------------------------------------- |
---|
| 165 | itcl::body Rappture::DataTableResult::delete {args} { |
---|
| 166 | if {[llength $args] == 0} { |
---|
| 167 | set args $_dlist |
---|
| 168 | } |
---|
| 169 | # delete all specified dataobjs |
---|
| 170 | set changed 0 |
---|
| 171 | foreach dataobj $args { |
---|
[1929] | 172 | if { $dataobj == $_raised } { |
---|
| 173 | set _raised "" |
---|
| 174 | } |
---|
[1920] | 175 | set pos [lsearch -exact $_dlist $dataobj] |
---|
| 176 | if {$pos >= 0} { |
---|
| 177 | set _dlist [lreplace $_dlist $pos $pos] |
---|
| 178 | set changed 1 |
---|
| 179 | } |
---|
| 180 | } |
---|
| 181 | set _raised [lindex $_dlist 0] |
---|
| 182 | # If anything changed, then rebuild the table |
---|
| 183 | if {$changed} { |
---|
| 184 | $_dispatcher event -idle !rebuild |
---|
| 185 | } |
---|
| 186 | } |
---|
| 187 | |
---|
| 188 | # ---------------------------------------------------------------------- |
---|
| 189 | # USAGE: download coming |
---|
| 190 | # USAGE: download controls <downloadCommand> |
---|
| 191 | # USAGE: download now |
---|
| 192 | # |
---|
| 193 | # Clients use this method to create a downloadable representation |
---|
| 194 | # of the plot. Returns a list of the form {ext string}, where |
---|
| 195 | # "ext" is the file extension (indicating the type of data) and |
---|
| 196 | # "string" is the data itself. |
---|
| 197 | # ---------------------------------------------------------------------- |
---|
| 198 | itcl::body Rappture::DataTableResult::download {option args} { |
---|
| 199 | switch $option { |
---|
| 200 | coming { |
---|
| 201 | # nothing to do |
---|
| 202 | } |
---|
| 203 | controls { |
---|
| 204 | set popup .datatableresultdownload |
---|
| 205 | if {![winfo exists .datatableresultdownload]} { |
---|
| 206 | # if we haven't created the popup yet, do it now |
---|
| 207 | Rappture::Balloon $popup \ |
---|
| 208 | -title "[Rappture::filexfer::label downloadWord] as..." |
---|
| 209 | set inner [$popup component inner] |
---|
| 210 | label $inner.summary -text "" -anchor w |
---|
| 211 | pack $inner.summary -side top |
---|
| 212 | radiobutton $inner.datatable \ |
---|
[1929] | 213 | -text "Data as Comma-Separated Values" \ |
---|
[1920] | 214 | -variable Rappture::DataTableResult::_downloadPopup(format) \ |
---|
| 215 | -value csv |
---|
| 216 | pack $inner.datatable -anchor w |
---|
| 217 | button $inner.go -text [Rappture::filexfer::label download] \ |
---|
| 218 | -command [lindex $args 0] |
---|
| 219 | pack $inner.go -pady 4 |
---|
| 220 | } else { |
---|
| 221 | set inner [$popup component inner] |
---|
| 222 | } |
---|
| 223 | set num [llength [get]] |
---|
| 224 | set num [expr {($num == 1) ? "1 result" : "$num results"}] |
---|
| 225 | $inner.summary configure -text "[Rappture::filexfer::label downloadWord] $num in the following format:" |
---|
| 226 | update idletasks ;# fix initial sizes |
---|
| 227 | return $popup |
---|
| 228 | } |
---|
| 229 | now { |
---|
| 230 | set popup .datatableresultdownload |
---|
| 231 | if {[winfo exists .datatableresultdownload]} { |
---|
| 232 | $popup deactivate |
---|
| 233 | } |
---|
| 234 | switch -- $_downloadPopup(format) { |
---|
| 235 | csv { |
---|
| 236 | # reverse the objects so the selected data appears on top |
---|
| 237 | set dlist "" |
---|
| 238 | foreach dataobj [get] { |
---|
| 239 | set dlist [linsert $dlist 0 $dataobj] |
---|
| 240 | } |
---|
| 241 | |
---|
| 242 | # generate the comma-separated value data for these objects |
---|
| 243 | set csvdata "" |
---|
| 244 | foreach dataobj $dlist { |
---|
| 245 | append csvdata "[string repeat - 60]\n" |
---|
| 246 | append csvdata " [$dataobj hints label]\n" |
---|
| 247 | if {[info exists _dataobj2desc($dataobj)] |
---|
| 248 | && [llength [split $_dataobj2desc($dataobj) \n]] > 1} { |
---|
| 249 | set indent "for:" |
---|
| 250 | foreach line [split $_dataobj2desc($dataobj) \n] { |
---|
| 251 | append csvdata " $indent $line\n" |
---|
| 252 | set indent " " |
---|
| 253 | } |
---|
| 254 | } |
---|
| 255 | append csvdata "[string repeat - 60]\n" |
---|
| 256 | |
---|
| 257 | append csvdata "[$dataobj hints xlabel], [$dataobj hints ylabel]\n" |
---|
| 258 | set first 1 |
---|
| 259 | foreach comp [$dataobj components] { |
---|
| 260 | if {!$first} { |
---|
| 261 | # blank line between components |
---|
| 262 | append csvdata "\n" |
---|
| 263 | } |
---|
| 264 | set xv [$dataobj mesh $comp] |
---|
| 265 | set yv [$dataobj values $comp] |
---|
| 266 | foreach x [$xv values] y [$yv values] { |
---|
| 267 | append csvdata [format "%20.15g, %20.15g\n" $x $y] |
---|
| 268 | } |
---|
| 269 | set first 0 |
---|
| 270 | } |
---|
| 271 | append csvdata "\n" |
---|
| 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 | # ---------------------------------------------------------------------- |
---|
| 290 | itcl::body Rappture::DataTableResult::Rebuild {} { |
---|
| 291 | eval $_tree delete [$_tree children 0] |
---|
| 292 | |
---|
| 293 | foreach dataobj $_dlist { |
---|
[1929] | 294 | scan $dataobj "::dataTable%d" suffix |
---|
| 295 | incr suffix |
---|
[1920] | 296 | |
---|
[1929] | 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 | } |
---|
[1920] | 311 | } |
---|
| 312 | foreach col [$itk_component(treeview) column names] { |
---|
[1929] | 313 | if { [string match "BLT TreeView*" $col] } { |
---|
| 314 | continue |
---|
| 315 | } |
---|
| 316 | $itk_component(treeview) column delete $col |
---|
[1920] | 317 | } |
---|
| 318 | $itk_component(treeview) column configure treeView -hide yes |
---|
| 319 | set dataobj [lindex $_dlist 0] |
---|
| 320 | if { $dataobj != "" } { |
---|
[1929] | 321 | foreach { label description style } [$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 | } |
---|
| 329 | } |
---|
[1920] | 330 | } |
---|
| 331 | if { [llength $_dlist] == 1 } { |
---|
[1929] | 332 | foreach { label description style } [$dataobj columns] { |
---|
| 333 | foreach c [lsort -dictionary [array names labels $label*]] { |
---|
| 334 | $itk_component(treeview) column configure $c -text $label |
---|
| 335 | } |
---|
| 336 | } |
---|
[1920] | 337 | } |
---|
| 338 | if { $_raised != "" } { |
---|
[1929] | 339 | foreach c [$itk_component(treeview) column names] { |
---|
| 340 | $itk_component(treeview) column configure $c -style lowered |
---|
| 341 | } |
---|
| 342 | scan $_raised "::dataTable%d" suffix |
---|
| 343 | incr suffix |
---|
| 344 | foreach { label description style } [$_raised columns] { |
---|
| 345 | set c "$label \#$suffix" |
---|
| 346 | $itk_component(treeview) column configure $c -style raised |
---|
| 347 | } |
---|
[1920] | 348 | } |
---|
| 349 | } |
---|
| 350 | |
---|
| 351 | itcl::body Rappture::DataTableResult::snap { w h } { |
---|
| 352 | set g $itk_component(plot) |
---|
| 353 | if { $w <= 0 || $h <= 0 } { |
---|
[1929] | 354 | set w [winfo width $g] |
---|
| 355 | set h [winfo height $g] |
---|
[1920] | 356 | } |
---|
| 357 | set img [image create picture -width $w -height $h] |
---|
| 358 | $g snap $img -width $w -height $h |
---|
| 359 | return $img |
---|
| 360 | } |
---|
| 361 | |
---|
| 362 | itcl::body Rappture::DataTableResult::tooltip { description x y } { |
---|
| 363 | Rappture::Tooltip::text $itk_component(treeview) $description |
---|
| 364 | Rappture::Tooltip::tooltip pending $itk_component(treeview) @$x,$y |
---|
| 365 | } |
---|