source: trunk/gui/scripts/xylegend.tcl @ 2790

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