source: branches/1.3/gui/scripts/xylegend.tcl @ 3800

Last change on this file since 3800 was 3800, checked in by gah, 8 years ago

add -simulation to plotadd calls

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