Changeset 2987 for branches/blt4/gui

Timestamp:

May 1, 2012, 3:22:07 PM (13 years ago)

Author:

gah

Message:

 

File:

• branches/blt4/gui/scripts/drawingentry.tcl (modified) (11 diffs)

branches/blt4/gui/scripts/drawingentry.tcl

@@ +1 @@
+
 # ----------------------------------------------------------------------
 #  COMPONENT: DrawingEntry - widget for entering numeric values
@@ -30 +31 @@
     private variable _xAspect 0
     private variable _yAspect 0
+    private variable _controls ""
+    private variable _showing ""
+
     constructor {owner path args} { # defined below }
 
@@ -52 +56 @@
     private method ScreenX { x } 
     private method ScreenY { y } 
-    private method Unhighlight { tag } 
+    private method Activate { tag } 
+    private method Deactivate { tag } 
+    private method Invoke { tag } 
+    private method Insert { tag } 
+    private method ControlChanged { tag } 
 }
 
@@ -163 +171 @@
     # Remove exists canvas items and hints
     $itk_component(drawing) delete all
+    # Delete any images that we created.
+    foreach name [array names _cname2image] {
+        image delete $_cname2image($name)
+    }
     # Recompute the size of the canvas/drawing area
     set _canvasWidth [winfo width $itk_component(drawing)] 
@@ -182 +194 @@
 }
 
-itcl::body Rappture::DrawingEntry::ParseLine { cpath cname } {
-    array set attr2option {
-        "linewidth"     "-width"
-        "arrow"         "-arrow"
-        "dash"          "-dash"
-        "color"         "-fill"
-    }
-    # Set default options first and then let tool.xml override them.
-    array set options {
-        -arrow          none
-        -width          0
-        -fill           black
-        -dash           ""
-    }
-    # Coords
-    set coords {}
-    set coords [$_owner xml get $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
-        set coords "0 0"
-    } else {
-        set coords [ScreenCoords $coords]
-    }
-    puts stderr "ParseLineDescrption description owner=$_owner cpath=$cpath coords=$coords"
-    set list {}
-    foreach attr [$_owner xml children $cpath] {
-        if { [info exists attr2option($attr)] } {
-            set option $attr2option($attr)
-            set value [$_owner xml get $cpath.$attr]
-            set options($option) $value
-        }
-    }
-    set options(-tags) $cname
-    puts stderr "$itk_component(drawing) create line $coords"
-    set id [eval $itk_component(drawing) create line $coords]
-    set _cname2id($cname) $id
-    eval $itk_component(drawing) itemconfigure $id [array get options]
+#
+# ParseDescription -- 
+#
+itcl::body Rappture::DrawingEntry::ParseDescription {} {
+    puts stderr "ParseDescrption description owner=$_owner path=$_path"
+    ParseBackground
+    ParseSubstitutions
+    foreach cname [$_owner xml children $_path.components] {
+        switch -glob -- $cname {
+            "line*" {
+                ParseLine $_path.components.$cname
+            }
+            "grid*" {
+                ParseGrid $_path.components.$cname
+            }
+            "text*" {
+                ParseText $_path.components.$cname
+            }
+            "picture*" {
+                ParsePicture $_path.components.$cname
+            }
+            "rectangle*" {
+                ParseRectangle $_path.components.$cname
+            }
+            "oval*" {
+                ParseOval $_path.components.$cname
+            }
+            "polygon*" {
+                ParsePolygon $_path.components.$cname
+            }
+            "hotspot*" {
+                ParseHotspot $_path.components.$cname
+            }
+        }
+    }
 }
 
@@ -310 +320 @@
 }
 
