source: trunk/gui/scripts/deviceViewer1D.tcl @ 1837

Last change on this file since 1837 was 1837, checked in by gah, 14 years ago

add -tkwait flag to molvisviewer addmethod

File size: 26.8 KB
Line 
1# ----------------------------------------------------------------------
2#  COMPONENT: deviceViewer1D - visualizer for 1D device geometries
3#
4#  This widget is a simple visualizer for 1D devices.  It takes the
5#  Rappture XML representation for a 1D device and draws various
6#  facets of the data.  Each facet shows the physical layout along
7#  with some other quantity.  The "Electrical" facet shows electrical
8#  contacts.  The "Doping" facet shows the doping profile, and so
9#  forth.
10# ======================================================================
11#  AUTHOR:  Michael McLennan, Purdue University
12#  Copyright (c) 2004-2005  Purdue Research Foundation
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 Img
19package require BLT
20
21option add *DeviceViewer1D.padding 4 widgetDefault
22option add *DeviceViewer1D.deviceSize 0.25i widgetDefault
23option add *DeviceViewer1D.deviceOutline black widgetDefault
24option add *DeviceViewer1D*graph.width 3i widgetDefault
25option add *DeviceViewer1D*graph.height 2i widgetDefault
26
27itcl::class Rappture::DeviceViewer1D {
28    inherit itk::Widget
29
30    itk_option define -device device Device ""
31
32    constructor {owner args} { # defined below }
33    destructor { # defined below }
34
35    public method add {dataobj {settings ""}}
36    public method get {}
37    public method delete {args}
38    public method parameters {title args} { # do nothing }
39
40    public method controls {option args}
41    public method download {option args}
42                                                                               
43    protected method _loadDevice {}
44    protected method _loadParameters {frame path}
45    protected method _changeTabs {}
46    protected method _fixSize {}
47    protected method _fixAxes {}
48    protected method _align {}
49
50    protected method _marker {option {name ""} {path ""}}
51
52    protected method _controlCreate {container libObj path}
53    protected method _controlSet {widget libObj path}
54
55    private variable _owner ""      ;# thing managing this control
56    private variable _dlist ""      ;# list of dataobj objects
57    private variable _dobj2raise    ;# maps dataobj => raise flag
58    private variable _device ""     ;# XML library with <structure>
59    private variable _tab2fields    ;# maps tab name => list of fields
60    private variable _field2parm    ;# maps field path => parameter name
61    private variable _units ""      ;# units for field being edited
62    private variable _marker        ;# marker currently being edited
63}
64                                                                               
65itk::usual DeviceViewer1D {
66}
67
68# ----------------------------------------------------------------------
69# CONSTRUCTOR
70# ----------------------------------------------------------------------
71itcl::body Rappture::DeviceViewer1D::constructor {owner args} {
72    set _owner $owner
73
74    pack propagate $itk_component(hull) no
75
76    itk_component add tabs {
77        blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
78            -side bottom -tearoff 0 \
79            -selectcommand [itcl::code $this _changeTabs]
80    } {
81        keep -activebackground -activeforeground
82        keep -background -cursor -font
83        rename -highlightbackground -background background Background
84        keep -highlightcolor -highlightthickness
85        keep -tabbackground -tabforeground
86        rename -selectbackground -background background Background
87        rename -selectforeground -foreground foreground Foreground
88    }
89    pack $itk_component(tabs) -expand yes -fill both
90
91    itk_component add -protected inner {
92        frame $itk_component(tabs).inner
93    }
94
95    itk_component add top {
96        frame $itk_component(inner).top
97    }
98    pack $itk_component(top) -fill x
99
100    itk_component add layout {
101        Rappture::DeviceLayout1D $itk_component(inner).layout
102    }
103    pack $itk_component(layout) -side top -fill x -pady 4
104
105    itk_component add graph {
106        blt::graph $itk_component(inner).graph \
107            -highlightthickness 0 -plotpadx 0 -plotpady 0
108    } {
109        keep -background -foreground -cursor -font
110    }
111    pack $itk_component(graph) -expand yes -fill both
112    $itk_component(graph) legend configure -hide yes
113
114    bind $itk_component(graph) <Configure> "
115        [list after cancel [list catch [itcl::code $this _align]]]
116        [list after 100 [list catch [itcl::code $this _align]]]
117    "
118
119    itk_component add geditor {
120        Rappture::Editor $itk_component(graph).editor \
121            -activatecommand [itcl::code $this _marker activate] \
122            -validatecommand [itcl::code $this _marker validate] \
123            -applycommand [itcl::code $this _marker apply]
124    }
125
126    itk_component add devcntls {
127        Rappture::Notebook $itk_component(inner).devcntls
128    }
129    pack $itk_component(devcntls) -side bottom -fill x
130
131    eval itk_initialize $args
132
133    after cancel [list catch [itcl::code $this _fixSize]]
134    after idle [list catch [itcl::code $this _fixSize]]
135}
136
137# ----------------------------------------------------------------------
138# DESTRUCTOR
139# ----------------------------------------------------------------------
140itcl::body Rappture::DeviceViewer1D::destructor {} {
141    set _device ""
142    foreach name [array names _tab2fields] {
143        eval itcl::delete object $_tab2fields($name)
144    }
145    after cancel [list catch [itcl::code $this _fixAxes]]
146    after cancel [list catch [itcl::code $this _align]]
147    after cancel [list catch [itcl::code $this _loadDevice]]
148}
149
150# ----------------------------------------------------------------------
151# USAGE: add <dataobj> ?<settings>?
152#
153# Clients use this to add a data object to the plot.  The optional
154# <settings> are used to configure the plot.  Allowed settings are
155# -color, -brightness, -width, -linestyle, and -raise. Only
156# -brightness and -raise do anything.
157# ----------------------------------------------------------------------
158itcl::body Rappture::DeviceViewer1D::add {dataobj {settings ""}} {
159    array set params {
160        -color auto
161        -brightness 0
162        -width 1
163        -raise 0
164        -linestyle solid
165        -description ""
166        -param ""
167        -tkwait no
168    }
169    foreach {opt val} $settings {
170        if {![info exists params($opt)]} {
171            error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
172        }
173        set params($opt) $val
174    }
175 
176    set pos [lsearch -exact $dataobj $_dlist]
177
178    if {$pos < 0} {
179        if {![Rappture::library isvalid $dataobj]} {
180            error "bad value \"$dataobj\": should be Rappture::library object"
181        }
182
183        lappend _dlist $dataobj
184        set _dobj2raise($dataobj) $params(-raise)
185
186        after cancel [list catch [itcl::code $this _loadDevice]]
187        after idle [list catch [itcl::code $this _loadDevice]]
188    }
189}
190
191# ----------------------------------------------------------------------
192# USAGE: get
193#
194# Clients use this to query the list of objects being plotted, in
195# order from bottom to top of this result.
196# ----------------------------------------------------------------------
197itcl::body Rappture::DeviceViewer1D::get {} {
198    # put the dataobj list in order according to -raise options
199    set dlist $_dlist
200    foreach obj $dlist {
201        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
202            set i [lsearch -exact $dlist $obj]
203            if {$i >= 0} {
204                set dlist [lreplace $dlist $i $i]
205                lappend dlist $obj
206            }
207        }
208    }
209    return $dlist
210}
211
212# ----------------------------------------------------------------------
213# USAGE: delete ?<dataobj> <dataobj> ...?
214#
215# Clients use this to delete a dataobj from the plot. If no dataobjs
216# are specified, then all dataobjs are deleted.
217# ----------------------------------------------------------------------
218itcl::body Rappture::DeviceViewer1D::delete {args} {
219    if {[llength $args] == 0} {
220        set args $_dlist
221    }
222
223    # delete all specified dataobjs
224    set changed 0
225    foreach dataobj $args {
226        set pos [lsearch -exact $_dlist $dataobj]
227        if {$pos >= 0} {
228            set _dlist [lreplace $_dlist $pos $pos]
229            catch {unset _dobj2raise($dataobj)}
230            set changed 1
231        }
232    }
233
234    # if anything changed, then rebuild the plot
235    if {$changed} {
236        after cancel [list catch [itcl::code $this _loadDevice]]
237        after idle [list catch [itcl::code $this _loadDevice]]
238    }
239}
240
241# ----------------------------------------------------------------------
242# USAGE: controls insert <pos> <xmlobj> <path>
243#
244# Clients use this to add a control to the internal panels of this
245# widget.  Such controls are usually placed at the top of the widget,
246# but if possible, they are integrated directly onto the device
247# layout or the field area.
248# ----------------------------------------------------------------------
249itcl::body Rappture::DeviceViewer1D::controls {option args} {
250    switch -- $option {
251        insert {
252            if {[llength $args] != 3} {
253                error "wrong # args: should be \"controls insert pos xmlobj path\""
254            }
255            set pos [lindex $args 0]
256            set xmlobj [lindex $args 1]
257            set path [lindex $args 2]
258            if {[string match *structure.parameters* $path]} {
259            } elseif {[string match structure.components* $path]} {
260                $itk_component(layout) controls insert $pos $xmlobj $path
261            }
262        }
263        default {
264            error "bad option \"$option\": should be insert"
265        }
266    }
267}
268
269
270# ----------------------------------------------------------------------
271# USAGE: download coming
272# USAGE: download controls <downloadCommand>
273# USAGE: download now
274#
275# Clients use this method to create a downloadable representation
276# of the plot.  Returns a list of the form {ext string}, where
277# "ext" is the file extension (indicating the type of data) and
278# "string" is the data itself.
279# ----------------------------------------------------------------------
280itcl::body Rappture::DeviceViewer1D::download {option args} {
281    switch $option {
282        coming {
283            # nothing to do
284        }
285        controls {
286            # no controls for this download yet
287            return ""
288        }
289        now {
290            return ""  ;# not implemented yet!
291        }
292        default {
293            error "bad option \"$option\": should be coming, controls, now"
294        }
295    }
296}
297
298# ----------------------------------------------------------------------
299# USAGE: _loadDevice
300#
301# Used internally to search for fields and create corresponding
302# tabs whenever a device is installed into this viewer.
303# ----------------------------------------------------------------------
304itcl::body Rappture::DeviceViewer1D::_loadDevice {} {
305    set _device [lindex [get] end]
306
307    #
308    # Release any info left over from the last device.
309    #
310    foreach name [array names _tab2fields] {
311        eval itcl::delete object $_tab2fields($name)
312    }
313    catch {unset _tab2fields}
314    catch {unset _field2parm}
315
316    if {[winfo exists $itk_component(top).cntls]} {
317        $itk_component(top).cntls delete 0 end
318    }
319
320    #
321    # Scan through the current device and extract the list of
322    # fields.  Create a tab for each field.
323    #
324    if {$_device != ""} {
325        foreach nn [$_device children fields] {
326            set name [$_device get fields.$nn.about.label]
327            if {$name == ""} {
328                set name $nn
329            }
330
331            set fobj [Rappture::Field ::#auto $_device fields.$nn]
332            lappend _tab2fields($name) $fobj
333        }
334    }
335    set tabs [lsort [array names _tab2fields]]
336
337    if {[$itk_component(tabs) size] > 0} {
338        $itk_component(tabs) delete 0 end
339    }
340
341    if {[llength $tabs] <= 0} {
342        #
343        # No fields?  Then we don't need to bother with tabs.
344        # Just pack the inner frame directly.  If there are no
345        # fields, get rid of the graph.
346        #
347        pack $itk_component(inner) -expand yes -fill both
348        if {[llength $tabs] > 0} {
349            pack $itk_component(graph) -expand yes -fill both
350        } else {
351            pack forget $itk_component(graph)
352            $itk_component(layout) configure -leftmargin 0 -rightmargin 0
353        }
354    } else {
355        #
356        # Two or more fields?  Then create a tab for each field
357        # and select the first one by default.  Make sure the
358        # graph is packed.
359        #
360        pack forget $itk_component(inner)
361        pack $itk_component(graph) -expand yes -fill both
362
363        foreach name $tabs {
364            $itk_component(tabs) insert end $name \
365                -activebackground $itk_option(-background)
366        }
367        $itk_component(tabs) select 0
368    }
369
370    #
371    # Scan through and look for any parameters in the <structure>.
372    # Register any parameters associated with fields, so we can
373    # add them as active controls whenever we install new fields.
374    # Create controls for any remaining parameters, so the user
375    # can see that there's something to adjust.
376    #
377    if {$_device != ""} {
378        _loadParameters $itk_component(top) parameters
379    }
380
381    #
382    # Install the first tab
383    #
384    _changeTabs
385
386    #
387    # Fix the right margin of the graph so that it has enough room
388    # to display the right-hand edge of the device.
389    #
390    $itk_component(graph) configure \
391        -rightmargin [$itk_component(layout) extents bar3D]
392
393    after cancel [list catch [itcl::code $this _fixSize]]
394    after idle [list catch [itcl::code $this _fixSize]]
395}
396
397# ----------------------------------------------------------------------
398# USAGE: _loadParameters <frame> <path>
399#
400# Used internally in _loadDevice to load child parameters at the
401# specified <path> into the <frame>.  If any of the children are
402# groups, then this is called recursively to fill in the group
403# children.
404# ----------------------------------------------------------------------
405itcl::body Rappture::DeviceViewer1D::_loadParameters {frame path} {
406    foreach cname [$_device children $path] {
407        set handled 0
408        set type [$_device element -as type $path.$cname]
409        if {$type == "about"} {
410            continue
411        }
412        if {$type == "number"} {
413            set name [$_device element -as id $path.$cname]
414
415            # look for a field that uses this parameter
416            set found ""
417            foreach fname [$_device children fields] {
418                foreach comp [$_device children fields.$fname] {
419                    set v [$_device get fields.$fname.$comp.constant]
420                    if {[string equal $v $name]} {
421                        set found "fields.$fname.$comp"
422                        break
423                    }
424                }
425                if {"" != $found} break
426            }
427
428            if {"" != $found} {
429                set _field2parm($found) $name
430                set handled 1
431            }
432        }
433
434        #
435        # Any parameter that was not handled above should be handled
436        # here, by adding it to a control panel above the device
437        # layout area.
438        #
439        if {!$handled} {
440            if {![winfo exists $frame.cntls]} {
441                Rappture::Controls $frame.cntls $_owner
442                pack $frame.cntls -expand yes -fill both
443            }
444            $frame.cntls insert end $path.$cname
445
446            #
447            # If this is a group, then we must add its children
448            # recursively.
449            #
450            if {$type == "group"} {
451                set gr [$frame.cntls control -value end]
452                _loadParameters [$gr component inner] $path.$cname
453            }
454        }
455    }
456}
457
458# ----------------------------------------------------------------------
459# USAGE: _changeTabs
460#
461# Used internally to change the field being displayed whenever a new
462# tab is selected.
463# ----------------------------------------------------------------------
464itcl::body Rappture::DeviceViewer1D::_changeTabs {} {
465    set graph $itk_component(graph)
466
467    #
468    # Figure out which tab is selected and make the inner frame
469    # visible in that tab.
470    #
471    set i [$itk_component(tabs) index select]
472    if {$i != ""} {
473        set name [$itk_component(tabs) get $i]
474        $itk_component(tabs) tab configure $name \
475            -window $itk_component(inner) -fill both
476    } else {
477        set name [lindex [array names _tab2fields] 0]
478    }
479
480    #
481    # Update the graph to show the current field.
482    #
483    eval $graph element delete [$graph element names]
484    eval $graph marker delete [$graph marker names]
485
486    foreach {zmin zmax} [$itk_component(layout) limits] { break }
487    if {$zmin != "" && $zmin < $zmax} {
488        $graph axis configure x -min $zmin -max $zmax
489    }
490
491    if {$_device != ""} {
492        set units [$_device get units]
493        if {$units != "arbitrary"} {
494            $graph axis configure x -hide no -title "Position ($units)"
495        } else {
496            $graph axis configure x -hide yes
497        }
498    } else {
499        $graph axis configure x -hide no -title "Position"
500    }
501    $graph axis configure x -checklimits no
502
503    # turn on auto limits
504    $graph axis configure y -min "" -max "" -checklimits no
505
506    set flist ""
507    if {[info exists _tab2fields($name)]} {
508        set flist $_tab2fields($name)
509    }
510
511    set n 0
512    foreach fobj $flist {
513        catch {unset hints}
514        array set hints [$fobj hints]
515
516        if {[info exists hints(units)]} {
517            set _units $hints(units)
518            $graph axis configure y -title "$name ($hints(units))"
519        } else {
520            set _units ""
521            $graph axis configure y -title $name
522        }
523
524        if {[info exists hints(scale)]
525              && [string match log* $hints(scale)]} {
526            $graph axis configure y -logscale yes
527        } else {
528            $graph axis configure y -logscale no
529        }
530
531        foreach comp [$fobj components] {
532            # can only handle 1D meshes here
533            if {[$fobj components -dimensions $comp] != "1D"} {
534                continue
535            }
536
537            set elem "elem[incr n]"
538            set xv [$fobj mesh $comp]
539            set yv [$fobj values $comp]
540
541            $graph element create $elem -x $xv -y $yv \
542                -color black -symbol "" -linewidth 2
543
544            if {[info exists hints(color)]} {
545                $graph element configure $elem -color $hints(color)
546            }
547
548            foreach {path x y val} [$fobj controls get $comp] {
549                if {$path != ""} {
550                    set id "control[incr n]"
551                    $graph marker create text -coords [list $x $y] \
552                        -text $val -anchor s -name $id -background ""
553                    $graph marker bind $id <Enter> \
554                        [itcl::code $this _marker enter $id]
555                    $graph marker bind $id <Leave> \
556                        [itcl::code $this _marker leave $id]
557                    $graph marker bind $id <ButtonPress> \
558                        [itcl::code $this _marker edit $id $fobj/$path]
559                }
560            }
561        }
562    }
563
564    # let the widget settle, then fix the axes to "nice" values
565    after cancel [list catch [itcl::code $this _fixAxes]]
566    after 100 [list catch [itcl::code $this _fixAxes]]
567}
568
569# ----------------------------------------------------------------------
570# USAGE: _fixSize
571#
572# Used internally to fix the overall size of this widget based on
573# the various parts inside.  Sets the requested width/height of the
574# widget so that it is big enough to display the device and its
575# fields.
576# ----------------------------------------------------------------------
577itcl::body Rappture::DeviceViewer1D::_fixSize {} {
578    update idletasks
579    set w [winfo reqwidth $itk_component(tabs)]
580    set h [winfo reqheight $itk_component(tabs)]
581    component hull configure -width $w -height $h
582}
583
584# ----------------------------------------------------------------------
585# USAGE: _fixAxes
586#
587# Used internally to adjust the y-axis limits of the graph to "nice"
588# values, so that any control marker associated with the value,
589# for example, remains on screen.
590# ----------------------------------------------------------------------
591itcl::body Rappture::DeviceViewer1D::_fixAxes {} {
592    set graph $itk_component(graph)
593    if {![winfo ismapped $graph]} {
594        after cancel [list catch [itcl::code $this _fixAxes]]
595        after 100 [list catch [itcl::code $this _fixAxes]]
596        return
597    }
598
599    #
600    # HACK ALERT!
601    # Use this code to fix up the y-axis limits for the BLT graph.
602    # The auto-limits don't always work well.  We want them to be
603    # set to a "nice" number slightly above or below the min/max
604    # limits.
605    #
606    set log [$graph axis cget y -logscale]
607    $graph axis configure y -min "" -max ""
608    foreach {min max} [$graph axis limits y] { break }
609
610    if {$log} {
611        set min [expr {0.9*$min}]
612        set max [expr {1.1*$max}]
613    } else {
614        if {$min > 0} {
615            set min [expr {0.95*$min}]
616        } else {
617            set min [expr {1.05*$min}]
618        }
619        if {$max > 0} {
620            set max [expr {1.05*$max}]
621        } else {
622            set max [expr {0.95*$max}]
623        }
624    }
625
626    # bump up the max so that it's big enough to show control markers
627    set fnt $itk_option(-font)
628    set h [expr {[font metrics $fnt -linespace] + 5}]
629    foreach mname [$graph marker names] {
630        set xy [$graph marker cget $mname -coord]
631        foreach {x y} [eval $graph transform $xy] { break }
632        set y [expr {$y-$h}]  ;# find top of text in pixels
633        foreach {x y} [eval $graph invtransform [list 0 $y]] { break }
634        if {$y > $max} { set max $y }
635    }
636
637    if {$log} {
638        set min [expr {pow(10.0,floor(log10($min)))}]
639        set max [expr {pow(10.0,ceil(log10($max)))}]
640    } else {
641        set min [expr {0.1*floor(10*$min)}]
642        set max [expr {0.1*ceil(10*$max)}]
643    }
644
645    $graph axis configure y -min $min -max $max
646
647    after cancel [list catch [itcl::code $this _align]]
648    after 100 [list catch [itcl::code $this _align]]
649}
650
651# ----------------------------------------------------------------------
652# USAGE: _align
653#
654# Used internally to align the margins of the device layout and the
655# graph, so that two areas line up.
656# ----------------------------------------------------------------------
657itcl::body Rappture::DeviceViewer1D::_align {} {
658    set graph $itk_component(graph)
659
660    #
661    # Set the left/right margins of the layout so that it aligns
662    # with the graph.  Set the right margin of the graph so it
663    # it is big enough to show the 3D edge of the device that
664    # hangs over on the right-hand side.
665    #
666    update
667    foreach {xmin xmax} [$graph axis limits x] { break }
668    set lm [$graph xaxis transform $xmin]
669    $itk_component(layout) configure -leftmargin $lm
670
671    set w [winfo width $graph]
672    set rm [expr {$w-[$graph xaxis transform $xmax]}]
673    $itk_component(layout) configure -rightmargin $rm
674}
675
676# ----------------------------------------------------------------------
677# USAGE: _marker enter <name>
678# USAGE: _marker leave <name>
679# USAGE: _marker edit <name> <path>
680# USAGE: _marker activate
681# USAGE: _marker validate <value>
682# USAGE: _marker apply <value>
683#
684# Used internally to manipulate the control markers draw on the
685# graph for a field.
686# ----------------------------------------------------------------------
687itcl::body Rappture::DeviceViewer1D::_marker {option {name ""} {path ""}} {
688    switch -- $option {
689        enter {
690            $itk_component(graph) marker configure $name -background #e5e5e5
691            #
692            # BE CAREFUL:  Need an update here to force the graph to
693            #   refresh itself or else a subsequent click on the
694            #   marker will ignore the text that was recently changed,
695            #   and fail to generate a <ButtonPress> event!
696            #
697            update idletasks
698        }
699        leave {
700            $itk_component(graph) marker configure $name -background ""
701            #
702            # BE CAREFUL:  Need an update here to force the graph to
703            #   refresh itself or else a subsequent click on the
704            #   marker will ignore the text that was recently changed,
705            #   and fail to generate a <ButtonPress> event!
706            #
707            update idletasks
708        }
709        edit {
710            set _marker(name) $name
711            set _marker(fobj) [lindex [split $path /] 0]
712            set _marker(path) [lindex [split $path /] 1]
713            $itk_component(geditor) activate
714        }
715        activate {
716            set g $itk_component(graph)
717            set val [$g marker cget $_marker(name) -text]
718            foreach {x y} [$g marker cget $_marker(name) -coords] { break }
719            foreach {x y} [$g transform $x $y] { break }
720            set x [expr {$x + [winfo rootx $g] - 4}]
721            set y [expr {$y + [winfo rooty $g] - 5}]
722
723            set fnt $itk_option(-font)
724            set h [expr {[font metrics $fnt -linespace] + 2}]
725            set w [expr {[font measure $fnt $val] + 5}]
726
727            return [list text $val \
728                x [expr {$x-$w/2}] \
729                y [expr {$y-$h}] \
730                w $w \
731                h $h]
732        }
733        validate {
734            if {$_units != ""} {
735                if {[catch {Rappture::Units::convert $name \
736                        -context $_units -to $_units} result] != 0} {
737                    if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
738                          || [regexp {(.)(.+)} $result match first tail]} {
739                        set result "[string toupper $first]$tail"
740                    }
741                    bell
742                    Rappture::Tooltip::cue $itk_component(geditor) $result
743                    return 0
744                }
745            }
746            if {[catch {$_marker(fobj) controls validate $_marker(path) $name} result]} {
747                bell
748                Rappture::Tooltip::cue $itk_component(geditor) $result
749                return 0
750            }
751            return 1
752        }
753        apply {
754            if {$_units != ""} {
755                catch {Rappture::Units::convert $name \
756                    -context $_units -to $_units} value
757            } else {
758                set value $name
759            }
760
761            $_marker(fobj) controls put $_marker(path) $value
762            $_owner changed $_marker(path)
763            event generate $itk_component(hull) <<Edit>>
764
765            _changeTabs
766        }
767    }
768}
769
770# ----------------------------------------------------------------------
771# USAGE: _controlCreate <container> <libObj> <path>
772#
773# Used internally to create a gauge widget and pack it into the
774# given <container>.  When the gauge is set, it updates the value
775# for the <path> in the <libObj>.
776# ----------------------------------------------------------------------
777itcl::body Rappture::DeviceViewer1D::_controlCreate {container libObj path} {
778    set presets ""
779    foreach pre [$libObj children -type preset $path] {
780        lappend presets \
781            [$libObj get $path.$pre.value] \
782            [$libObj get $path.$pre.label]
783    }
784
785    set type Rappture::Gauge
786    set units [$libObj get $path.units]
787    if {$units != ""} {
788        set desc [Rappture::Units::description $units]
789        if {[string match temperature* $desc]} {
790            set type Rappture::TemperatureGauge
791        }
792    }
793
794    set counter 0
795    set w "$container.gauge[incr counter]"
796    while {[winfo exists $w]} {
797        set w "$container.gauge[incr counter]"
798    }
799
800    # create the widget
801    $type $w -units $units -presets $presets
802    pack $w -side top -anchor w
803    bind $w <<Value>> [itcl::code $this _controlSet $w $libObj $path]
804
805    set min [$libObj get $path.min]
806    if {"" != $min} { $w configure -minvalue $min }
807
808    set max [$libObj get $path.max]
809    if {"" != $max} { $w configure -maxvalue $max }
810
811    set str [$libObj get $path.default]
812    if {$str != ""} { $w value $str }
813
814    if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
815        set color [$libObj get $path.color]
816        if {$color == ""} {
817            set color blue
818        }
819        if {$units != ""} {
820            set min [Rappture::Units::convert $min -to $units -units off]
821            set max [Rappture::Units::convert $max -to $units -units off]
822        }
823        $w configure -spectrum [Rappture::Spectrum ::#auto [list \
824            $min white $max $color] -units $units]
825    }
826
827    set str [$libObj get $path.label]
828    if {$str != ""} {
829        set help [$libObj get $path.help]
830        if {"" != $help} {
831            append str "\n$help"
832        }
833        if {$units != ""} {
834            set desc [Rappture::Units::description $units]
835            append str "\n(units of $desc)"
836        }
837        Rappture::Tooltip::for $w $str
838    }
839
840    set str [$libObj get $path.icon]
841    if {$str != ""} {
842        $w configure -image [image create photo -data $str]
843    }
844}
845
846# ----------------------------------------------------------------------
847# USAGE: _controlSet <widget> <libObj> <path>
848#
849# Invoked automatically whenever an internal control changes value.
850# Queries the new value for the control and assigns the value to the
851# given <path> on the XML object <libObj>.
852# ----------------------------------------------------------------------
853itcl::body Rappture::DeviceViewer1D::_controlSet {widget libObj path} {
854    set newval [$widget value]
855    $libObj put $path.current $newval
856    event generate $itk_component(hull) <<Edit>>
857}
858
859# ----------------------------------------------------------------------
860# CONFIGURATION OPTION: -device
861#
862# Set to the Rappture::Library object representing the device being
863# displayed in the viewer.  If set to "", the viewer is cleared to
864# display nothing.
865# ----------------------------------------------------------------------
866itcl::configbody Rappture::DeviceViewer1D::device {
867    if {$itk_option(-device) != ""} {
868        if {![Rappture::library isvalid $itk_option(-device)]} {
869            error "bad value \"$itk_option(-device)\": should be Rappture::Library"
870        }
871    }
872
873    delete
874    if {"" != $itk_option(-device)} {
875        add $itk_option(-device)
876    }
877    _loadDevice
878}
Note: See TracBrowser for help on using the repository browser.