| 1 | |
|---|
| 2 | # ---------------------------------------------------------------------- |
|---|
| 3 | # COMPONENT: xylegend - X/Y plot legend. |
|---|
| 4 | # |
|---|
| 5 | # This widget is a legend for 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 curves 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 | # ====================================================================== |
|---|
| 15 | package require Itk |
|---|
| 16 | package require BLT |
|---|
| 17 | |
|---|
| 18 | option add *Xylegend.font \ |
|---|
| 19 | -*-helvetica-medium-r-normal-*-8-* widgetDefault |
|---|
| 20 | |
|---|
| 21 | option add *Xylegend.Button.font \ |
|---|
| 22 | -*-helvetica-medium-r-normal-*-9-* widgetDefault |
|---|
| 23 | |
|---|
| 24 | itcl::class ::Rappture::XyLegend { |
|---|
| 25 | inherit itk::Widget |
|---|
| 26 | |
|---|
| 27 | private variable _dispatcher "" ;# dispatcher for !events |
|---|
| 28 | private variable graph_ "" |
|---|
| 29 | private variable tree_ "" |
|---|
| 30 | private variable diff_ "" |
|---|
| 31 | private variable focus_ -1 |
|---|
| 32 | private variable diffelements_ |
|---|
| 33 | |
|---|
| 34 | constructor {args} { graph } |
|---|
| 35 | destructor {} |
|---|
| 36 | |
|---|
| 37 | public method Activate {} |
|---|
| 38 | public method Average {} |
|---|
| 39 | public method Check {} |
|---|
| 40 | public method Deactivate {} |
|---|
| 41 | public method Delete { args } |
|---|
| 42 | public method Difference {} |
|---|
| 43 | public method Editor { option args } |
|---|
| 44 | public method Hide { args } |
|---|
| 45 | public method Lower { args } |
|---|
| 46 | public method Raise { args } |
|---|
| 47 | public method Rename {} |
|---|
| 48 | public method Show { args } |
|---|
| 49 | public method Toggle { args } |
|---|
| 50 | private method GetData { elem what } |
|---|
| 51 | private method Add { elem label {flags ""}} |
|---|
| 52 | private method SelectAll {} |
|---|
| 53 | } |
|---|
| 54 | |
|---|
| 55 | itk::usual XyLegend { |
|---|
| 56 | keep -background -foreground -cursor |
|---|
| 57 | } |
|---|
| 58 | |
|---|
| 59 | itk::usual TreeView { |
|---|
| 60 | keep -background -foreground -cursor |
|---|
| 61 | } |
|---|
| 62 | |
|---|
| 63 | blt::bitmap define dot1 { |
|---|
| 64 | #define dot1_width 8 |
|---|
| 65 | #define dot1_height 8 |
|---|
| 66 | static unsigned char dot1_bits[] = { |
|---|
| 67 | 0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa, 0x55, 0xaa}; |
|---|
| 68 | } |
|---|
| 69 | |
|---|
| 70 | # ---------------------------------------------------------------------- |
|---|
| 71 | # CONSTRUCTOR |
|---|
| 72 | # ---------------------------------------------------------------------- |
|---|
| 73 | itcl::body Rappture::XyLegend::constructor { graph args } { |
|---|
| 74 | option add hull.width hull.height |
|---|
| 75 | itk_component add scrollbars { |
|---|
| 76 | Rappture::Scroller $itk_interior.scrl \ |
|---|
| 77 | -xscrollmode auto -yscrollmode auto |
|---|
| 78 | } |
|---|
| 79 | set tree_ [blt::tree create] |
|---|
| 80 | itk_component add legend { |
|---|
| 81 | blt::treeview $itk_component(scrollbars).legend -linewidth 0 \ |
|---|
| 82 | -bg white -selectmode multiple -width 0 \ |
|---|
| 83 | -highlightthickness 0 \ |
|---|
| 84 | -tree $tree_ \ |
|---|
| 85 | -font "Arial 9" \ |
|---|
| 86 | -flat yes -separator / |
|---|
| 87 | } |
|---|
| 88 | $itk_component(scrollbars) contents $itk_component(legend) |
|---|
| 89 | $itk_component(legend) column insert 0 "show" \ |
|---|
| 90 | -text "" -weight 0.0 -pad 0 -borderwidth 0 |
|---|
| 91 | $itk_component(legend) style checkbox "check" -showvalue no \ |
|---|
| 92 | -onvalue 0 -offvalue 1 \ |
|---|
| 93 | -boxcolor grey50 -checkcolor black -activebackground grey90 |
|---|
| 94 | $itk_component(legend) column configure "treeView" -justify left \ |
|---|
| 95 | -weight 1.0 -text "" -pad 0 -borderwidth 0 |
|---|
| 96 | $itk_component(legend) column configure "show" -style "check" -pad {0 0} \ |
|---|
| 97 | -edit yes |
|---|
| 98 | itk_component add controls { |
|---|
| 99 | frame $itk_component(hull).controls -width 100 -relief sunken -bd 2 |
|---|
| 100 | } |
|---|
| 101 | set controls $itk_component(controls) |
|---|
| 102 | grid $itk_component(controls) -column 0 -row 1 -sticky nsew |
|---|
| 103 | grid columnconfigure $itk_component(hull) 0 -weight 1 |
|---|
| 104 | grid rowconfigure $itk_component(hull) 1 -weight 0 |
|---|
| 105 | grid rowconfigure $itk_component(hull) 0 -weight 1 |
|---|
| 106 | grid $itk_component(scrollbars) -column 0 -row 0 -sticky nsew |
|---|
| 107 | set commands { |
|---|
| 108 | hide "" |
|---|
| 109 | show "" |
|---|
| 110 | toggle "" |
|---|
| 111 | raise findup |
|---|
| 112 | lower finddn |
|---|
| 113 | average "" |
|---|
| 114 | difference "" |
|---|
| 115 | delete "" |
|---|
| 116 | rename "" |
|---|
| 117 | } |
|---|
| 118 | foreach { but icon} $commands { |
|---|
| 119 | set title [string totitle $but] |
|---|
| 120 | button $controls.$but -text $title \ |
|---|
| 121 | -relief flat -pady 0 -padx 0 -font "Arial 9" \ |
|---|
| 122 | -command [itcl::code $this $title] -overrelief flat \ |
|---|
| 123 | -activebackground grey90 |
|---|
| 124 | } |
|---|
| 125 | grid $controls.hide -column 0 -row 0 -sticky w |
|---|
| 126 | grid $controls.show -column 0 -row 1 -sticky w |
|---|
| 127 | grid $controls.toggle -column 0 -row 2 -sticky w |
|---|
| 128 | grid $controls.raise -column 0 -row 3 -sticky w |
|---|
| 129 | grid $controls.lower -column 0 -row 4 -sticky w |
|---|
| 130 | grid $controls.difference -column 1 -row 0 -sticky w |
|---|
| 131 | grid $controls.average -column 1 -row 1 -sticky w |
|---|
| 132 | grid $controls.rename -column 1 -row 2 -sticky w |
|---|
| 133 | grid $controls.delete -column 1 -row 3 -sticky w |
|---|
| 134 | |
|---|
| 135 | grid columnconfigure $controls 0 -weight 1 |
|---|
| 136 | grid columnconfigure $controls 1 -weight 1 |
|---|
| 137 | |
|---|
| 138 | set graph_ $graph |
|---|
| 139 | set cmd [itcl::code $this Toggle current] |
|---|
| 140 | $itk_component(legend) bind CheckBoxStyle <ButtonRelease-1> \ |
|---|
| 141 | [itcl::code [subst -nocommands { |
|---|
| 142 | if { [%W edit -root -test %X %Y] } { |
|---|
| 143 | %W edit -root %X %Y |
|---|
| 144 | $this Toggle [%W nearest -root %X %Y] |
|---|
| 145 | break |
|---|
| 146 | } |
|---|
| 147 | }]] |
|---|
| 148 | bind $itk_component(legend) <Enter> { focus %W } |
|---|
| 149 | $itk_component(legend) bind Entry <Control-KeyRelease-a> \ |
|---|
| 150 | [itcl::code $this SelectAll] |
|---|
| 151 | $itk_component(legend) bind Entry <KeyRelease-Return> \ |
|---|
| 152 | +[itcl::code $this Toggle focus] |
|---|
| 153 | $itk_component(legend) bind Entry <Escape> \ |
|---|
| 154 | "$itk_component(legend) selection clearall" |
|---|
| 155 | $itk_component(legend) configure -selectcommand \ |
|---|
| 156 | [itcl::code $this Check] |
|---|
| 157 | |
|---|
| 158 | itk_component add editor { |
|---|
| 159 | Rappture::Editor $itk_interior.editor \ |
|---|
| 160 | -activatecommand [itcl::code $this Editor activate] \ |
|---|
| 161 | -validatecommand [itcl::code $this Editor validate] \ |
|---|
| 162 | -applycommand [itcl::code $this Editor apply] |
|---|
| 163 | } |
|---|
| 164 | Check |
|---|
| 165 | eval itk_initialize $args |
|---|
| 166 | } |
|---|
| 167 | |
|---|
| 168 | # ---------------------------------------------------------------------- |
|---|
| 169 | # DESTRUCTOR |
|---|
| 170 | # ---------------------------------------------------------------------- |
|---|
| 171 | itcl::body Rappture::XyLegend::destructor {} { |
|---|
| 172 | Deactivate |
|---|
| 173 | } |
|---|
| 174 | |
|---|
| 175 | itcl::body Rappture::XyLegend::Add { elem label {flags ""} } { |
|---|
| 176 | set hide [$graph_ element cget $elem -hide] |
|---|
| 177 | set im [image create photo] |
|---|
| 178 | $graph_ legend icon $elem $im |
|---|
| 179 | set data(show) $hide |
|---|
| 180 | set data(delete) [expr { $flags == "-delete" }] |
|---|
| 181 | set node [$tree_ insert root -at 0 -label $elem -data [array get data]] |
|---|
| 182 | $itk_component(legend) entry configure $node -label $label -icon $im \ |
|---|
| 183 | -activeicon $im |
|---|
| 184 | return $node |
|---|
| 185 | } |
|---|
| 186 | |
|---|
| 187 | # ---------------------------------------------------------------------- |
|---|
| 188 | # USAGE: activate <curve> ?<settings>? |
|---|
| 189 | # |
|---|
| 190 | # Clients use this to add a curve to the plot. The optional <settings> |
|---|
| 191 | # are used to configure the plot. Allowed settings are -color, |
|---|
| 192 | # -brightness, -width, -linestyle and -raise. |
|---|
| 193 | # ---------------------------------------------------------------------- |
|---|
| 194 | itcl::body Rappture::XyLegend::Activate {} { |
|---|
| 195 | foreach elem [$graph_ element show] { |
|---|
| 196 | set label [$graph_ element cget $elem -label] |
|---|
| 197 | if { $label == "" } { |
|---|
| 198 | continue |
|---|
| 199 | } |
|---|
| 200 | Add $elem $label |
|---|
| 201 | } |
|---|
| 202 | $itk_component(legend) open -recurse root |
|---|
| 203 | } |
|---|
| 204 | |
|---|
| 205 | itcl::body Rappture::XyLegend::Deactivate {} { |
|---|
| 206 | foreach node [$tree_ children root] { |
|---|
| 207 | $tree_ delete $node |
|---|
| 208 | } |
|---|
| 209 | } |
|---|
| 210 | |
|---|
| 211 | itcl::body Rappture::XyLegend::Hide { args } { |
|---|
| 212 | if { $args == "" } { |
|---|
| 213 | set nodes [$itk_component(legend) curselection] |
|---|
| 214 | } else { |
|---|
| 215 | set nodes $args |
|---|
| 216 | } |
|---|
| 217 | foreach node $nodes { |
|---|
| 218 | set elem [$tree_ label $node] |
|---|
| 219 | if { ![$graph_ element exists $elem] } { |
|---|
| 220 | continue |
|---|
| 221 | } |
|---|
| 222 | $graph_ element configure $elem -hide yes |
|---|
| 223 | $tree_ set $node "show" 1 |
|---|
| 224 | } |
|---|
| 225 | } |
|---|
| 226 | |
|---|
| 227 | itcl::body Rappture::XyLegend::Show { args } { |
|---|
| 228 | if { $args == "" } { |
|---|
| 229 | set nodes [$itk_component(legend) curselection] |
|---|
| 230 | } else { |
|---|
| 231 | set nodes $args |
|---|
| 232 | } |
|---|
| 233 | foreach node $nodes { |
|---|
| 234 | set elem [$tree_ label $node] |
|---|
| 235 | if { ![$graph_ element exists $elem] } { |
|---|
| 236 | continue |
|---|
| 237 | } |
|---|
| 238 | $graph_ element configure $elem -hide no |
|---|
| 239 | $tree_ set $node "show" 0 |
|---|
| 240 | } |
|---|
| 241 | } |
|---|
| 242 | |
|---|
| 243 | itcl::body Rappture::XyLegend::Toggle { args } { |
|---|
| 244 | if { $args == "" } { |
|---|
| 245 | set nodes [$itk_component(legend) curselection] |
|---|
| 246 | } else { |
|---|
| 247 | set nodes $args |
|---|
| 248 | } |
|---|
| 249 | foreach node $nodes { |
|---|
| 250 | set node [$itk_component(legend) index $node] |
|---|
| 251 | set elem [$tree_ label $node] |
|---|
| 252 | if { ![$graph_ element exists $elem] } { |
|---|
| 253 | continue |
|---|
| 254 | } |
|---|
| 255 | set hide [$graph_ element cget $elem -hide] |
|---|
| 256 | set hide [expr $hide==0] |
|---|
| 257 | $tree_ set $node "show" $hide |
|---|
| 258 | $graph_ element configure $elem -hide $hide |
|---|
| 259 | } |
|---|
| 260 | } |
|---|
| 261 | |
|---|
| 262 | itcl::body Rappture::XyLegend::Raise { args } { |
|---|
| 263 | if { $args == "" } { |
|---|
| 264 | set nodes [$itk_component(legend) curselection] |
|---|
| 265 | } else { |
|---|
| 266 | set nodes $args |
|---|
| 267 | } |
|---|
| 268 | set elements {} |
|---|
| 269 | foreach node $nodes { |
|---|
| 270 | set elem [$tree_ label $node] |
|---|
| 271 | set found($elem) 1 |
|---|
| 272 | set elements [linsert $elements 0 $elem] |
|---|
| 273 | } |
|---|
| 274 | foreach elem $elements { |
|---|
| 275 | $tree_ move [$tree_ index $elem] 0 -at 0 |
|---|
| 276 | } |
|---|
| 277 | set list {} |
|---|
| 278 | foreach elem [$graph_ element show] { |
|---|
| 279 | if { [info exists found($elem)] } { |
|---|
| 280 | continue |
|---|
| 281 | } |
|---|
| 282 | lappend list $elem |
|---|
| 283 | } |
|---|
| 284 | $graph_ element show [concat $list $elements] |
|---|
| 285 | } |
|---|
| 286 | |
|---|
| 287 | itcl::body Rappture::XyLegend::Lower { args } { |
|---|
| 288 | if { $args == "" } { |
|---|
| 289 | set nodes [$itk_component(legend) curselection] |
|---|
| 290 | } else { |
|---|
| 291 | set nodes $args |
|---|
| 292 | } |
|---|
| 293 | set elements {} |
|---|
| 294 | foreach node $nodes { |
|---|
| 295 | set elem [$tree_ label $node] |
|---|
| 296 | set found($elem) 1 |
|---|
| 297 | set elements [linsert $elements 0 $elem] |
|---|
| 298 | } |
|---|
| 299 | set pos [$tree_ degree 0] |
|---|
| 300 | |
|---|
| 301 | foreach elem $elements { |
|---|
| 302 | incr pos -1 |
|---|
| 303 | $tree_ move [$tree_ index $elem] 0 -at $pos |
|---|
| 304 | } |
|---|
| 305 | |
|---|
| 306 | set list {} |
|---|
| 307 | foreach elem [$graph_ element show] { |
|---|
| 308 | if { [info exists found($elem)] } { |
|---|
| 309 | continue |
|---|
| 310 | } |
|---|
| 311 | lappend list $elem |
|---|
| 312 | } |
|---|
| 313 | $graph_ element show [concat $elements $list] |
|---|
| 314 | } |
|---|
| 315 | |
|---|
| 316 | itcl::body Rappture::XyLegend::Delete { args } { |
|---|
| 317 | if { $args == "" } { |
|---|
| 318 | set nodes [$itk_component(legend) curselection] |
|---|
| 319 | } else { |
|---|
| 320 | set nodes $args |
|---|
| 321 | } |
|---|
| 322 | set elements {} |
|---|
| 323 | set delnodes {} |
|---|
| 324 | foreach node $nodes { |
|---|
| 325 | if { ![$tree_ get $node "delete" 0] } { |
|---|
| 326 | continue |
|---|
| 327 | } |
|---|
| 328 | set elem [$tree_ label $node] |
|---|
| 329 | lappend elements $elem |
|---|
| 330 | lappend delnodes $node |
|---|
| 331 | if { $diff_ != "" && [info exists diffelements_($elem)] } { |
|---|
| 332 | $graph_ element delete $diff_ |
|---|
| 333 | array unset diffelements_ |
|---|
| 334 | set diff_ "" |
|---|
| 335 | } |
|---|
| 336 | } |
|---|
| 337 | if { [llength $delnodes] > 0 } { |
|---|
| 338 | eval $tree_ delete $delnodes |
|---|
| 339 | } |
|---|
| 340 | $itk_component(legend) selection clearall |
|---|
| 341 | eval $graph_ element delete $elements |
|---|
| 342 | } |
|---|
| 343 | |
|---|
| 344 | itcl::body Rappture::XyLegend::Check {} { |
|---|
| 345 | set nodes [$itk_component(legend) curselection] |
|---|
| 346 | foreach n { hide show toggle raise lower |
|---|
| 347 | rename average difference delete } { |
|---|
| 348 | $itk_component(controls).$n configure -state disabled |
|---|
| 349 | } |
|---|
| 350 | foreach node $nodes { |
|---|
| 351 | if { [$tree_ get $node "delete" 0] } { |
|---|
| 352 | $itk_component(controls).delete configure -state normal |
|---|
| 353 | break |
|---|
| 354 | } |
|---|
| 355 | } |
|---|
| 356 | if { [$itk_component(legend) index focus] != -1 } { |
|---|
| 357 | $itk_component(controls).rename configure -state normal |
|---|
| 358 | } |
|---|
| 359 | if { [$tree_ degree 0] > 1 && [llength $nodes] > 0 } { |
|---|
| 360 | foreach n { raise lower } { |
|---|
| 361 | $itk_component(controls).$n configure -state normal |
|---|
| 362 | } |
|---|
| 363 | } |
|---|
| 364 | switch -- [llength $nodes] { |
|---|
| 365 | 0 { |
|---|
| 366 | } |
|---|
| 367 | 1 { |
|---|
| 368 | foreach n { hide show toggle } { |
|---|
| 369 | $itk_component(controls).$n configure -state normal |
|---|
| 370 | } |
|---|
| 371 | } |
|---|
| 372 | 2 { |
|---|
| 373 | foreach n { hide show toggle difference average } { |
|---|
| 374 | $itk_component(controls).$n configure -state normal |
|---|
| 375 | } |
|---|
| 376 | } |
|---|
| 377 | default { |
|---|
| 378 | foreach n { hide show toggle average } { |
|---|
| 379 | $itk_component(controls).$n configure -state normal |
|---|
| 380 | } |
|---|
| 381 | } |
|---|
| 382 | } |
|---|
| 383 | } |
|---|
| 384 | |
|---|
| 385 | itcl::body Rappture::XyLegend::GetData { elem what } { |
|---|
| 386 | set y [$graph_ element cget $elem $what] |
|---|
| 387 | if { [blt::vector names $y] == $y } { |
|---|
| 388 | set y [$y range 0 end] |
|---|
| 389 | } |
|---|
| 390 | return $y |
|---|
| 391 | } |
|---|
| 392 | |
|---|
| 393 | itcl::body Rappture::XyLegend::Average {} { |
|---|
| 394 | set nodes [$itk_component(legend) curselection] |
|---|
| 395 | if { $nodes == "" } { |
|---|
| 396 | return |
|---|
| 397 | } |
|---|
| 398 | set elements {} |
|---|
| 399 | set sum [blt::vector create \#auto -command ""] |
|---|
| 400 | |
|---|
| 401 | set xcoords [blt::vector create \#auto -command ""] |
|---|
| 402 | set ycoords [blt::vector create \#auto -command ""] |
|---|
| 403 | |
|---|
| 404 | # Step 1. Get the x-values for each curve, then sort them to get the |
|---|
| 405 | # unique values. |
|---|
| 406 | |
|---|
| 407 | foreach node $nodes { |
|---|
| 408 | set elem [$tree_ label $node] |
|---|
| 409 | $xcoords append [GetData $elem -x] |
|---|
| 410 | set elements [linsert $elements 0 $elem] |
|---|
| 411 | } |
|---|
| 412 | # Sort the abscissas keeping unique values. |
|---|
| 413 | $xcoords sort -uniq |
|---|
| 414 | |
|---|
| 415 | # Step 2. Now for each curve, generate a cubic spline of that curve |
|---|
| 416 | # and interpolate to get the corresponding y-values for each |
|---|
| 417 | # abscissa. Normally the abscissa are the same, so we're |
|---|
| 418 | # interpolation the knots. |
|---|
| 419 | |
|---|
| 420 | set x [blt::vector create \#auto -command ""] |
|---|
| 421 | set y [blt::vector create \#auto -command ""] |
|---|
| 422 | $sum length [$xcoords length] |
|---|
| 423 | |
|---|
| 424 | foreach node $nodes { |
|---|
| 425 | set elem [$tree_ label $node] |
|---|
| 426 | $x set [GetData $elem -x] |
|---|
| 427 | $y set [GetData $elem -y] |
|---|
| 428 | blt::spline natural $x $y $xcoords $ycoords |
|---|
| 429 | |
|---|
| 430 | # Sum the interpolated y-coordinate values. |
|---|
| 431 | $sum expr "$sum + $ycoords" |
|---|
| 432 | } |
|---|
| 433 | blt::vector destroy $x $y |
|---|
| 434 | |
|---|
| 435 | # Get the average |
|---|
| 436 | $sum expr "$sum / [llength $elements]" |
|---|
| 437 | |
|---|
| 438 | # Step 3. Create a new curve which is the average. Append it to the |
|---|
| 439 | # the end. |
|---|
| 440 | |
|---|
| 441 | set count 0 |
|---|
| 442 | while {[$graph_ element exists avg$count] } { |
|---|
| 443 | incr count |
|---|
| 444 | } |
|---|
| 445 | set elements [lsort -dictionary $elements] |
|---|
| 446 | set name "avg$count" |
|---|
| 447 | set label "Avg. [join $elements ,]" |
|---|
| 448 | |
|---|
| 449 | # Don't use the vector because we don't know when it will be cleaned up. |
|---|
| 450 | |
|---|
| 451 | $graph_ element create $name -label $label -x [$xcoords range 0 end]\ |
|---|
| 452 | -y [$sum range 0 end] -symbol scross |
|---|
| 453 | blt::vector destroy $xcoords $ycoords $sum |
|---|
| 454 | set node [Add $name $label -delete] |
|---|
| 455 | Raise $node |
|---|
| 456 | } |
|---|
| 457 | |
|---|
| 458 | itcl::body Rappture::XyLegend::Difference {} { |
|---|
| 459 | set nodes [$itk_component(legend) curselection] |
|---|
| 460 | set elements {} |
|---|
| 461 | set sum [blt::vector create \#auto -command ""] |
|---|
| 462 | |
|---|
| 463 | set xcoords [blt::vector create \#auto -command ""] |
|---|
| 464 | set ycoords [blt::vector create \#auto -command ""] |
|---|
| 465 | |
|---|
| 466 | # Step 1. Get the x-values for each curve, then sort them to get the |
|---|
| 467 | # unique values. |
|---|
| 468 | |
|---|
| 469 | foreach node $nodes { |
|---|
| 470 | set elem [$tree_ label $node] |
|---|
| 471 | $xcoords append [GetData $elem -x] |
|---|
| 472 | set elements [linsert $elements 0 $elem] |
|---|
| 473 | } |
|---|
| 474 | # Sort the abscissas keeping unique values. |
|---|
| 475 | $xcoords sort -uniq |
|---|
| 476 | |
|---|
| 477 | # Step 2. Now for each curve, generate a cubic spline of that curve |
|---|
| 478 | # and interpolate to get the corresponding y-values for each |
|---|
| 479 | # abscissa. Normally the abscissa are the same, so we're |
|---|
| 480 | # interpolation the knots. |
|---|
| 481 | |
|---|
| 482 | set x [blt::vector create \#auto -command ""] |
|---|
| 483 | set y [blt::vector create \#auto -command ""] |
|---|
| 484 | $sum length [$xcoords length] |
|---|
| 485 | |
|---|
| 486 | foreach node $nodes { |
|---|
| 487 | set elem [$tree_ label $node] |
|---|
| 488 | $x set [GetData $elem -x] |
|---|
| 489 | $y set [GetData $elem -y] |
|---|
| 490 | blt::spline natural $x $y $xcoords $ycoords |
|---|
| 491 | |
|---|
| 492 | # Sum the interpolated y-coordinate values. |
|---|
| 493 | $sum expr "fabs($ycoords - $sum)" |
|---|
| 494 | } |
|---|
| 495 | blt::vector destroy $x $y |
|---|
| 496 | |
|---|
| 497 | # Get the average |
|---|
| 498 | #$sum expr "$sum / [llength $elements]" |
|---|
| 499 | |
|---|
| 500 | # Step 3. Create a new curve which is the average. Append it to the |
|---|
| 501 | # the end. |
|---|
| 502 | |
|---|
| 503 | set count 0 |
|---|
| 504 | while {[$graph_ element exists diff$count] } { |
|---|
| 505 | incr count |
|---|
| 506 | } |
|---|
| 507 | set elements [lsort -dictionary $elements] |
|---|
| 508 | set name "diff$count" |
|---|
| 509 | set label "Diff. [join $elements ,]" |
|---|
| 510 | |
|---|
| 511 | # Don't use the vector because we don't know when it will be cleaned up. |
|---|
| 512 | |
|---|
| 513 | $graph_ element create $name -label $label -x [$xcoords range 0 end] \ |
|---|
| 514 | -y [$sum range 0 end] |
|---|
| 515 | blt::vector destroy $xcoords $ycoords $sum |
|---|
| 516 | set node [Add $name $label] |
|---|
| 517 | Raise $node |
|---|
| 518 | } |
|---|
| 519 | |
|---|
| 520 | itcl::body Rappture::XyLegend::Difference {} { |
|---|
| 521 | |
|---|
| 522 | if { $diff_ != "" } { |
|---|
| 523 | $graph_ marker delete $diff_ |
|---|
| 524 | set diff_ "" |
|---|
| 525 | } |
|---|
| 526 | set nodes [$itk_component(legend) curselection] |
|---|
| 527 | set elem1 [$tree_ label [lindex $nodes 0]] |
|---|
| 528 | set elem2 [$tree_ label [lindex $nodes 1]] |
|---|
| 529 | if { [info exists diffelements_($elem1)] && |
|---|
| 530 | [info exists diffelements_($elem2)] } { |
|---|
| 531 | array unset diffelements_ |
|---|
| 532 | return |
|---|
| 533 | } |
|---|
| 534 | array unset diffelements_ |
|---|
| 535 | set x [blt::vector create \#auto -command ""] |
|---|
| 536 | set y [blt::vector create \#auto -command ""] |
|---|
| 537 | set m [blt::vector create \#auto -command ""] |
|---|
| 538 | |
|---|
| 539 | $x append [GetData $elem1 -x] |
|---|
| 540 | $y append [GetData $elem1 -y] |
|---|
| 541 | $x sort -reverse $y |
|---|
| 542 | $x append [GetData $elem2 -x] |
|---|
| 543 | $y append [GetData $elem2 -y] |
|---|
| 544 | $m merge $x $y |
|---|
| 545 | set diff_ [$graph_ marker create polygon \ |
|---|
| 546 | -coords [$m range 0 end] \ |
|---|
| 547 | -elem $elem1 \ |
|---|
| 548 | -stipple dot1 \ |
|---|
| 549 | -outline "" -fill blue4 ] |
|---|
| 550 | blt::vector destroy $m $x $y |
|---|
| 551 | set diffelements_($elem1) 1 |
|---|
| 552 | set diffelements_($elem2) 1 |
|---|
| 553 | } |
|---|
| 554 | |
|---|
| 555 | |
|---|
| 556 | itcl::body Rappture::XyLegend::SelectAll { } { |
|---|
| 557 | foreach node [$tree_ children 0] { |
|---|
| 558 | $itk_component(legend) selection set $node |
|---|
| 559 | } |
|---|
| 560 | } |
|---|
| 561 | |
|---|
| 562 | itcl::body Rappture::XyLegend::Rename {} { |
|---|
| 563 | Editor popup |
|---|
| 564 | } |
|---|
| 565 | |
|---|
| 566 | # ---------------------------------------------------------------------- |
|---|
| 567 | # USAGE: Editor popup |
|---|
| 568 | # USAGE: Editor activate |
|---|
| 569 | # USAGE: Editor validate <value> |
|---|
| 570 | # USAGE: Editor apply <value> |
|---|
| 571 | # USAGE: Editor menu <rootx> <rooty> |
|---|
| 572 | # |
|---|
| 573 | # Used internally to handle the various functions of the pop-up |
|---|
| 574 | # editor for the value of this gauge. |
|---|
| 575 | # ---------------------------------------------------------------------- |
|---|
| 576 | itcl::body Rappture::XyLegend::Editor {option args} { |
|---|
| 577 | switch -- $option { |
|---|
| 578 | popup { |
|---|
| 579 | $itk_component(editor) activate |
|---|
| 580 | } |
|---|
| 581 | activate { |
|---|
| 582 | set focus_ [$itk_component(legend) index focus] |
|---|
| 583 | if { $focus_ == -1 } { |
|---|
| 584 | return; |
|---|
| 585 | } |
|---|
| 586 | set label [$itk_component(legend) entry cget $focus_ -label] |
|---|
| 587 | foreach { l r w h } [$itk_component(legend) bbox $focus_] break |
|---|
| 588 | set info(text) $label |
|---|
| 589 | set info(x) [expr $l + [winfo rootx $itk_component(legend)]] |
|---|
| 590 | set info(y) [expr $r + [winfo rooty $itk_component(legend)]] |
|---|
| 591 | set info(w) $w |
|---|
| 592 | set info(h) $h |
|---|
| 593 | return [array get info] |
|---|
| 594 | } |
|---|
| 595 | validate { |
|---|
| 596 | if {[llength $args] != 1} { |
|---|
| 597 | error "wrong # args: should be \"editor validate value\"" |
|---|
| 598 | } |
|---|
| 599 | } |
|---|
| 600 | apply { |
|---|
| 601 | if {[llength $args] != 1} { |
|---|
| 602 | error "wrong # args: should be \"editor apply value\"" |
|---|
| 603 | } |
|---|
| 604 | set label [lindex $args 0] |
|---|
| 605 | $itk_component(legend) entry configure $focus_ -label $label |
|---|
| 606 | set elem [$tree_ label $focus_] |
|---|
| 607 | $graph_ element configure $elem -label $label |
|---|
| 608 | } |
|---|
| 609 | menu { |
|---|
| 610 | eval tk_popup $itk_component(emenu) $args |
|---|
| 611 | } |
|---|
| 612 | default { |
|---|
| 613 | error "bad option \"$option\": should be popup, activate, validate, apply, and menu" |
|---|
| 614 | } |
|---|
| 615 | } |
|---|
| 616 | } |
|---|