-itcl::body Rappture::DrawingEntry::ParseText { cpath cname } {
+#
+# ParseHotspot -- 
+#
+itcl::body Rappture::DrawingEntry::ParseHotspot { cpath cname } {
     array set attr2option {
-        "font"          "-font"
-        "default"       "-text"
-        "color"         "-fill"
-        "text"          "-text"
-        "anchor"        "-anchor"
-    }
-    puts stderr "ParseText description owner=$_owner cpath=$cpath"
-
+        "color" "-fill"
+        "anchor" "-anchor"
+    }
+    puts stderr "ParseHotspot owner=$_owner cpath=$cpath"
     # Set default options first and then let tool.xml override them.
     array set options {
-        -font {Arial 12}
-        -text {}
-        -fill black
+        -fill red
         -anchor c
     }
+    array unset _cname2controls $cname
     foreach attr [$_owner xml children $cpath] {
         if { [info exists attr2option($attr)] } {
@@ -332 +340 @@
             set value [$_owner xml get $cpath.$attr]
             set options($option) $value
-        }
+        } elseif { [string match "controls*" $attr] } {
+            set value [$_owner xml get $cpath.$attr]
+            lappend _cname2controls($cname) $value
+        }
+    }
+    # Coordinates
+    set coords [$_owner xml get $cpath.coords]
+    set coords [ScreenCoords $coords]
+    if { $coords == "" } {
+        set coords "0 0 1 1"
+    } 
+    set c $itk_component(drawing)
+    set img [image create picture -width 16 -height 16]
+    $img blank 0x0
+    $img draw text "?" 8 8 -anchor c -font "Arial 6" -shadow 1 \
+        -color $option(-fill)
+    foreach { x1 y1 } [ScreenCoords $coords] break
+    set id [$itk_component(drawing) create image $x1 $y1]
+    set options(-tags) $cname
+    set options(-image) $img
+    eval $c itemconfigure $id [array get options]
+    set _cname2id($cname) $id
+    set _cname2image($cname) $img
+    $c bind $id <Enter> [itcl::code $this Activate $cname]
+    $c bind $id <Leave> [itcl::code $this Deactivate $cname]
+    $c bind $id <ButtonPress-1> [itcl::code $this Depress $cname]
+    $c bind $id <ButtonRelease-1> [itcl::code $this Invoke $cname $x1 $y1]
+}
+
+#
+# ParseLine -- 
+#
+itcl::body Rappture::DrawingEntry::ParseLine { cpath cname } {
+    array set attr2option {
+        "linewidth"     "-width"
+        "arrow"         "-arrow"
+        "dash"          "-dash"
+        "color"         "-fill"
+    }
+    # Set default options first and then let tool.xml override them.
+    array set options {
+        -arrow          none
+        -width          0
+        -fill           black
+        -dash           ""
     }
     # Coords
@@ -343 +395 @@
         set coords [ScreenCoords $coords]
     }
