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

Last change on this file since 6 was 6, checked in by mmc, 19 years ago

Fixed the Tcl library to mirror the API developed for XML
libraries on the Python side. The Tcl Rappture::library
now has methods like "children", "element", "put", etc.
One difference: On the Tcl side, the default -flavor for
element/children is "component", since that works better
in Tcl code. In Python, the default is flavor=object.

Also fixed the Tcl install script to install not just
the tcl/scripts library, but also the ../gui and ../lib
directories.
File size: 21.6 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  Purdue Research Foundation, West Lafayette, IN
13# ======================================================================
14package require Itk
15package require BLT
16
17option add *DeviceViewer1D.width 4i widgetDefault
18option add *DeviceViewer1D.height 4i widgetDefault
19option add *DeviceViewer1D.padding 4 widgetDefault
20option add *DeviceViewer1D.deviceSize 0.25i widgetDefault
21option add *DeviceViewer1D.deviceOutline black widgetDefault
22
23itcl::class Rappture::DeviceViewer1D {
24    inherit itk::Widget
25
26    itk_option define -device device Device ""
27    itk_option define -tool tool Tool ""
28
29    constructor {args} { # defined below }
30    destructor { # defined below }
31
32    public method controls {option args}
33                                                                               
34    protected method _fixTabs {}
35    protected method _changeTabs {}
36    protected method _fixAxes {}
37    protected method _align {}
38
39    protected method _marker {option {name ""} {path ""}}
40
41    protected method _controlCreate {container libObj path}
42    protected method _controlSet {widget libObj path}
43
44    private variable _device ""     ;# LibraryObj for device rep
45    private variable _tool ""       ;# LibraryObj for tool parameters
46    private variable _tab2fields    ;# maps tab name => list of fields
47    private variable _units ""      ;# units for field being edited
48    private variable _restrict ""   ;# restriction expr for field being edited
49    private variable _marker        ;# marker currently being edited
50}
51                                                                               
52itk::usual DeviceViewer1D {
53}
54
55# ----------------------------------------------------------------------
56# CONSTRUCTOR
57# ----------------------------------------------------------------------
58itcl::body Rappture::DeviceViewer1D::constructor {args} {
59    itk_option add hull.width hull.height
60    pack propagate $itk_component(hull) no
61
62    itk_component add tabs {
63        blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
64            -side bottom -tearoff 0 \
65            -selectcommand [itcl::code $this _changeTabs]
66    } {
67        keep -activebackground -activeforeground
68        keep -background -cursor -font
69        rename -highlightbackground -background background Background
70        keep -highlightcolor -highlightthickness
71        keep -selectbackground -selectforeground
72        keep -tabbackground -tabforeground
73    }
74    pack $itk_component(tabs) -expand yes -fill both
75
76    itk_component add -protected inner {
77        frame $itk_component(tabs).inner
78    }
79
80    itk_component add ambient {
81        frame $itk_component(inner).ambient
82    }
83    pack $itk_component(ambient) -side top -fill x
84
85    itk_component add layout {
86        Rappture::DeviceLayout1D $itk_component(inner).layout
87    }
88    pack $itk_component(layout) -side top -fill x -pady 4
89
90    itk_component add graph {
91        blt::graph $itk_component(inner).graph \
92            -highlightthickness 0 -plotpadx 0 -plotpady 0 \
93            -width 3i -height 3i
94    } {
95        keep -background -foreground -cursor -font
96    }
97    pack $itk_component(graph) -expand yes -fill both
98    $itk_component(graph) legend configure -hide yes
99
100    bind $itk_component(graph) <Configure> "
101        after cancel [itcl::code $this _fixAxes]
102        after idle [itcl::code $this _fixAxes]
103    "
104
105    itk_component add geditor {
106        Rappture::Editor $itk_component(graph).editor \
107            -activatecommand [itcl::code $this _marker activate] \
108            -validatecommand [itcl::code $this _marker validate] \
109            -applycommand [itcl::code $this _marker apply]
110    }
111
112    itk_component add devcntls {
113        Rappture::Notebook $itk_component(inner).devcntls
114    }
115    pack $itk_component(devcntls) -side bottom -fill x
116
117    eval itk_initialize $args
118}
119
120# ----------------------------------------------------------------------
121# DESTRUCTOR
122# ----------------------------------------------------------------------
123itcl::body Rappture::DeviceViewer1D::destructor {} {
124    set _device ""
125    foreach name [array names _tab2fields] {
126        eval itcl::delete object $_tab2fields($name)
127    }
128    after cancel [list catch [itcl::code $this _fixAxes]]
129    after cancel [list catch [itcl::code $this _align]]
130}
131
132# ----------------------------------------------------------------------
133# USAGE: controls add <parameter>
134# USAGE: controls remove <parameter>|all
135#
136# Clients use this to add a control to the internal panels of this
137# widget.  If the <parameter> is ambient*, then the control is added
138# to the top, so it goes along with the layout of the device.  If
139# it is device.field*, then it goes in one of the field panels.
140# ----------------------------------------------------------------------
141itcl::body Rappture::DeviceViewer1D::controls {option args} {
142    switch -- $option {
143        add {
144            if {[llength $args] != 1} {
145                error "wrong # args: should be \"controls add parameter\""
146            }
147            set path [lindex $args 0]
148            if {[string match device.field* $path]} {
149            } elseif {[string match device.recipe* $path]} {
150                $itk_component(layout) controls add $path
151            } else {
152                _controlCreate $itk_component(ambient) $_tool $path
153            }
154        }
155        remove {
156            error "not yet implemented"
157        }
158        default {
159            error "bad option \"$option\": should be add or remove"
160        }
161    }
162}
163
164# ----------------------------------------------------------------------
165# USAGE: _fixTabs
166#
167# Used internally to search for fields and create corresponding
168# tabs whenever a device is installed into this viewer.
169#
170# If there are no tabs, then the widget is packed so that it appears
171# directly.  Otherwise, the interior reconfigured and assigned to
172# the current tab.
173# ----------------------------------------------------------------------
174itcl::body Rappture::DeviceViewer1D::_fixTabs {} {
175    #
176    # Release any info left over from the last device.
177    #
178    foreach name [array names _tab2fields] {
179        eval itcl::delete object $_tab2fields($name)
180    }
181    catch {unset _tab2fields}
182
183    #
184    # Scan through the current device and extract the list of
185    # fields.  Create a tab for each field.
186    #
187    if {$_device != ""} {
188        foreach nn [$_device children] {
189            if {[string match field* $nn]} {
190                set name [$_device get $nn.label]
191                if {$name == ""} {
192                    set name $nn
193                }
194
195                set fobj [Rappture::Field ::#auto $_device $_device $nn]
196                lappend _tab2fields($name) $fobj
197            }
198        }
199    }
200    set tabs [lsort [array names _tab2fields]]
201
202    if {[$itk_component(tabs) size] > 0} {
203        $itk_component(tabs) delete 0 end
204    }
205
206    if {[llength $tabs] <= 0} {
207        #
208        # No fields or one field?  Then we don't need to bother
209        # with tabs.  Just pack the inner frame directly.  If
210        # there are no fields, get rid of the graph.
211        #
212        pack $itk_component(inner) -expand yes -fill both
213        if {[llength $tabs] > 0} {
214            pack $itk_component(graph) -expand yes -fill both
215        } else {
216            pack forget $itk_component(graph)
217            $itk_component(layout) configure -leftmargin 0 -rightmargin 0
218        }
219    } else {
220        #
221        # Two or more fields?  Then create a tab for each field
222        # and select the first one by default.  Make sure the
223        # graph is packed.
224        #
225        pack forget $itk_component(inner)
226        pack $itk_component(graph) -expand yes -fill both
227
228        foreach name $tabs {
229            $itk_component(tabs) insert end $name
230        }
231        $itk_component(tabs) select 0
232    }
233    _changeTabs
234
235    #
236    # Fix the right margin of the graph so that it has enough room
237    # to display the right-hand edge of the device.
238    #
239    $itk_component(graph) configure \
240        -rightmargin [$itk_component(layout) extents bar3D]
241}
242
243# ----------------------------------------------------------------------
244# USAGE: _changeTabs
245#
246# Used internally to change the field being displayed whenever a new
247# tab is selected.
248# ----------------------------------------------------------------------
249itcl::body Rappture::DeviceViewer1D::_changeTabs {} {
250    set graph $itk_component(graph)
251
252    #
253    # Figure out which tab is selected and make the inner frame
254    # visible in that tab.
255    #
256    set i [$itk_component(tabs) index select]
257    if {$i != ""} {
258        set name [$itk_component(tabs) get $i]
259        $itk_component(tabs) tab configure $name \
260            -window $itk_component(inner) -fill both
261    } else {
262        set name [lindex [array names _tab2fields] 0]
263    }
264
265    #
266    # Update the graph to show the current field.
267    #
268    eval $graph element delete [$graph element names]
269    eval $graph marker delete [$graph marker names]
270
271    foreach {zmin zmax} [$itk_component(layout) limits] { break }
272    if {$zmax > $zmin} {
273        $graph axis configure x -min $zmin -max $zmax -title "Position (um)"
274    }
275
276    # turn on auto limits
277    $graph axis configure y -min "" -max ""
278
279    set flist ""
280    if {[info exists _tab2fields($name)]} {
281        set flist $_tab2fields($name)
282    }
283
284    set n 0
285    foreach fobj $flist {
286        catch {unset hints}
287        array set hints [$fobj hints]
288
289        if {[info exists hints(units)]} {
290            set _units $hints(units)
291            $graph axis configure y -title "$name ($hints(units))"
292        } else {
293            set _units ""
294            $graph axis configure y -title $name
295        }
296
297        if {[info exists hints(restrict)]} {
298            set _restrict $hints(restrict)
299        } else {
300            set _restrict ""
301        }
302
303        if {[info exists hints(scale)]
304              && [string match log* $hints(scale)]} {
305            $graph axis configure y -logscale yes
306        } else {
307            $graph axis configure y -logscale no
308        }
309
310        foreach comp [$fobj components] {
311            set elem "elem[incr n]"
312            foreach {xv yv} [$fobj vectors $comp] { break }
313            $graph element create $elem -x $xv -y $yv -symbol "" -linewidth 2
314
315            if {[info exists hints(color)]} {
316                $graph element configure $elem -color $hints(color)
317            }
318
319            foreach {path x y val} [$fobj controls get $comp] {
320                $graph marker create text -coords [list $x $y] \
321                    -text $val -anchor s -name $comp.$x
322                $graph marker bind $comp.$x <Enter> \
323                    [itcl::code $this _marker enter $comp.$x]
324                $graph marker bind $comp.$x <Leave> \
325                    [itcl::code $this _marker leave $comp.$x]
326                $graph marker bind $comp.$x <ButtonPress> \
327                    [itcl::code $this _marker edit $comp.$x $fobj/$path]
328            }
329        }
330    }
331
332    # let the widget settle, then fix the axes to "nice" values
333    after cancel [itcl::code $this _fixAxes]
334    after 20 [itcl::code $this _fixAxes]
335}
336
337# ----------------------------------------------------------------------
338# USAGE: _fixAxes
339#
340# Used internally to adjust the y-axis limits of the graph to "nice"
341# values, so that any control marker associated with the value,
342# for example, remains on screen.
343# ----------------------------------------------------------------------
344itcl::body Rappture::DeviceViewer1D::_fixAxes {} {
345    set graph $itk_component(graph)
346
347    #
348    # HACK ALERT!
349    # Use this code to fix up the y-axis limits for the BLT graph.
350    # The auto-limits don't always work well.  We want them to be
351    # set to a "nice" number slightly above or below the min/max
352    # limits.
353    #
354    set log [$graph axis cget y -logscale]
355    foreach {min max} [$graph axis limits y] { break }
356
357    if {$log} {
358        set min [expr {0.9*$min}]
359        set max [expr {1.1*$max}]
360    } else {
361        if {$min > 0} {
362            set min [expr {0.95*$min}]
363        } else {
364            set min [expr {1.05*$min}]
365        }
366        if {$max > 0} {
367            set max [expr {1.05*$max}]
368        } else {
369            set max [expr {0.95*$max}]
370        }
371    }
372
373    # bump up the max so that it's big enough to show control markers
374    set fnt $itk_option(-font)
375    set h [expr {[font metrics $fnt -linespace] + 5}]
376    foreach mname [$graph marker names] {
377        set xy [$graph marker cget $mname -coord]
378        foreach {x y} [eval $graph transform $xy] { break }
379        set y [expr {$y-$h}]  ;# find top of text in pixels
380        foreach {x y} [eval $graph invtransform [list 0 $y]] { break }
381        if {$y > $max} { set max $y }
382    }
383
384    if {$log} {
385        set min [expr {pow(10.0,floor(log10($min)))}]
386        set max [expr {pow(10.0,ceil(log10($max)))}]
387    } else {
388        set min [expr {0.1*floor(10*$min)}]
389        set max [expr {0.1*ceil(10*$max)}]
390    }
391
392    $graph axis configure y -min $min -max $max
393
394    after cancel [list catch [itcl::code $this _align]]
395    after 100 [list catch [itcl::code $this _align]]
396}
397
398# ----------------------------------------------------------------------
399# USAGE: _align
400#
401# Used internally to align the margins of the device layout and the
402# graph, so that two areas line up.
403# ----------------------------------------------------------------------
404itcl::body Rappture::DeviceViewer1D::_align {} {
405    set graph $itk_component(graph)
406
407    #
408    # Set the left/right margins of the layout so that it aligns
409    # with the graph.  Set the right margin of the graph so it
410    # it is big enough to show the 3D edge of the device that
411    # hangs over on the right-hand side.
412    #
413    update
414    foreach {xmin xmax} [$graph axis limits x] { break }
415    set lm [$graph xaxis transform $xmin]
416    $itk_component(layout) configure -leftmargin $lm
417
418    set w [winfo width $graph]
419    set rm [expr {$w-[$graph xaxis transform $xmax]}]
420    $itk_component(layout) configure -rightmargin $rm
421}
422
423# ----------------------------------------------------------------------
424# USAGE: _marker enter <name>
425# USAGE: _marker leave <name>
426# USAGE: _marker edit <name> <path>
427# USAGE: _marker activate
428# USAGE: _marker validate <value>
429# USAGE: _marker apply <value>
430#
431# Used internally to manipulate the control markers draw on the
432# graph for a field.
433# ----------------------------------------------------------------------
434itcl::body Rappture::DeviceViewer1D::_marker {option {name ""} {path ""}} {
435    switch -- $option {
436        enter {
437            $itk_component(graph) marker configure $name -background #e5e5e5
438        }
439        leave {
440            $itk_component(graph) marker configure $name -background ""
441        }
442        edit {
443            set _marker(name) $name
444            set _marker(fobj) [lindex [split $path /] 0]
445            set _marker(path) [lindex [split $path /] 1]
446            $itk_component(geditor) activate
447        }
448        activate {
449            set g $itk_component(graph)
450            set val [$g marker cget $_marker(name) -text]
451            foreach {x y} [$g marker cget $_marker(name) -coords] { break }
452            foreach {x y} [$g transform $x $y] { break }
453            set x [expr {$x + [winfo rootx $g] - 4}]
454            set y [expr {$y + [winfo rooty $g] - 5}]
455
456            set fnt $itk_option(-font)
457            set h [expr {[font metrics $fnt -linespace] + 2}]
458            set w [expr {[font measure $fnt $val] + 5}]
459
460            return [list text $val \
461                x [expr {$x-$w/2}] \
462                y [expr {$y-$h}] \
463                w $w \
464                h $h]
465        }
466        validate {
467            if {$_units != ""} {
468                if {[catch {Rappture::Units::convert $name \
469                        -context $_units -to $_units} result] != 0} {
470                    if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
471                          || [regexp {(.)(.+)} $result match first tail]} {
472                        set result "[string toupper $first]$tail"
473                    }
474                    bell
475                    Rappture::Tooltip::cue $itk_component(geditor) $result
476                    return 0
477                }
478                if {"" != $_restrict
479                      && [catch {Rappture::Units::convert $result \
480                        -context $_units -to $_units -units off} value] == 0} {
481
482                    set rexpr $_restrict
483                    regsub -all value $rexpr {$value} rexpr
484                    if {[catch {expr $rexpr} result] == 0 && !$result} {
485                        bell
486                        Rappture::Tooltip::cue $itk_component(geditor) "Should satisfy the condition: $_restrict"
487                        return 0
488                    }
489                }
490            }
491            return 1
492        }
493        apply {
494            if {$_units != ""} {
495                catch {Rappture::Units::convert $name \
496                    -context $_units -to $_units} value
497            } else {
498                set value $name
499            }
500
501            $_marker(fobj) controls put $_marker(path) $value
502            event generate $itk_component(hull) <<Edit>>
503
504            _changeTabs
505        }
506    }
507}
508
509# ----------------------------------------------------------------------
510# USAGE: _controlCreate <container> <libObj> <path>
511#
512# Used internally to create a gauge widget and pack it into the
513# given <container>.  When the gauge is set, it updates the value
514# for the <path> in the <libObj>.
515# ----------------------------------------------------------------------
516itcl::body Rappture::DeviceViewer1D::_controlCreate {container libObj path} {
517    set presets ""
518    foreach pre [$libObj children -type preset $path] {
519        lappend presets \
520            [$libObj get $path.$pre.value] \
521            [$libObj get $path.$pre.label]
522    }
523
524    set type Rappture::Gauge
525    set units [$libObj get $path.units]
526    if {$units != ""} {
527        set desc [Rappture::Units::description $units]
528        if {[string match temperature* $desc]} {
529            set type Rappture::TemperatureGauge
530        }
531    }
532
533    set counter 0
534    set w "$container.gauge[incr counter]"
535    while {[winfo exists $w]} {
536        set w "$container.gauge[incr counter]"
537    }
538
539    # create the widget
540    $type $w -units $units -presets $presets
541    pack $w -side top -anchor w
542    bind $w <<Value>> [itcl::code $this _controlSet $w $libObj $path]
543
544    set min [$libObj get $path.min]
545    if {"" != $min} { $w configure -minvalue $min }
546
547    set max [$libObj get $path.max]
548    if {"" != $max} { $w configure -maxvalue $max }
549
550    set str [$libObj get $path.default]
551    if {$str != ""} { $w value $str }
552
553    if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
554        set color [$libObj get $path.color]
555        if {$color == ""} {
556            set color blue
557        }
558        if {$units != ""} {
559            set min [Rappture::Units::convert $min -to $units -units off]
560            set max [Rappture::Units::convert $max -to $units -units off]
561        }
562        $w configure -spectrum [Rappture::Spectrum ::#auto [list \
563            $min white $max $color] -units $units]
564    }
565
566    set str [$libObj get $path.label]
567    if {$str != ""} {
568        set help [$libObj get $path.help]
569        if {"" != $help} {
570            append str "\n$help"
571        }
572        if {$units != ""} {
573            set desc [Rappture::Units::description $units]
574            append str "\n(units of $desc)"
575        }
576        Rappture::Tooltip::for $w $str
577    }
578
579    set str [$libObj get $path.icon]
580    if {$str != ""} {
581        $w configure -image [image create photo -data $str]
582    }
583}
584
585# ----------------------------------------------------------------------
586# USAGE: _controlSet <widget> <libObj> <path>
587#
588# Invoked automatically whenever an internal control changes value.
589# Queries the new value for the control and assigns the value to the
590# given <path> on the XML object <libObj>.
591# ----------------------------------------------------------------------
592itcl::body Rappture::DeviceViewer1D::_controlSet {widget libObj path} {
593    set newval [$widget value]
594    $libObj put $path.current $newval
595    event generate $itk_component(hull) <<Edit>>
596}
597
598# ----------------------------------------------------------------------
599# CONFIGURATION OPTION: -device
600#
601# Set to the Rappture::Library object representing the device being
602# displayed in the viewer.  If set to "", the viewer is cleared to
603# display nothing.
604# ----------------------------------------------------------------------
605itcl::configbody Rappture::DeviceViewer1D::device {
606    if {$itk_option(-device) != ""} {
607        if {![Rappture::library isvalid $itk_option(-device)]} {
608            error "bad value \"$itk_option(-device)\": should be Rappture::Library"
609        }
610    }
611    set _device $itk_option(-device)
612    _fixTabs
613}
614
615# ----------------------------------------------------------------------
616# CONFIGURATION OPTION: -tool
617#
618# Set to the Rappture::Library object containing tool parameters.
619# Needed only if controls are added to the widget, so the controls
620# can update the tool parameters.
621# ----------------------------------------------------------------------
622itcl::configbody Rappture::DeviceViewer1D::tool {
623    if {$itk_option(-tool) != ""} {
624        if {![Rappture::library isvalid $itk_option(-tool)]} {
625            error "bad value \"$itk_option(-tool)\": should be Rappture::Library"
626        }
627    }
628    set _tool $itk_option(-tool)
629}
Note: See TracBrowser for help on using the repository browser.