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

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