+    puts stderr "ParseLineDescrption description owner=$_owner cpath=$cpath coords=$coords"
+    set list {}
+    foreach attr [$_owner xml children $cpath] {
+        if { [info exists attr2option($attr)] } {
+            set option $attr2option($attr)
+            set value [$_owner xml get $cpath.$attr]
+            set options($option) $value
+        }
+    }
+    set options(-tags) $cname
+    puts stderr "$itk_component(drawing) create line $coords"
+    set id [eval $itk_component(drawing) create line $coords]
+    set _cname2id($cname) $id
+    eval $itk_component(drawing) itemconfigure $id [array get options]
+}
+
+#
+# ParseOval -- 
+#
+itcl::body Rappture::DrawingEntry::ParseOval { cpath cname } {
+    array set attr2option {
+        "outline"       "-outline"
+        "fill"          "-fill"
+        "linewidth"     "-linewidth"
+    }
+    puts stderr "ParseOval description owner=$_owner cpath=$cpath"
+
+    # Set default options first and then let tool.xml override them.
+    array set options {
+        -fill blue
+        -linewidth 1 
+        -outline black
+    }
+    foreach attr [$_owner xml children $cpath] {
+        if { [info exists attr2option($attr)] } {
+            set option $attr2option($attr)
+            set value [$_owner xml get $cpath.$attr]
+            set options($option) $value
+        }
+    }
+    # Coordinates
+    set coords {}
+    set coords [$_owner xml get $cpath.coords]
+    set coords [string trim $coords]
+    if { $coords == "" } {
+        set coords "0 0 1 1"
+    }
+    foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
+    set id [eval $itk_component(drawing) create oval $coords]
+    set _cname2id($cname) $id
+}
+
+#
+# ParsePicture -- 
+#
+itcl::body Rappture::DrawingEntry::ParsePicture { cpath cname } {
+    array set attr2option {
+        "anchor"        "-anchor"
+    }
+    puts stderr "ParsePicture description owner=$_owner cpath=$cpath"
+    # Set default options first and then let tool.xml override them.
+    array set options {
+        -anchor nw
+    }
+    foreach attr [$_owner xml children $cpath] {
+        if { [info exists attr2option($attr)] } {
+            set option $attr2option($attr)
+            set value [$_owner xml get $cpath.$attr]
+            set options($option) $value
+        }
+    }
+    # Coordinates
+    set coords {}
+    set coords [$_owner xml get $cpath.coords]
+    set coords [ScreenCoords $coords]
+    if { [llength $coords] == 2 } {
+        foreach { x1 y1 } $coords break
+        set w [$_owner xml get $cpath.width]
+        if { $w == "" || ![string is number $w] || $w <= 0.0 } {
+            set width [expr [image width $img] / 4]
+        } else {
+            set width [expr [ScreenX $w] - [ScreenX 0]]
+        }
+        set h [$_owner xml get $cpath.height]
+        if { $h == "" || ![string is number $h] || $h <= 0.0 } {
+            set height [expr [image height $img] / 4]
+        } else {
+            set height [expr [ScreenY $h] - [ScreenY 0]]
+        }
+        if { $width != [image width $img] || $height != [image height $img] } {
+            set dst [image create picture -width $width -height $height]
+            $dst resample $img -filter box
+            image delete $img
+            set img $dst
+        }
+    } elseif { [llength $coords] == 4 } {
+        foreach { x1 y1 x2 y2 } $coords break
+        if { $x1 > $x2 } {
+            set tmp $x1 
+            set x1 $x2
+            set x2 $tmp
+        }
+        if { $y1 > $y2 } {
+            set tmp $x1 
+            set x1 $x2
+            set x2 $tmp
+        }
+        set width [expr $x2 - $x1 + 1]
+        set height [expr $x2 - $x1 + 1]
+        if { $width != [image width $img] || $height != [image height $img] } {
+            set dst [image create picture -width $width -height $height]
+            $dst resample $img -filter box
+            image delete $img
+            set img $dst
+        }
+    } else {
+        set width [expr [image width $img] / 4]
+        set height [expr [image height $img] / 4]
+        set dst [image create picture -width $width -height $height]
+        $dst resample $img -filter box
+        image delete $img
+        set img $dst
+        set x1 0 
+        set y1 0
+    }
+    set contents [$_owner xml get $cpath.contents]
+    if { [string compare -length 5 $contents "file:"] } {
+        set fileName [string range $contents 5 end]
+        set img [image create picture -file $fileName]
+    } elseif { [string compare -length 5 $contents "http:"] } {
+        puts stderr  "don't know how to handle http"
+    } else {
+        set img [image create picture -data $contents]
+    }
+    set options(-tags) $cname
+    set options(-image) $img
+    set id [eval $itk_component(drawing) create oval $coords]
+    set _cname2image($cname) $img
+    set _cname2id($cname) $id
+    eval $itk_component(drawing) itemconfigure $id [array get options]
+}
+
+
+itcl::body Rappture::DrawingEntry::ParsePolygon { cpath cname } {
+    array set attr2option {
+        "linewidth"     "-width"
+        "arrow"         "-arrow"
+        "color"         "-fill"
+    }
+    # Set default options first and then let tool.xml override them.
+    array set options {
+        -arrow          none
+        -width          0
+        -fill           black
+    }
+    # Coords
+    set coords {}
+    set coords [$_owner xml get $cpath.coords]
+    set coords [string trim $coords]
+    if { $coords == "" } {
+        set coords "0 0"
+    } else {
+        set coords [ScreenCoords $coords]
+    }
+    set x1 [lindex $coords 0]
+    set y1 [lindex $coords 1]
+    lappend coords $x1 $y1
+    puts stderr "ParsePolygon owner=$_owner cpath=$cpath coords=$coords"
+    set list {}
+    foreach attr [$_owner xml children $cpath] {
+        if { [info exists attr2option($attr)] } {
+            set option $attr2option($attr)
+            set value [$_owner xml get $cpath.$attr]
+            set options($option) $value
+        }
+    }
+    set options(-tags) $cname
+    set id [eval $itk_component(drawing) create polygon $coords]
+    set _cname2id($cname) $id
+    eval $itk_component(drawing) itemconfigure $id [array get options]
+}
+
+#
+# ParseRectangle -- 
+#
+itcl::body Rappture::DrawingEntry::ParseRectangle { cpath cname } {
+    array set attr2option {
+        "outline"       "-outline"
+        "fill"          "-fill"
+        "linewidth"     "-linewidth"
+    }
+    puts stderr "ParseRectangle description owner=$_owner cpath=$cpath"
+
+    # Set default options first and then let tool.xml override them.
+    array set options {
+        -fill blue
+        -linewidth 1 
+        -outline black
+    }
+    foreach attr [$_owner xml children $cpath] {
+        if { [info exists attr2option($attr)] } {
+            set option $attr2option($attr)
+            set value [$_owner xml get $cpath.$attr]
+            set options($option) $value
+        }
+    }
+    # Coordinates
+    set coords {}
+    set coords [$_owner xml get $cpath.coords]
+    set coords [string trim $coords]
+    if { $coords == "" } {
+        set coords "0 0 1 1"
+    }
+    foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
+    set id [eval $itk_component(drawing) create rectangle $coords]
+    set _cname2id($cname) $id
+}
+
+#
+# ParseText -- 
+#
+itcl::body Rappture::DrawingEntry::ParseText { cpath cname } {
+    array set attr2option {
+        "font"          "-font"
+        "color"         "-fill"
+        "text"          "-text"
+        "anchor"        "-anchor"
+    }
+    puts stderr "ParseText description owner=$_owner cpath=$cpath"
+
+    # Set default options first and then let tool.xml override them.
+    array set options {
+        -font {Arial 12}
+        -text {}
+        -fill black
+        -anchor c
+    }
+    foreach attr [$_owner xml children $cpath] {
+        if { [info exists attr2option($attr)] } {
+            set option $attr2option($attr)
+            set value [$_owner xml get $cpath.$attr]
+            set options($option) $value
+        }
+    }
+    # Coords
+    set coords {}
+    set coords [$_owner xml get $cpath.coords]
+    set coords [string trim $coords]
+    if { $coords == "" } {
+        set coords "0 0"
+    } else {
+        set coords [ScreenCoords $coords]
+    }
     set options(-tags) $cname
     puts stderr "$itk_component(drawing) create text $coords"
@@ -351 +656 @@
 }
 
