source: branches/nanovis2/gui/scripts/drawingcontrols.tcl @ 3305

Last change on this file since 3305 was 3305, checked in by ldelgass, 12 years ago

sync with trunk
File size: 17.3 KB
Line 
1
2# ----------------------------------------------------------------------
3#  COMPONENT: drawingcontrols - Print X-Y plot.
4#
5# ======================================================================
6#  AUTHOR:  Michael McLennan, Purdue University
7#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
8#
9#  See the file "license.terms" for information on usage and
10#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
11# ======================================================================
12package require Itk
13package require BLT
14
15#option add *DrawingControls.width 3i widgetDefault
16#option add *DrawingControls.height 3i widgetDefault
17#option add *DrawingControls*Font "Arial 9" widgetDefault
18option add *DrawingControls.padding 4 widgetDefault
19option add *DrawingControls.labelFont \
20    -*-helvetica-medium-r-normal-*-12-* widgetDefault
21
22
23itcl::class Rappture::DrawingControls {
24    inherit itk::Widget
25
26    constructor {args} {}
27    destructor {}
28
29    itk_option define -padding padding Padding 0
30
31    public variable deactivatecommand ""
32
33    public method add { path }
34    public method delete { {name "all"} }
35
36    private method ControlChanged { name }
37    private method ControlValue {path {units ""}}
38    private method Rebuild {}
39    private method FormatLabel {str}
40    private method Monitor {name state}
41    private variable _dispatcher ""
42    private variable _controls ""
43    private variable _name2info
44    private variable _counter 0
45    private variable _owner ""
46    private variable _frame ""
47    private variable _closeOnChange 0
48}
49
50# ----------------------------------------------------------------------
51# CONSTRUCTOR
52# ----------------------------------------------------------------------
53itcl::body Rappture::DrawingControls::constructor { owner args } {
54    Rappture::dispatcher _dispatcher
55    $_dispatcher register !layout
56    $_dispatcher dispatch $this !layout "[itcl::code $this Rebuild]; list"
57   
58    set _owner $owner
59    set _frame $itk_interior.frame
60    frame $_frame
61    itk_component add cancel {
62        button $itk_interior.cancel -text "cancel" -command $deactivatecommand
63    }
64    itk_component add save {
65        button $itk_interior.save -text "save"  -command $deactivatecommand
66    }
67    #
68    # Put this frame in whenever the control frame is empty.
69    # It forces the size to contract back now when controls are deleted.
70    #
71    frame $_frame.empty -width 1 -height 1
72    blt::table $itk_interior \
73        0,0 $_frame -fill both -cspan 2
74
75    eval itk_initialize $args
76}
77
78# ----------------------------------------------------------------------
79# DESTRUCTOR
80# ----------------------------------------------------------------------
81itcl::body Rappture::DrawingControls::destructor {} {
82    array unset _name2info
83}
84
85itcl::body Rappture::DrawingControls::delete { {cname "all"} } {
86    set controls $cname
87    if { $cname == "all" } {
88        set controls $_controls
89    }
90    foreach name $controls {
91        set w $_frame.v$name
92        destroy $w
93        if { [info exists _name2info($name-label)] } {
94            destroy $_frame.l$name
95        }
96        set i [lsearch $_controls $name]
97        set _controls [lreplace $_controls $i $i]
98        array unset _name2info $name-*
99    }
100}
101
102itcl::body Rappture::DrawingControls::add { path } {
103    set pos [llength $_controls]
104    incr _counter
105    set name "control$_counter"
106    set path [$_owner xml element -as path $path]
107
108    set _name2info($name-path) $path
109    set _name2info($name-label) ""
110    set _name2info($name-type) ""
111    set w $_frame.v$name
112    set _name2info($name-value) $w
113    set _name2info($name-enable) "yes"
114    set _name2info($name-disablestyle) "greyout"
115
116    set type [$_owner xml element -as type $path]
117    set _name2info($name-type) $type
118    switch -- $type {
119        choice {
120            Rappture::ChoiceEntry $w $_owner $path
121            bind $w <<Value>> [itcl::code $this ControlChanged $name]
122        }
123        filechoice {
124            Rappture::FileChoiceEntry $w $_owner $path
125            bind $w <<Value>> [itcl::code $this ControlChanged $name]
126        }
127        filelist {
128            Rappture::FileListEntry $w $_owner $path
129            bind $w <<Value>> [itcl::code $this ControlChanged $name]
130        }
131        group {
132            Rappture::GroupEntry $w $_owner $path
133        }
134        loader {
135            Rappture::Loader $w $_owner $path -tool [$_owner tool]
136            bind $w <<Value>> [itcl::code $this ControlChanged $name]
137        }
138        number {
139            Rappture::NumberEntry $w $_owner $path
140            bind $w <<Value>> [itcl::code $this ControlChanged $name]
141        }
142        integer {
143            Rappture::IntegerEntry $w $_owner $path
144            bind $w <<Value>> [itcl::code $this ControlChanged $name]
145        }
146        boolean {
147            Rappture::BooleanEntry $w $_owner $path
148            bind $w <<Value>> [itcl::code $this ControlChanged $name]
149        }
150        string {
151            Rappture::TextEntry $w $_owner $path
152            bind $w <<Value>> [itcl::code $this ControlChanged $name]
153        }
154        image {
155            Rappture::ImageEntry $w $_owner $path
156        }
157        separator {
158            # no widget to create
159            set _name2info($name-value) "--"
160        }
161        note {
162            Rappture::Note $w $_owner $path
163        }
164        periodicelement {
165            Rappture::PeriodicElementEntry $w $_owner $path
166            bind $w <<Value>> [itcl::code $this _controlChanged $name]
167        }
168        default {
169            error "don't know how to add control type \"$type\""
170        }
171    }
172    #
173    # If this element has an <enable> expression, then register its
174    # controlling widget here. 
175    #
176    set notify [string trim [$_owner xml get $path.about.notify]]
177
178    set disablestyle [string trim [$_owner xml get $path.about.disablestyle]]
179    if { $disablestyle != "" } {
180        set _name2info($name-disablestyle) $disablestyle
181    }
182
183    if 0 {
184    #
185    # If this element has an <enable> expression, then register
186    # its controlling widget here.
187    #
188    set enable [string trim [$_owner xml get $path.about.enable]]
189    if {"" == $enable} {
190        set enable yes
191    }
192    if {![string is boolean $enable]} {
193        set re {([a-zA-Z_]+[0-9]*|\([^\(\)]+\)|[a-zA-Z_]+[0-9]*\([^\(\)]+\))(\.([a-zA-Z_]+[0-9]*|\([^\(\)]+\)|[a-zA-Z_]+[0-9]*\([^\(\)]+\)))*(:[-a-zA-Z0-9/]+)?}
194        set rest $enable
195        set enable ""
196        set deps ""
197        while {1} {
198            if {[regexp -indices $re $rest match]} {
199                foreach {s0 s1} $match break
200
201                if {[string index $rest [expr {$s0-1}]] == "\""
202                      && [string index $rest [expr {$s1+1}]] == "\""} {
203                    # string in ""'s? then leave it alone
204                    append enable [string range $rest 0 $s1]
205                    set rest [string range $rest [expr {$s1+1}] end]
206                } else {
207                    #
208                    # This is a symbol which should be substituted
209                    # it can be either:
210                    #   input.foo.bar
211                    #   input.foo.bar:units
212                    #
213                    set cpath [string range $rest $s0 $s1]
214                    set parts [split $cpath :]
215                    set ccpath [lindex $parts 0]
216                    set units [lindex $parts 1]
217
218                    # make sure we have the standard path notation
219                    set stdpath [$_owner regularize $ccpath]
220                    if {"" == $stdpath} {
221                        puts stderr "WARNING: don't recognize parameter $cpath in <enable> expression for $path.  This may be buried in a structure that is not yet loaded."
222                        set stdpath $ccpath
223                    }
224                    # substitute [_controlValue ...] call in place of path
225                    append enable [string range $rest 0 [expr {$s0-1}]]
226                    append enable [format {[ControlValue %s %s]} $stdpath $units]
227                    lappend deps $stdpath
228                    set rest [string range $rest [expr {$s1+1}] end]
229                }
230            } else {
231                append enable $rest
232                break
233            }
234        }
235        foreach cpath $deps {
236            $_owner dependenciesfor $cpath $path
237        }
238    }
239    }
240    set _name2info($name-enable) yes
241
242    #set wid [$_owner widgetfor $path]
243
244    if {[lsearch {control group separator note} $type] < 0} {
245        # make a label for this control
246        set label [$w label]
247        if {"" != $label} {
248            set _name2info($name-label) $_frame.l$name
249            set font [option get $itk_component(hull) labelFont Font]
250            label $_name2info($name-label) -text [FormatLabel $label] \
251                -font $font
252        }
253
254        # register the tooltip for this control
255        set tip [$w tooltip]
256        if {"" != $tip} {
257            Rappture::Tooltip::for $w $tip
258
259            # add the tooltip to the label too, if there is one
260            if {$_name2info($name-label) != ""} {
261                Rappture::Tooltip::for $_name2info($name-label) $tip
262            }
263        }
264    }
265
266    # insert the new control onto the known list
267    set _controls [linsert $_controls $pos $name]
268    Monitor $name on
269
270    # now that we have a new control, we should fix the layout
271    $_dispatcher event -idle !layout
272    ControlChanged $name
273    return $name
274}
275
276# ----------------------------------------------------------------------
277# USAGE: ControlChanged <name>
278#
279# Invoked automatically whenever the value for a control changes.
280# Sends a notification along to the tool controlling this panel.
281# ----------------------------------------------------------------------
282itcl::body Rappture::DrawingControls::ControlChanged {name} {
283    set wv $_name2info($name-value)
284    set value [$wv value]
285    set path $_name2info($name-path)
286    set wid [$_owner widgetfor $path]
287    # Push the new value into the shadow widget.
288    $wid value $value
289    # Overwrite the default value
290    $_owner xml put $path.default $value
291    set path $_name2info($name-path)
292    # Let the owner know that this control changed.
293    if {"" != $_owner} {
294        $_owner changed $path
295    }
296    if { [winfo class $wid] == "TextEntry" } {
297        return
298    }
299    eval $deactivatecommand
300}
301
302# ----------------------------------------------------------------------
303# USAGE: Rebuild
304#
305# Used internally to fix the layout of controls whenever controls
306# are added or deleted, or when the control arrangement changes.
307# There are a lot of heuristics here trying to achieve a "good"
308# arrangement of controls.
309# ----------------------------------------------------------------------
310itcl::body Rappture::DrawingControls::Rebuild {} {
311    #
312    # Clear any existing layout
313    #
314    foreach name $_controls {
315        foreach elem {label value} {
316            set w $_name2info($name-$elem)
317            if {$w != "" && [winfo exists $w]} {
318                grid forget $w
319            }
320        }
321    }
322    grid forget $_frame.empty
323
324    #
325    # Decide which widgets should be shown and which should be hidden.
326    #
327    set hidden ""
328    set showing ""
329    foreach name $_controls {
330        set show 1
331        set cond $_name2info($name-enable)
332        if {[string is boolean $cond] && !$cond} {
333            # hard-coded "off" -- ignore completely
334        } elseif {[catch {expr $cond} show] == 0} {
335            set type $_name2info($name-type)
336            set disablestyle $_name2info($name-disablestyle)
337            set lwidget $_name2info($name-label)
338            set vwidget $_name2info($name-value)
339            if {[lsearch -exact {group image structure} $type] >= 0 ||
340                $disablestyle == "hide" } {
341                if {$show ne "" && $show} {
342                    lappend showing $name
343                } else {
344                    lappend hidden $name
345                }
346            } else {
347                # show other objects, but enable/disable them
348                lappend showing $name
349                if {$show ne "" && $show} {
350                    if {[winfo exists $vwidget]} {
351                        $vwidget configure -state normal
352                    }
353                    if {[winfo exists $lwidget]} {
354                        $lwidget configure -foreground \
355                            [lindex [$lwidget configure -foreground] 3]
356                    }
357                } else {
358                    if {[winfo exists $vwidget]} {
359                        $vwidget configure -state disabled
360                    }
361                    if {[winfo exists $lwidget]} {
362                        $lwidget configure -foreground gray
363                    }
364                }
365            }
366        } else {
367            bgerror "Error in <enable> expression for \"$_name2info($name-path)\":\n  $show"
368        }
369    }
370
371    # store the showing tabs in the object so it can be used in _changeTabs
372    set _showing $showing
373
374    #
375    # SCHEME: hlabels
376    # simple "Label: Value" layout
377    #
378    #pack forget $_tabs
379    grid propagate $_frame on
380    grid columnconfigure $_frame 0 -weight 0
381    grid rowconfigure $_frame 0 -weight 0
382   
383    set expand 0  ;# most controls float to top
384    set row 0
385    foreach name $showing {
386        set wl $_name2info($name-label)
387        if {$wl != "" && [winfo exists $wl]} {
388            grid $wl -row $row -column 0 -sticky e
389        }
390       
391        set wv $_name2info($name-value)
392        if {$wv != "" && [winfo exists $wv]} {
393            if {$wl != ""} {
394                grid $wv -row $row -column 1 -sticky ew
395            } else {
396                grid $wv -row $row -column 0 -columnspan 2 -sticky ew
397            }
398           
399            grid rowconfigure $_frame $row -weight 0
400           
401            switch -- [winfo class $wv] {
402                TextEntry {
403                    if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
404                        grid $wl -sticky n -pady 4
405                        grid $wv -sticky nsew
406                        grid rowconfigure $_frame $row -weight 1
407                        grid columnconfigure $_frame 1 -weight 1
408                        set expand 1
409                    }
410                }
411                GroupEntry {
412                    $wv configure -heading yes
413                   
414                    #
415                    # Scan through all children in this group
416                    # and see if any demand more space.  If the
417                    # group contains a structure or a note, then
418                    # make sure that the group itself is set to
419                    # expand/fill.
420                    #
421                    set queue [winfo children $wv]
422                    set expandgroup 0
423                    while {[llength $queue] > 0} {
424                        set w [lindex $queue 0]
425                        set queue [lrange $queue 1 end]
426                        set c [winfo class $w]
427                        if {[lsearch {DeviceEditor Note} $c] >= 0} {
428                            set expandgroup 1
429                            break
430                        }
431                        eval lappend queue [winfo children $w]
432                    }
433                    if {$expandgroup} {
434                        set expand 1
435                        grid $wv -sticky nsew
436                        grid rowconfigure $_frame $row -weight 1
437                    }
438                }
439                Note {
440                    grid $wv -sticky nsew
441                    grid rowconfigure $_frame $row -weight 1
442                    set expand 1
443                }
444            }
445            grid columnconfigure $_frame 1 -weight 1
446        } elseif {$wv == "--"} {
447            grid rowconfigure $_frame $row -minsize 10
448        }
449       
450        incr row
451        grid rowconfigure $_frame $row -minsize $itk_option(-padding)
452        incr row
453    }
454    grid $_frame.empty -row $row
455   
456    #
457    # If there are any hidden items, then make the bottom of
458    # this form fill up any extra space, so the form floats
459    # to the top.  Otherwise, it will jitter around as the
460    # hidden items come and go.
461    #
462    if {[llength $hidden] > 0 && !$expand} {
463        grid rowconfigure $_frame 99 -weight 1
464    } else {
465        grid rowconfigure $_frame 99 -weight 0
466    }
467    set _closeOnChange 0
468    set slaves [grid slaves $_frame]
469    if { [llength $slaves] == 1 } {
470        set slave [lindex $slaves 0]
471        set _closeOnChange 1
472    }
473}
474
475# ----------------------------------------------------------------------
476# USAGE: ControlValue <path> ?<units>?
477#
478# Used internally to get the value of a control with the specified
479# <path>.  Returns the current value for the control.
480# ----------------------------------------------------------------------
481itcl::body Rappture::DrawingControls::ControlValue {path {units ""}} {
482    if {"" != $_owner} {
483        set val [$_owner valuefor $path]
484        if {"" != $units} {
485            set val [Rappture::Units::convert $val -to $units -units off]
486        }
487        return $val
488    }
489    return ""
490}
491
492# ----------------------------------------------------------------------
493# USAGE: FormatLabel <string>
494#
495# Used internally to format a label <string>.  Trims any excess
496# white space and adds a ":" to the end.  That way, all labels
497# have a uniform look.
498# ----------------------------------------------------------------------
499itcl::body Rappture::DrawingControls::FormatLabel {str} {
500    set str [string trim $str]
501    if {"" != $str && [string index $str end] != ":"} {
502        append str ":"
503    }
504    return $str
505}
506
507# ----------------------------------------------------------------------
508# USAGE: Monitor <name> <state>
509#
510# Used internally to add/remove bindings that cause the widget
511# associated with <name> to notify this controls widget of size
512# changes.  Whenever there is a size change, this controls widget
513# should fix its layout.
514# ----------------------------------------------------------------------
515itcl::body Rappture::DrawingControls::Monitor {name state} {
516    set tag "Controls-$this"
517    set wv $_name2info($name-value)
518    if {$wv == "--" || [catch {bindtags $wv} btags]} {
519        return
520    }
521    set i [lsearch $btags $tag]
522
523    if {$state} {
524        if {$i < 0} {
525            bindtags $wv [linsert $btags 0 $tag]
526        }
527    } else {
528        if {$i >= 0} {
529            bindtags $wv [lreplace $btags $i $i]
530        }
531    }
532}
533
534# ----------------------------------------------------------------------
535# OPTION: -padding
536# ----------------------------------------------------------------------
537itcl::configbody Rappture::DrawingControls::padding {
538    $_dispatcher event -idle !layout
539}
540
Note: See TracBrowser for help on using the repository browser.