source: trunk/gui/scripts/gauge.tcl @ 6480

Last change on this file since 6480 was 6476, checked in by ldelgass, 8 years ago

code style fix in gauge
File size: 26.5 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: gauge - compact readout for real values
4#
5#  This widget is a readout for a real value.  It has a little glyph
6#  filled with color according to the value, followed by a numeric
7#  representation of the value itself.  The value can be edited, and
8#  a list of predefined values can be associated with a menu that
9#  drops down from the value.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
13#
14#  See the file "license.terms" for information on usage and
15#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
16# ======================================================================
17package require Itk
18package require BLT
19
20option add *Gauge.sampleWidth 30 widgetDefault
21option add *Gauge.sampleHeight 20 widgetDefault
22option add *Gauge.borderWidth 2 widgetDefault
23option add *Gauge.relief sunken widgetDefault
24option add *Gauge.valuePosition "right" widgetDefault
25option add *Gauge.textBackground #cccccc widgetDefault
26option add *Gauge.editable yes widgetDefault
27
28itcl::class Rappture::Gauge {
29    inherit itk::Widget
30
31    itk_option define -editable editable Editable ""
32    itk_option define -state state State "normal"
33    itk_option define -spectrum spectrum Spectrum ""
34    itk_option define -type type Type "real"
35    itk_option define -units units Units ""
36    itk_option define -minvalue minValue MinValue ""
37    itk_option define -maxvalue maxValue MaxValue ""
38    itk_option define -presets presets Presets ""
39    itk_option define -valueposition valuePosition ValuePosition ""
40    itk_option define -image image Image ""
41    itk_option define -samplewidth sampleWidth SampleWidth 0
42    itk_option define -sampleheight sampleHeight SampleHeight 0
43    itk_option define -log log Log ""
44    itk_option define -varname varname Varname ""
45    itk_option define -label label Label ""
46    itk_option define -validatecommand validateCommand ValidateCommand ""
47    itk_option define -uq uq Uq no
48
49    constructor {args} { # defined below }
50
51    public method value {args}
52    public method edit {option}
53    public method bump {delta}
54
55    protected method _redraw {}
56    protected method _resize {}
57    protected method _hilite {comp state}
58    protected method _editor {option args}
59    protected method _presets {option}
60    protected method _layout {}
61    protected method _log {event args}
62    protected method _change_param_type {choice}
63    protected method _pop_uq {win}
64    protected method _pop_uq_deactivate {}
65
66    private variable _value 0;    # value for this widget
67    private variable _mode exact; # current mode
68    private variable _pde "";     # ProbDistEditor
69    private variable _val "";     # value choice combobox
70    private variable uq no
71
72    blt::bitmap define GaugeArrow {
73        #define arrow_width 9
74        #define arrow_height 4
75        static unsigned char arrow_bits[] = {
76           0x7f, 0x00, 0x3e, 0x00, 0x1c, 0x00, 0x08, 0x00};
77    }
78}
79
80itk::usual Gauge {
81    keep -cursor -font -foreground -background
82    keep -selectbackground -selectforeground -selectborderwidth
83}
84
85# ----------------------------------------------------------------------
86# CONSTRUCTOR
87# ----------------------------------------------------------------------
88itcl::body Rappture::Gauge::constructor {args} {
89    # puts "GAUGE CONS: $args"
90    array set attrs $args
91
92    itk_option remove hull.borderwidth hull.relief
93    component hull configure -borderwidth 0
94
95    itk_component add icon {
96        canvas $itk_interior.icon -width 1 -height 1 \
97            -borderwidth 0 -highlightthickness 0
98    } {
99        usual
100        ignore -highlightthickness -highlightbackground -highlightcolor
101        ignore -borderwidth -relief
102    }
103    bind $itk_component(icon) <Configure> [itcl::code $this _redraw]
104
105    if {[info exists attrs(-uq)]} {
106        set uq $attrs(-uq)
107        if {[string is true $uq]} {
108            set uq 1
109            itk_component add uq {
110                button $itk_interior.uq -image [Rappture::icon UQ] \
111                    -command [itcl::code $this _pop_uq $itk_interior]
112            }
113            pack $itk_component(uq) -side right -padx 10
114        } else {
115            set uq 0
116        }
117    } else {
118        set uq 0
119    }
120
121    itk_component add -protected vframe {
122        frame $itk_interior.vframe
123    } {
124        keep -borderwidth -relief
125    }
126
127    itk_component add value {
128        label $itk_component(vframe).value -width 20 \
129            -borderwidth 1 -relief flat -textvariable [itcl::scope _value]
130    } {
131        keep -font
132        rename -background -textbackground textBackground Background
133    }
134    pack $itk_component(value) -side left -expand yes -fill both
135
136    bind $itk_component(value) <Enter> [itcl::code $this _hilite value on]
137    bind $itk_component(value) <Leave> [itcl::code $this _hilite value off]
138
139    bind $itk_component(value) <<Cut>> [itcl::code $this edit cut]
140    bind $itk_component(value) <<Copy>> [itcl::code $this edit copy]
141    bind $itk_component(value) <<Paste>> [itcl::code $this edit paste]
142
143    itk_component add emenu {
144        menu $itk_component(value).menu -tearoff 0
145    } {
146        usual
147        ignore -tearoff
148    }
149    $itk_component(emenu) add command -label "Cut" -accelerator "^X" \
150        -command [list event generate $itk_component(value) <<Cut>>]
151    $itk_component(emenu) add command -label "Copy" -accelerator "^C" \
152        -command [list event generate $itk_component(value) <<Copy>>]
153    $itk_component(emenu) add command -label "Paste" -accelerator "^V" \
154        -command [list event generate $itk_component(value) <<Paste>>]
155    bind $itk_component(value) <<PopupMenu>> \
156        [itcl::code $this _editor menu %X %Y]
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    bind $itk_component(value) <ButtonPress> \
165        [itcl::code $this _editor popup]
166
167
168    itk_component add spinner {
169        frame $itk_component(vframe).spinner
170    }
171
172    itk_component add spinup {
173        button $itk_component(spinner).up -image [Rappture::icon intplus] \
174            -borderwidth 1 -relief raised -highlightthickness 0 \
175            -command [itcl::code $this bump 1]
176    } {
177        usual
178        ignore -borderwidth -highlightthickness
179        rename -background -buttonbackground buttonBackground Background
180    }
181    pack $itk_component(spinup) -side left -expand yes -fill both
182
183    itk_component add spindn {
184        button $itk_component(spinner).down -image [Rappture::icon intminus] \
185            -borderwidth 1 -relief raised -highlightthickness 0 \
186            -command [itcl::code $this bump -1]
187    } {
188        usual
189        ignore -borderwidth -highlightthickness
190        rename -background -buttonbackground buttonBackground Background
191    }
192    pack $itk_component(spindn) -side right -expand yes -fill both
193
194    itk_component add presets {
195        button $itk_component(vframe).psbtn -bitmap GaugeArrow \
196            -borderwidth 1 -highlightthickness 0 -relief raised
197    } {
198        usual
199        ignore -borderwidth -relief -highlightthickness
200    }
201
202    bind $itk_component(presets) <Enter> [itcl::code $this _hilite presets on]
203    bind $itk_component(presets) <Leave> [itcl::code $this _hilite presets off]
204
205    itk_component add presetlist {
206        Rappture::Dropdownlist $itk_component(presets).plist \
207            -postcommand [itcl::code $this _presets post] \
208            -unpostcommand [itcl::code $this _presets unpost] \
209    }
210
211    bind $itk_component(presetlist) <<DropdownlistSelect>> \
212        [itcl::code $this _presets select]
213
214    $itk_component(presets) configure -command \
215        [list $itk_component(presetlist) post $itk_component(vframe) left]
216
217    eval itk_initialize $args
218}
219
220# ----------------------------------------------------------------------
221# USAGE: value ?-check? ?<newval>?
222#
223# Clients use this to query/set the value for this widget.  With
224# no args, it returns the current value for the widget.  If the
225# <newval> is specified, it sets the value of the widget and
226# sends a <<Value>> event.  If the -check flag is included, the
227# new value is not actually applied, but just checked for correctness.
228# ----------------------------------------------------------------------
229itcl::body Rappture::Gauge::value {args} {
230    #puts "Gauge value: $args"
231
232    # Query.  Just return the current value.
233    if {[llength $args] == 0} {
234        return $_value
235    }
236
237    set i [lsearch -exact $args -check]
238    if {$i >= 0} {
239        set onlycheck 1
240        set args [lreplace $args $i $i]
241    } else {
242        set onlycheck 0
243    }
244
245    if {[llength $args] != 1} {
246        error "wrong # args: should be \"value ?-check? ?newval?\""
247    }
248
249    set newval [Rappture::Units::mcheck_range [lindex $args 0] \
250    $itk_option(-minvalue) $itk_option(-maxvalue) $itk_option(-units)]
251
252    set newmode [lindex $newval 0]
253    switch -- $newmode {
254        uniform -
255        gaussian {
256            set _mode $newmode
257        }
258        exact -
259        default {
260            set _mode exact
261        }
262    }
263
264    switch -- $itk_option(-type) {
265        integer {
266            if { [scan $newval "%g" value] != 1 || int($newval) != $value } {
267                error "bad value \"$newval\": should be an integer value"
268            }
269        }
270    }
271
272    #
273    # If there's a -validatecommand option, then invoke the code
274    # now to check the new value.
275    #
276    if {[string length $itk_option(-validatecommand)] > 0} {
277        set cmd "uplevel #0 [list $itk_option(-validatecommand) [list $newval]]"
278        set result [eval $cmd]
279    }
280
281    if {$onlycheck} {
282        return
283    }
284
285    set _value $newval
286    $itk_component(value) configure -width [string length $_value]
287    _redraw
288    event generate $itk_component(hull) <<Value>>
289
290    if {"" != $_pde} {
291        set val [$_val translate [$_val value]]
292        $_val value $_mode
293        $_pde value $_value
294
295    }
296    return $_value
297}
298
299# ----------------------------------------------------------------------
300# USAGE: edit cut
301# USAGE: edit copy
302# USAGE: edit paste
303#
304# Used internally to handle cut/copy/paste operations for the current
305# value.  Usually invoked by <<Cut>>, <<Copy>>, <<Paste>> events, but
306# can also be called directly through this method.
307# ----------------------------------------------------------------------
308itcl::body Rappture::Gauge::edit {option} {
309    if {$itk_option(-state) == "disabled"} {
310        return; # disabled? then bail out here!
311    }
312    switch -- $option {
313        cut {
314            edit copy
315            _editor popup
316            $itk_component(editor) value ""
317            $itk_component(editor) deactivate
318        }
319        copy {
320            clipboard clear
321            clipboard append $_value
322        }
323        paste {
324            _editor popup
325            $itk_component(editor) value [clipboard get]
326            $itk_component(editor) deactivate
327        }
328        default {
329            error "bad option \"$option\": should be cut, copy, paste"
330        }
331    }
332}
333
334# ----------------------------------------------------------------------
335# USAGE: bump <delta>
336#
337# Changes the current value up/down by the <delta> value.  Used
338# internally by the up/down spinner buttons when the value is
339# -type integer.
340# ----------------------------------------------------------------------
341itcl::body Rappture::Gauge::bump {delta} {
342    set val $_value
343    if {$val == ""} {
344        set val 0
345    }
346    if {[catch {value [expr {$val+$delta}]} result]} {
347        if {[regexp {allowed here is (.+)} $result match newval]} {
348            set _value $newval
349            $itk_component(value) configure -text $newval
350        }
351        if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
352              || [regexp {(.)(.+)} $result match first tail]} {
353            set result "[string toupper $first]$tail"
354        }
355        bell
356        Rappture::Tooltip::cue $itk_component(value) $result
357        _log warning $result
358        return 0
359    }
360    _log input [value]
361}
362
363# ----------------------------------------------------------------------
364# USAGE: _redraw
365#
366# Used internally to redraw the gauge on the internal canvas based
367# on the current value and the size of the widget.  In this simple
368# base class, the gauge is drawn as a colored block, with an optional
369# image in the middle of it.
370# ----------------------------------------------------------------------
371itcl::body Rappture::Gauge::_redraw {} {
372    set c $itk_component(icon)
373    set w [winfo width $c]
374    set h [winfo height $c]
375
376    if {"" == [$c find all]} {
377        # first time around, create the items
378        $c create rectangle 0 0 1 1 -outline black -tags block
379        $c create image 0 0 -anchor center -image "" -tags bimage
380        $c create rectangle 0 0 1 1 -outline "" -fill "" -stipple gray50 -tags screen
381    }
382
383    if {"" != $itk_option(-spectrum)} {
384        set color [$itk_option(-spectrum) get $_value]
385    } else {
386        set color ""
387    }
388
389    # update the items based on current values
390    $c coords block 0 0 [expr {$w-1}] [expr {$h-1}]
391    $c coords screen 0 0 $w $h
392    $c itemconfigure block -fill $color
393
394    $c coords bimage [expr {0.5*$w}] [expr {0.5*$h}]
395
396    if {$itk_option(-state) == "disabled"} {
397        $c itemconfigure screen -fill white
398    } else {
399        $c itemconfigure screen -fill ""
400    }
401}
402
403# ----------------------------------------------------------------------
404# USAGE: _resize
405#
406# Used internally to resize the internal canvas based on the -image
407# option or the size of the text.
408# ----------------------------------------------------------------------
409itcl::body Rappture::Gauge::_resize {} {
410    set w 0
411    set h 0
412
413    if {"" != $itk_option(-image) || "" != $itk_option(-spectrum)} {
414        if {$itk_option(-samplewidth) > 0} {
415            set w $itk_option(-samplewidth)
416        } else {
417            if {$itk_option(-image) != ""} {
418                set w [expr {[image width $itk_option(-image)]+4}]
419            } else {
420                set w [winfo reqheight $itk_component(value)]
421            }
422        }
423
424        if {$itk_option(-sampleheight) > 0} {
425            set h $itk_option(-sampleheight)
426        } else {
427            if {$itk_option(-image) != ""} {
428                set h [expr {[image height $itk_option(-image)]+4}]
429            } else {
430                set h [winfo reqheight $itk_component(value)]
431            }
432        }
433    }
434
435    if {$w > 0 && $h > 0} {
436        $itk_component(icon) configure -width $w -height $h
437    }
438}
439
440# ----------------------------------------------------------------------
441# USAGE: _hilite <component> <state>
442#
443# Used internally to resize the internal canvas based on the -image
444# option or the size of the text.
445# ----------------------------------------------------------------------
446itcl::body Rappture::Gauge::_hilite {comp state} {
447    if {$itk_option(-state) == "disabled"} {
448        set state 0; # disabled? then don't hilite
449    }
450    if {$comp == "value" && !$itk_option(-editable)} {
451        $itk_component(value) configure -relief flat
452        return
453    }
454
455    if {$state} {
456        $itk_component($comp) configure -relief flat
457    } else {
458        if {$comp eq "presets"} {
459            $itk_component($comp) configure -relief raised
460        } else {
461            $itk_component($comp) configure -relief flat
462        }
463    }
464}
465
466# ----------------------------------------------------------------------
467# USAGE: _editor popup
468# USAGE: _editor activate
469# USAGE: _editor validate <value>
470# USAGE: _editor apply <value>
471# USAGE: _editor menu <rootx> <rooty>
472#
473# Used internally to handle the various functions of the pop-up
474# editor for the value of this gauge.
475# ----------------------------------------------------------------------
476itcl::body Rappture::Gauge::_editor {option args} {
477    # puts "Gauge::editor option=$option args=$args"
478    if {$itk_option(-state) == "disabled"} {
479        return; # disabled? then bail out here!
480    }
481    switch -- $option {
482        popup {
483            if {$itk_option(-editable)} {
484                $itk_component(editor) activate
485            }
486        }
487        activate {
488            return [list text $_value \
489                x [winfo rootx $itk_component(value)] \
490                y [winfo rooty $itk_component(value)] \
491                w [winfo width $itk_component(value)] \
492                h [winfo height $itk_component(value)]]
493        }
494        validate {
495            if {[llength $args] != 1} {
496                error "wrong # args: should be \"_editor validate val\""
497            }
498            set val [lindex $args 0]
499            if {[catch {value -check $val} result]} {
500                if {[regexp {allowed here is (.+)} $result match newval]} {
501                    $itk_component(editor) value $newval
502                }
503                if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
504                      || [regexp {(.)(.+)} $result match first tail]} {
505                    set result "[string toupper $first]$tail"
506                }
507                bell
508                Rappture::Tooltip::cue $itk_component(editor) $result
509                _log warning $result
510                return 0
511            }
512        }
513        apply {
514            if {[llength $args] != 1} {
515                error "wrong # args: should be \"_editor apply val\""
516            }
517            set newval [lindex $args 0]
518            value $newval
519            _log input $newval
520        }
521        menu {
522            eval tk_popup $itk_component(emenu) $args
523        }
524        default {
525            error "bad option \"$option\": should be popup, activate, validate, apply, and menu"
526        }
527    }
528}
529
530# ----------------------------------------------------------------------
531# USAGE: _presets post
532# USAGE: _presets unpost
533# USAGE: _presets select
534#
535# Used internally to handle the list of presets for this gauge.  The
536# post/unpost options are invoked when the list is posted or unposted
537# to manage the relief of the controlling button.  The select option
538# is invoked whenever there is a selection from the list, to assign
539# the value back to the gauge.
540# ----------------------------------------------------------------------
541itcl::body Rappture::Gauge::_presets {option} {
542    switch -- $option {
543        post {
544            set i [$itk_component(presetlist) index $_value]
545            if {$i >= 0} {
546                $itk_component(presetlist) select clear 0 end
547                $itk_component(presetlist) select set $i
548            }
549            after 10 [list $itk_component(presets) configure -relief sunken]
550        }
551        unpost {
552            $itk_component(presets) configure -relief raised
553        }
554        select {
555            set val [$itk_component(presetlist) current]
556            if {"" != $val} {
557                value $val
558                _log input $val
559            }
560        }
561        default {
562            error "bad option \"$option\": should be post, unpost, select"
563        }
564    }
565}
566
567# ----------------------------------------------------------------------
568# USAGE: _layout
569#
570# Used internally to fix the layout of widgets whenever there is a
571# change in the options that affect layout.  Puts the value in the
572# proper position according to the -valueposition option.  Also,
573# adds or removes the icon if it needs to be shown.
574# ----------------------------------------------------------------------
575itcl::body Rappture::Gauge::_layout {} {
576    foreach w [pack slaves $itk_component(hull)] {
577        pack forget $w
578    }
579
580    if {$itk_option(-type) != "integer" && $uq} {
581        pack $itk_component(uq) -side right -padx 10
582    }
583
584    array set side2anchor {
585        left   e
586        right  w
587        top    s
588        bottom n
589    }
590    set pos $itk_option(-valueposition)
591    pack $itk_component(vframe) -side $pos \
592        -expand yes -fill both -ipadx 2
593    $itk_component(value) configure -anchor $side2anchor($pos)
594
595    if {"" != $itk_option(-image) || "" != $itk_option(-spectrum)} {
596        pack $itk_component(icon) -side $pos -padx 2
597    }
598}
599
600# ----------------------------------------------------------------------
601# USAGE: _log event ?arg arg...?
602#
603# Used internally to send info to the logging mechanism.  If the -log
604# argument is set, then this calls the Rappture::Logger mechanism to
605# log the rest of the arguments as an action.  Otherwise, it does
606# nothing.
607# ----------------------------------------------------------------------
608itcl::body Rappture::Gauge::_log {event args} {
609    if {$itk_option(-log) ne ""} {
610        eval Rappture::Logger::log $event [list $itk_option(-log)] $args
611    }
612}
613
614# ----------------------------------------------------------------------
615# CONFIGURATION OPTION: -editable
616# ----------------------------------------------------------------------
617itcl::configbody Rappture::Gauge::editable {
618    if {![string is boolean -strict $itk_option(-editable)]} {
619        error "bad value \"$itk_option(-editable)\": should be boolean"
620    }
621    if {!$itk_option(-editable) && [winfo ismapped $itk_component(editor)]} {
622        $itk_component(editor) deactivate -abort
623    }
624}
625
626# ----------------------------------------------------------------------
627# CONFIGURATION OPTION: -state
628# ----------------------------------------------------------------------
629itcl::configbody Rappture::Gauge::state {
630    set valid {normal disabled}
631    if {[lsearch -exact $valid $itk_option(-state)] < 0} {
632        error "bad value \"$itk_option(-state)\": should be [join $valid {, }]"
633    }
634    $itk_component(value) configure -state $itk_option(-state)
635    $itk_component(spinup) configure -state $itk_option(-state)
636    $itk_component(spindn) configure -state $itk_option(-state)
637    $itk_component(presets) configure -state $itk_option(-state)
638    if { [info exists itk_component(uq)] } {
639        $itk_component(uq) configure -state $itk_option(-state)
640    }
641    _redraw; # fix gauge
642}
643
644# ----------------------------------------------------------------------
645# CONFIGURATION OPTION: -spectrum
646# ----------------------------------------------------------------------
647itcl::configbody Rappture::Gauge::spectrum {
648    if {$itk_option(-spectrum) != ""
649          && ([catch {$itk_option(-spectrum) isa ::Rappture::Spectrum} valid]
650               || !$valid)} {
651        error "bad option \"$itk_option(-spectrum)\": should be Rappture::Spectrum object"
652    }
653    _resize
654    _layout
655    _redraw
656}
657
658# ----------------------------------------------------------------------
659# CONFIGURATION OPTION: -image
660# ----------------------------------------------------------------------
661itcl::configbody Rappture::Gauge::image {
662    if {$itk_option(-image) != ""
663          && [catch {image width $itk_option(-image)}]} {
664        error "bad value \"$itk_option(-image)\": should be Tk image"
665    }
666    _resize
667    _layout
668    $itk_component(icon) itemconfigure bimage -image $itk_option(-image)
669}
670
671# ----------------------------------------------------------------------
672# CONFIGURATION OPTION: -units
673# ----------------------------------------------------------------------
674itcl::configbody Rappture::Gauge::units {
675    if {$itk_option(-units) != ""
676          && [::Rappture::Units::System::for $itk_option(-units)] == ""} {
677        error "unrecognized system of units \"$itk_option(-units)\""
678    }
679}
680
681# ----------------------------------------------------------------------
682# CONFIGURATION OPTION: -valueposition
683# ----------------------------------------------------------------------
684itcl::configbody Rappture::Gauge::valueposition {
685    set pos $itk_option(-valueposition)
686    set opts {left right top bottom}
687    if {[lsearch -exact $opts $pos] < 0} {
688        error "bad value \"$pos\": should be [join $opts {, }]"
689    }
690    _layout
691}
692
693# ----------------------------------------------------------------------
694# CONFIGURATION OPTION: -presets
695# ----------------------------------------------------------------------
696itcl::configbody Rappture::Gauge::presets {
697    if {"" == $itk_option(-presets)} {
698        pack forget $itk_component(presets)
699    } else {
700        if {$itk_option(-valueposition) == "left"} {
701            set s "left"
702        } else {
703            set s "right"
704        }
705        set first [lindex [pack slaves $itk_component(vframe)] 0]
706        pack $itk_component(presets) -before $first -side $s -fill y
707
708        $itk_component(presetlist) delete 0 end
709        $itk_component(presetlist) insert end $itk_option(-presets)
710    }
711}
712
713# ----------------------------------------------------------------------
714# CONFIGURATION OPTION: -type
715# ----------------------------------------------------------------------
716itcl::configbody Rappture::Gauge::type {
717    switch -- $itk_option(-type) {
718        integer {
719            set first [lindex [pack slaves $itk_component(vframe)] 0]
720            if {$first == $itk_component(presets)} {
721                pack $itk_component(spinner) -after $first -side left -fill y
722            } else {
723                pack $itk_component(spinner) -before $first -side right -fill y
724            }
725        }
726        real {
727            pack forget $itk_component(spinner)
728        }
729        default {
730            error "bad number type \"$itk_option(-type)\": should be integer or real"
731        }
732    }
733}
734
735itcl::body Rappture::Gauge::_pop_uq {win} {
736    # puts "min=$itk_option(-minvalue) max=$itk_option(-maxvalue) units=$itk_option(-units)"
737    set varname $itk_option(-varname)
738    set popup .pop_uq_$varname
739    if { ![winfo exists $popup] } {
740        Rappture::Balloon $popup -title $itk_option(-label)
741        set inner [$popup component inner]
742        frame $inner.type
743        pack $inner.type -side top -fill x
744        label $inner.type.l -text "Parameter Value:"
745        pack $inner.type.l -side left
746
747        set _val [Rappture::Combobox $inner.type.val -width 20 -editable no]
748        pack $_val -side left -expand yes -fill x
749        $_val choices insert end exact "Exact Value"
750        $_val choices insert end uniform "Uniform Distribution"
751        $_val choices insert end gaussian "Gaussian Distribution"
752        bind $_val <<Value>> [itcl::code $this _change_param_type $inner]
753
754        set _pde [Rappture::ProbDistEditor $inner.entry \
755        $itk_option(-minvalue) $itk_option(-maxvalue) $itk_option(-units) $_value]
756        $_val value $_mode
757        $_pde value $_value
758        pack $inner.entry -expand yes -fill both -pady {10 0}
759
760        $popup configure \
761            -deactivatecommand [itcl::code $this _pop_uq_deactivate]
762    }
763    update
764    $popup activate $win right
765}
766
767itcl::body Rappture::Gauge::_pop_uq_deactivate {} {
768    # puts "deactivate [$_pde value]"
769    value [$_pde value]
770}
771
772itcl::body Rappture::Gauge::_change_param_type {inner} {
773    set val [$_val translate [$_val value]]
774    $_pde mode $val
775}
Note: See TracBrowser for help on using the repository browser.