-itcl::body Rappture::DrawingEntry::ParseRectangle { cpath cname } {
-    array set attr2option {
-        "outline"       "-outline"
-        "fill"          "-fill"
-        "linewidth"     "-linewidth"
-    }
-    puts stderr "ParseRectangle description owner=$_owner cpath=$cpath"
-
-    # Set default options first and then let tool.xml override them.
-    array set options {
-        -fill blue
-        -linewidth 1 
-        -outline black
-    }
-    foreach attr [$_owner xml children $cpath] {
-        if { [info exists attr2option($attr)] } {
-            set option $attr2option($attr)
-            set value [$_owner xml get $cpath.$attr]
-            set options($option) $value
-        }
-    }
-    # Coordinates
-    set coords {}
-    set coords [$_owner xml get $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
-        set coords "0 0 1 1"
-    }
-    foreach { x y } [ScreenCoords $coords] break
-    set lx $x
-    set ly $y
-
-    puts stderr "$itk_component(drawing) itemconfigure $id [array get options]"
-    eval $itk_component(drawing) itemconfigure $id [array get options]
-    set bbox [$itk_component(drawing) bbox $id]
-    puts stderr "cpath=$cpath bbox=$bbox"
-    set sid [eval $itk_component(drawing) create rectangle $bbox]
-    $itk_component(drawing) itemconfigure $sid -fill "" -outline "" \
-        -tag $cname-bg
-    set sid [eval $itk_component(drawing) create rectangle $bbox]
-    $itk_component(drawing) itemconfigure $sid -fill "" -outline "" \
-        -tag $cname-sensor
-    $itk_component(drawing) bind $cname-sensor <Enter> \
-        [itcl::code $this Highlight $cname]
-    $itk_component(drawing) bind $cname-sensor <Leave> \
-        [itcl::code $this Unhighlight $cname]
-    $itk_component(drawing) lower $cname-bg
-    $itk_component(drawing) raise $cname-sensor
-}
 
 itcl::body Rappture::DrawingEntry::ScreenX { x } {
@@ -445 +701 @@
     }
 }
-
-itcl::body Rappture::DrawingEntry::ParseDescription {} {
-    puts stderr "ParseDescrption description owner=$_owner path=$_path"
-    ParseBackground
-    ParseSubstitutions
-    foreach cname [$_owner xml children $_path.components] {
-        switch -glob -- $cname {
-            "line*" {
-                ParseLine $_path.components.$cname
-            }
-            "grid*" {
-                ParseGrid $_path.components.$cname
-            }
-            "text*" {
-                ParseText $_path.components.$cname
-            }
-            "picture*" {
-                ParsePicture $_path.components.$cname
-            }
-            "rectangle*" {
-                ParseRectangle $_path.components.$cname
-            }
-            "oval*" {
-                ParseOval $_path.components.$cname
-            }
-            "polygon*" {
-                ParsePolygon $_path.components.$cname
-            }
-            "hotspot*" {
-                ParseHotspot $_path.components.$cname
-            }
-        }
-    }
-}
-
-
 
 itcl::body Rappture::DrawingEntry::Highlight { tag } {
@@ -622 +842 @@
     }
 }
+
+#
+# ParseLine -- 
+#
+itcl::body Rappture::DrawingEntry::Invoke { cname x y } {
+    
+    set controls $_cname2controls($cname)
+    if { [llength $controls] == 0 } {
+        puts stderr "no controls defined for $cname"
+        return 
+    }
+    # Build a popup with the designated controls
+    set popup .drawingentrypopup
+    if { ![winfo exists $popup] } {
+        # Create a popup for the print dialog
+        Rappture::Balloon $popup -title "Change values..."
+        set inner [$popup component inner]
+        foreach w [winfo children $inner] {
+            destroy $w
+        }
+    }
+    BuildControls $popup $controls
+    foreach path $controls {
+        Insert $inner $path
+    }
+    button 
+    update
+    # Activate the popup and call for the output.
+    incr x [winfo rootx $itk_component(drawing)]
+    incr y [winfo rooty $itk_component(drawing)]
+    $popup activate @$x,$y left
+    set inner [$popup component inner]
+    $inner.print print $itk_component(plot) \
+                    $toolName $plotName]
+    $popup deactivate 
+    return $output
+
+    $popup configure \
+        -deactivatecommand [list $inner.print reset] 
+    blt::table $inner 0,0 $inner.print -fill both
+
+    tkwait variable _done
+
+            
+        # Create the print dialog widget and add it to the
+        # the balloon popup.
+        
+    }
+}
+
+itcl::body Rappture::DrawingEntry::Insert { inner path } {
+    set pos [llength $_controls]
+    incr _counter
+    set name "control$_counter"
+    set path [$_owner xml element -as path $path]
+
+    set _name2info($name-path) $path
+    set _name2info($name-label) ""
+    set _name2info($name-type) ""
+    set w $inner.v$name
+    set _name2info($name-value) $w
+    set _name2info($name-enable) "yes"
+    set _name2info($name-disablestyle) "greyout"
+
+    set type [$_owner xml element -as type $path]
+    set _name2info($name-type) $type
+    switch -- $type {
+        choice {
+            Rappture::ChoiceEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        filechoice {
+            Rappture::FileChoiceEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        filelist {
+            Rappture::FileListEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        group {
+            Rappture::GroupEntry $w $_owner $path
+        }
+        loader {
+            Rappture::Loader $w $_owner $path -tool [$_owner tool]
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        number {
+            Rappture::NumberEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        integer {
+            Rappture::IntegerEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        boolean {
+            Rappture::BooleanEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        string {
+            Rappture::TextEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        image {
+            Rappture::ImageEntry $w $_owner $path
+        }
+        separator {
+            # no widget to create
+            set _name2info($name-value) "--"
+        }
+        note {
+            Rappture::Note $w $_owner $path
+        }
+        periodicelement {
+            Rappture::PeriodicElementEntry $w $_owner $path
+            bind $w <<Value>> [itcl::code $this _controlChanged $name]
+        }
+        default {
+            error "don't know how to add control type \"$type\""
+        }
+    }
+
+    # 
+    # If this element has an <enable> expression, then register its
+    # controlling widget here.  
+    #
+    set notify [string trim [$_owner xml get $path.about.notify]]
+
+    set disablestyle [string trim [$_owner xml get $path.about.disablestyle]]
+    if { $disablestyle != "" } {
+        set _name2info($name-disablestyle) $disablestyle
+    }
+    #
+    # If this element has an <enable> expression, then register
+    # its controlling widget here.
+    #
+    set enable [string trim [$_owner xml get $path.about.enable]]
+    if {"" == $enable} {
+        set enable yes
+    }
+    if {![string is boolean $enable]} {
+        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/]+)?}
+        set rest $enable
+        set enable ""
+        set deps ""
+        while {1} {
+            if {[regexp -indices $re $rest match]} {
+                foreach {s0 s1} $match break
+
+                if {[string index $rest [expr {$s0-1}]] == "\""
+                      && [string index $rest [expr {$s1+1}]] == "\""} {
+                    # string in ""'s? then leave it alone
+                    append enable [string range $rest 0 $s1]
+                    set rest [string range $rest [expr {$s1+1}] end]
+                } else {
+                    #
+                    # This is a symbol which should be substituted
+                    # it can be either:
+                    #   input.foo.bar
+                    #   input.foo.bar:units
+                    #
+                    set cpath [string range $rest $s0 $s1]
+                    set parts [split $cpath :]
+                    set ccpath [lindex $parts 0]
+                    set units [lindex $parts 1]
+
+                    # make sure we have the standard path notation
+                    set stdpath [$_owner regularize $ccpath]
+                    if {"" == $stdpath} {
+                        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."
+                        set stdpath $ccpath
+                    }
+                    # substitute [_controlValue ...] call in place of path
+                    append enable [string range $rest 0 [expr {$s0-1}]]
+                    append enable [format {[_controlValue %s %s]} $stdpath $units]
+                    lappend deps $stdpath
+                    set rest [string range $rest [expr {$s1+1}] end]
+                }
+            } else {
+                append enable $rest
+                break
+            }
+        }
+
+        foreach cpath $deps {
+            $_owner dependenciesfor $cpath $path
+        }
+    }
+    set _name2info($name-enable) $enable
+
+    $_owner widgetfor $path $w
+
+    if {[lsearch {control group separator note} $type] < 0} {
+        # make a label for this control
+        set label [$w label]
+        if {"" != $label} {
+            set _name2info($name-label) $_frame.l$name
+            set font [option get $itk_component(hull) labelFont Font]
+            label $_name2info($name-label) -text [_formatLabel $label] \
+                -font $font
+        }
+
+        # register the tooltip for this control
+        set tip [$w tooltip]
+        if {"" != $tip} {
+            Rappture::Tooltip::for $w $tip
+
+            # add the tooltip to the label too, if there is one
+            if {$_name2info($name-label) != ""} {
+                Rappture::Tooltip::for $_name2info($name-label) $tip
+            }
+        }
+    }
+
+    # insert the new control onto the known list
+    set _controls [linsert $_controls $pos $name]
+    _monitor $name on
+
+    # now that we have a new control, we should fix the layout
+    after idle [itcl::code $this LayoutControls]
+    ControlChanged $name
+    return $name
+}
+
+# ----------------------------------------------------------------------
+# USAGE: ControlChanged <name>
+#
+# Invoked automatically whenever the value for a control changes.
+# Sends a notification along to the tool controlling this panel.
+# ----------------------------------------------------------------------
+itcl::body Rappture::DrawingEntry::ControlChanged {name} {
+    set path $_name2info($name-path)
+    #
+    # Let the owner know that this control changed.
+    #
+    if {"" != $_owner} {
+        $_owner changed $path
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: LayoutControls
+#
+# Used internally to fix the layout of controls whenever controls
+# are added or deleted, or when the control arrangement changes.
+# There are a lot of heuristics here trying to achieve a "good"
+# arrangement of controls.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Controls::LayoutControls {} {
+    #
+    # Clear any existing layout
+    #
+    foreach name $_controls {
+        foreach elem {label value} {
+            set w $_name2info($name-$elem)
+            if {$w != "" && [winfo exists $w]} {
+                grid forget $w
+            }
+        }
+    }
+    grid forget $_frame.empty
+
+    #
+    # Decide which widgets should be shown and which should be hidden.
+    #
+    set hidden ""
+    set showing ""
+    foreach name $_controls {
+        set show 1
+        set cond $_name2info($name-enable)
+        if {[string is boolean $cond] && !$cond} {
+            # hard-coded "off" -- ignore completely
+        } elseif {[catch {expr $cond} show] == 0} {
+            set type $_name2info($name-type)
+            set disablestyle $_name2info($name-disablestyle)
+            set lwidget $_name2info($name-label)
+            set vwidget $_name2info($name-value)
+            if {[lsearch -exact {group image structure} $type] >= 0 || 
+                $disablestyle == "hide" } {
+                if {$show ne "" && $show} {
+                    lappend showing $name
+                } else {
+                    lappend hidden $name
+                }
+            } else {
+                # show other objects, but enable/disable them
+                lappend showing $name
+                if {$show ne "" && $show} {
+                    if {[winfo exists $vwidget]} {
+                        $vwidget configure -state normal
+                    }
+                    if {[winfo exists $lwidget]} {
+                        $lwidget configure -foreground \
+                            [lindex [$lwidget configure -foreground] 3]
+                    }
+                } else {
+                    if {[winfo exists $vwidget]} {
+                        $vwidget configure -state disabled
+                    }
+                    if {[winfo exists $lwidget]} {
+                        $lwidget configure -foreground gray
+                    }
+                }
+            }
+        } else {
+            bgerror "Error in <enable> expression for \"$_name2info($name-path)\":\n  $show"
+        }
+    }
+
+    # store the showing tabs in the object so it can be used in _changeTabs
+    set _showing $showing
+
+    #
+    # SCHEME: hlabels
+    # simple "Label: Value" layout
+    #
+    #pack forget $_tabs
+    grid propagate $_frame on
+    grid columnconfigure $_frame 0 -weight 0
+    grid rowconfigure $_frame 0 -weight 0
+    
+    set expand 0  ;# most controls float to top
+    set row 0
+    foreach name $showing {
+        set wl $_name2info($name-label)
+        if {$wl != "" && [winfo exists $wl]} {
+            grid $wl -row $row -column 0 -sticky e
+        }
+        
+        set wv $_name2info($name-value)
+        if {$wv != "" && [winfo exists $wv]} {
+            if {$wl != ""} {
+                grid $wv -row $row -column 1 -sticky ew
+            } else {
+                grid $wv -row $row -column 0 -columnspan 2 -sticky ew
+            }
+            
+            grid rowconfigure $_frame $row -weight 0
+            
+            switch -- [winfo class $wv] {
+                TextEntry {
+                    if {[regexp {[0-9]+x[0-9]+} [$wv size]]} {
+                        grid $wl -sticky n -pady 4
+                        grid $wv -sticky nsew
+                        grid rowconfigure $_frame $row -weight 1
+                        grid columnconfigure $_frame 1 -weight 1
+                        set expand 1
+                    }
+                }
+                GroupEntry {
+                    $wv configure -heading yes
+                    
+                    #
+                    # Scan through all children in this group
+                    # and see if any demand more space.  If the
+                    # group contains a structure or a note, then
+                    # make sure that the group itself is set to
+                    # expand/fill.
+                    #
+                    set queue [winfo children $wv]
+                    set expandgroup 0
+                    while {[llength $queue] > 0} {
+                        set w [lindex $queue 0]
+                        set queue [lrange $queue 1 end]
+                        set c [winfo class $w]
+                        if {[lsearch {DeviceEditor Note} $c] >= 0} {
+                            set expandgroup 1
+                            break
+                        }
+                        eval lappend queue [winfo children $w]
+                    }
+                    if {$expandgroup} {
+                        set expand 1
+                        grid $wv -sticky nsew
+                        grid rowconfigure $_frame $row -weight 1
+                    }
+                }
+                Note {
+                    grid $wv -sticky nsew
+                    grid rowconfigure $_frame $row -weight 1
+                    set expand 1
+                }
+            }
+            grid columnconfigure $_frame 1 -weight 1
+        } elseif {$wv == "--"} {
+            grid rowconfigure $_frame $row -minsize 10
+        }
+        
+        incr row
+        grid rowconfigure $_frame $row -minsize $itk_option(-padding)
+        incr row
+    }
+    grid $_frame.empty -row $row
+    
+    #
+    # If there are any hidden items, then make the bottom of
+    # this form fill up any extra space, so the form floats
+    # to the top.  Otherwise, it will jitter around as the
+    # hidden items come and go.
+    #
+    if {[llength $hidden] > 0 && !$expand} {
+        grid rowconfigure $_frame 99 -weight 1
+    } else {
+        grid rowconfigure $_frame 99 -weight 0
+    }
+}