Changeset 3636

Timestamp:

Apr 25, 2013, 7:04:34 PM (11 years ago)

Author:

mmc

Message:

Fixed the drawing widget to handle notifications from outside widgets, so
that canvas items react to value changes. Also added tooltips for drawing
items.

Nudged the next/back buttons for the pager in a bit, so they're a little
easier to press in the iPad app.

Fixed the Ruby template for the builder to include the overwrite/append flag.

Location:

trunk

Files:

• builder/scripts/templates/ruby.tl (modified) (1 diff)
• examples/zoo/drawing/tool.xml (modified) (2 diffs)
• gui/scripts/Makefile.in (modified) (1 diff)
• gui/scripts/contourresult.tcl (modified) (1 diff)
• gui/scripts/controlOwner.tcl (modified) (4 diffs)
• gui/scripts/controls.tcl (modified) (6 diffs)
• gui/scripts/drawing-obsolete.tcl (deleted)
• gui/scripts/drawingcontrols.tcl (deleted)
• gui/scripts/drawingentry.tcl (modified) (36 diffs)
• gui/scripts/page.tcl (modified) (2 diffs)
• gui/scripts/pager.tcl (modified) (1 diff)
• gui/scripts/textentry.tcl (modified) (1 diff)
• gui/src/RpCanvHotspot.c (modified) (4 diffs)

trunk/builder/scripts/templates/ruby.tl

@@ -86 +86 @@
     code "\n# save output value for $path"
     code "# data should be base64-encoded image data"
-    code "io.put(\"$path.current\", imdata)"
+    code "io.put(\"$path.current\", imdata, Rappture::OVERWRITE)"
   }
   output * {
     code "\n# save output value for $path"
-    code "io.put(\"$path.current\",$id)"
+    code "io.put(\"$path.current\",$id, Rappture::OVERWRITE)"
   }
 }

trunk/examples/zoo/drawing/tool.xml

@@ -93 +93 @@
      <anchor>nw</anchor>
     </text>
-    <hotspot id="feature_height">
-     <coords>.95 .53</coords>
-     <controls>input.choice(analysis)</controls>
-     <controls>input.number(feature_height)</controls>
-     <controls>input.number(feature_length)</controls>
-     <controls>input.number(substrate_length)</controls>
-    </hotspot>
     <line id="substrate_length">
      <coords>0 .8 1 .8</coords>
@@ -133 +126 @@
      <linewidth>2</linewidth>
     </line>
+    <rectangle id="border">
+     <coords>-0.05 0.05 0.3 0.35</coords>
+     <outline>black</outline>
+     <linewidth>5</linewidth>
+    </rectangle>
     <picture id="analysis">
-     <coords>-.08 .06 0.17 0.15</coords>
-     <contents>file:images/${analysis}_F-d.png</contents>
-     <anchor>nw</anchor>
+     <coords>-0.05 0.05 0.3 0.35</coords>
+     <contents>file://images/${analysis}_F-d.png</contents>
     </picture>
     <text id="analysis">
-     <coords>.05 .4</coords>
+     <coords>.125 .36</coords>
      <color>black</color>
      <text>${analysis}</text>
      <font>Arial 11</font>
      <anchor>n</anchor>
-     <hotspot>inline</hotspot>
     </text>
     <text id="string">

trunk/gui/scripts/Makefile.in

@@ -44 +44 @@
                 $(srcdir)/dispatcher.tcl \
                 $(srcdir)/drawing.tcl \
-                $(srcdir)/drawingcontrols.tcl \
                 $(srcdir)/drawingentry.tcl \
                 $(srcdir)/dropdown.tcl \

trunk/gui/scripts/contourresult.tcl

@@ -591 +591 @@
                         return
                     }
-puts stderr "ContourResult: dataobj=$dataobj mesh=$mesh "
                     switch -- [$mesh GetClassName] {
                       vtkPoints {

trunk/gui/scripts/controlOwner.tcl

@@ -40 +40 @@
     protected variable _xmlobj ""    ;# Rappture XML description
     private variable _path2widget    ;# maps path => widget on this page
+    private variable _path2controls  ;# maps path => panel containing widget
     private variable _owner2paths    ;# for notify: maps owner => interests
     private variable _type2curpath   ;# maps type(path) => path's current value
@@ -96 +97 @@
 # ControlOwner knows what widgets to look at when syncing itself
 # to the underlying XML data.
+#
+# There can only be one widget per path, since the control owner will
+# later query the widgets for current values.  If there is already an
+# existing widget registered for the <path>, then it will be deleted
+# and the new <widget> will take its place.  If the caller doesn't
+# want to replace an existing widget, it should check before calling
+# this method and make sure that the return value is "".
 # ----------------------------------------------------------------------
 itcl::body Rappture::ControlOwner::widgetfor {path args} {
@@ -101 +109 @@
     if {[llength $args] == 0} {
         set owner [ownerfor $path]
-        if {$owner != $this && $owner != ""} {
+        if {$owner ne $this && $owner ne ""} {
             return [$owner widgetfor $path]
         }
@@ -112 +120 @@
     # otherwise, associate the path with the given widget
     set widget [lindex $args 0]
-    if {"" != $widget} {
+    if {$widget ne ""} {
+        # is there already a widget registered for this path?
         if {[info exists _path2widget($path)]} {
-            error "$path already associated with widget $_path2widget($path)"
-        }
+            # delete old widget and replace
+            set panel $_path2controls($path)
+            $panel delete $path
+            set _path2controls($path) ""
+        }
+
+        # register the new widget for the path
         set _path2widget($path) $widget
+
+        # look up the containing panel and store it too
+        set w [winfo parent $widget]
+        while {$w ne ""} {
+            if {[string match *Controls [winfo class $w]]} {
+                set _path2controls($path) $w
+                break
+            }
+            set w [winfo parent $w]
+        }
     } else {
+        # empty name => forget about this widget
         catch {unset _path2widget($path)}
+        catch {unset _path2controls($path)}
     }
 }

trunk/gui/scripts/controls.tcl

@@ -115 +115 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Controls::insert {pos path} {
-    if {"end" == $pos} {
-        set pos [llength $_controls]
-    } elseif {![string is integer $pos]} {
-        error "bad index \"$pos\": should be integer or \"end\""
+    if {$pos ne "end" && ![string is integer $pos]} {
+        set pos [index $pos]
     }
 
@@ -267 +265 @@
     }
     set _name2info($name-enable) $enable
-
-    set hidden [string trim [$_owner xml get $_name2info($name-path).hide]]
-    if { $hidden != "" } {
-        set _name2info($name-enable) [expr !$hidden]
-    }
     $_owner widgetfor $path $w
 
-    if {[lsearch {control group separator note} $type] < 0} {
+    if {[lsearch {control group drawing separator note} $type] < 0} {
         # make a label for this control
         set label [$w label]
-        if {"" != $label} {
+        if {$label ne ""} {
             set _name2info($name-label) $_frame.l$name
             set font [option get $itk_component(hull) labelFont Font]
@@ -286 +279 @@
         # register the tooltip for this control
         set tip [$w tooltip]
-        if {"" != $tip} {
+        if {$tip ne ""} {
             Rappture::Tooltip::for $w $tip -log $path
 
             # add the tooltip to the label too, if there is one
-            if {$_name2info($name-label) != ""} {
+            if {$_name2info($name-label) ne ""} {
                 Rappture::Tooltip::for $_name2info($name-label) $tip -log $path
             }
@@ -321 +314 @@
         set last $first
     }
-    if {![regexp {^[0-9]+|end$} $first]} {
-        error "bad index \"$first\": should be integer or \"end\""
-    }
-    if {![regexp {^[0-9]+|end$} $last]} {
-        error "bad index \"$last\": should be integer or \"end\""
+    if {![string is integer $first]} {
+        set first [index $first]
+    }
+    if {![string is integer $last]} {
+        set last [index $last]
     }
 
@@ -346 +339 @@
 
 # ----------------------------------------------------------------------
-# USAGE: index <name>|@n
+# USAGE: index <name>|<path>|@n|end
 #
 # Clients use this to convert a control <name> into its corresponding
 # integer index.  Returns an error if the <name> is not recognized.
 # ----------------------------------------------------------------------
-itcl::body Rappture::Controls::index {name} {
-    set i [lsearch $_controls $name]
+itcl::body Rappture::Controls::index {val} {
+    set i [lsearch $_controls $val]
     if {$i >= 0} {
         return $i
     }
-    if {[regexp {^@([0-9]+)$} $name match i]} {
+    if {[regexp {^@([0-9]+)$} $val match i]} {
         return $i
     }
-    if {$name == "end"} {
+    if {$val eq "end"} {
         return [expr {[llength $_controls]-1}]
     }
-    error "bad control name \"$name\": should be @int or one of [join [lsort $_controls] {, }]"
+
+    # treat as a path name and search for this path
+    foreach name $_controls {
+        if {$_name2info($name-path) eq $val} {
+            set i [lsearch $_controls $name]
+            if {$i >= 0} {
+                return $i
+            }
+        }
+    }
+
+    error "bad control name \"$name\": should be @int or \"end\" or path name or one of [join [lsort $_controls] {, }]"
 }
 
@@ -439 +443 @@
         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} {
+        if {[catch {expr $cond} show] == 0} {
             set type $_name2info($name-type)
             set disablestyle $_name2info($name-disablestyle)

trunk/gui/scripts/drawingentry.tcl

@@ -20 +20 @@
     itk_option define -state state State "normal"
 
+    private variable _dispatcher ""
+    private variable _path
+    private variable _owner
+    private variable _monitoring ""
+    private variable _xmlobj ""
+
+    # slave interpreter where all substituted variables are stored
+    private variable _parser ""
+
+    # unique counter for popup names
+    private common _popupnum 0
+
     private variable _canvasHeight 0
     private variable _canvasWidth 0
-    private variable _cname2controls
+    private variable _cpath2popup
+    private variable _takedown ""
     private variable _cname2id
     private variable _cname2image
     private variable _name2path
+    private variable _name2map
     private variable _drawingHeight 0
     private variable _drawingWidth 0
-    private variable _owner
-    private variable _xmlobj ""
-    private variable _parser "";        # Slave interpreter where all 
-                                        # substituted variables are stored.
-    private variable _path
     private variable _showing ""
     private variable _xAspect 0
@@ -56 +65 @@
     private method Activate { tag } 
     private method AdjustDrawingArea { xAspect yAspect } 
-    private method ControlValue {path {units ""}}
     private method Deactivate { tag } 
     private method Highlight { tag } 
-    private method InitSubstitutions {} 
     private method Invoke { name x y } 
     private method ParseBackground {}
@@ -71 +78 @@
     private method ParseRectangle { cpath cname }
     private method ParseScreenCoordinates { values }
-    private method ParseSubstitutions {}
     private method ParseText { cpath cname }
     private method Redraw {}
@@ -77 +83 @@
     private method ScreenX { x } 
     private method ScreenY { y } 
+    private method UpdateSubstitutions {}
     private method XmlGet { path } 
     private method XmlGetSubst { path } 
-    private method Withdraw { cname } 
     private method Hotspot { option cname item args } 
-    private method IsEnabled { path } 
-    private method NumControlsEnabled { cname } 
 }
 
@@ -102 +106 @@
     set _owner $owner
     set _xmlobj [$_owner xml object]
+
+    Rappture::dispatcher _dispatcher
+    $_dispatcher register !redraw
+    $_dispatcher dispatch $this !redraw "[itcl::code $this Redraw]; list"
+
     #
     # Display the current drawing.
@@ -112 +121 @@
     }
     pack $itk_component(drawing) -expand yes -fill both
-    bind $itk_component(drawing) <Configure> [itcl::code $this Redraw]
+    bind $itk_component(drawing) <Configure> \
+        [itcl::code $_dispatcher event -idle !redraw]
+
+    # scan through all variables and attach notifications for changes
+    foreach cpath [$_xmlobj children -as path -type variable $_path.substitutions] {
+        set map ""
+        set name ""
+        set path ""
+        foreach elem [$_xmlobj children $cpath] {
+            switch -glob -- $elem {
+                "name*" {
+                    set name [XmlGet $cpath.$elem]
+                }
+                "path*" {
+                    set path [XmlGet $cpath.$elem]
+                }
+                "map*" {
+                    set from [XmlGet $cpath.$elem.from]
+                    set to [XmlGet $cpath.$elem.to]
+                    if {$from eq "" || $to eq ""} {
+                        puts stderr "empty translation in map table \"$cpath\""
+                    }
+                    lappend map $from $to
+                }
+            }
+        }
+        if {$name eq ""} {
+            puts stderr "no name defined for substituion variable \"$cpath\""
+            continue
+        }
+        if {[info exists _name2path($name)]} {
+            puts stderr "substitution variable \"$name\" already defined"
+            continue
+        }
+        set _name2path($name) $path
+        if {$path eq ""} {
+            puts stderr "no path defined for substituion variable \"$cpath\""
+            continue
+        }
+        set _name2map($name) $map
+
+        # keep track of controls built for each variable (see below)
+        set controls($path) unused
+
+        # whenever variable changes, update drawing to report new values
+        if {[lsearch $_monitoring $path] < 0} {
+            $_owner notify add $this $path \
+                [itcl::code $_dispatcher event -idle !redraw]
+            lappend _monitoring $path
+        }
+    }
+
+    # find all embedded controls and build a popup for each hotspot
+    foreach cpath [$_xmlobj children -type hotspot -as path $_path.components] {
+        set listOfControls [$_xmlobj children -type controls $cpath]
+        if {[llength $listOfControls] > 0} {
+            set popup .drawingentrypopup[incr _popupnum]
+            Rappture::Balloon $popup -title "Change values..."
+            set inner [$popup component inner]
+            Rappture::Controls $inner.controls $_owner
+            pack $inner.controls -fill both -expand yes
+            set _cpath2popup($cpath) $popup
+
+            # Add control widgets to this popup.
+            # NOTE: if the widget exists elsewhere, it is deleted at this
+            #   point and "sucked in" to the popup.
+            foreach cname $listOfControls {
+                set cntlpath [XmlGetSubst $cpath.$cname]
+                $inner.controls insert end $cntlpath
+            }
+        }
+    }
+
+    set c $itk_component(drawing)
+    foreach cpath [$_xmlobj children -type text -as path $_path.components] {
+        set popup ""
+        set mode [XmlGetSubst $cpath.hotspot]
+        if {$mode eq "off"} {
+            # no popup if hotspot is turned off
+            continue
+        }
+
+        # easiest way to parse embedded variables is to create a hotspot item
+        set id [$c create hotspot 0 0 -text [XmlGet $cpath.text]]
+        foreach varName [Rappture::hotspot variables $c $id] {
+            if {[info exists _name2path($varName)]} {
+                set cntlpath $_name2path($varName)
+
+                if {$controls($cntlpath) ne "unused"} {
+                    puts stderr "WARNING: drawing variable \"$varName\" is used in two hotspots, but will appear in only one of them."
+                    continue
+                }
+                set controls($cntlpath) "--"
+
+                if {$popup eq ""} {
+                    # create the popup for this item, if we haven't already
+                    set popup .drawingentrypopup[incr _popupnum]
+                    Rappture::Balloon $popup -title "Change values..."
+                    set inner [$popup component inner]
+                    Rappture::Controls $inner.controls $_owner
+                    pack $inner.controls -fill both -expand yes
+                }
+
+                # Add the control widget for this variable to this popup.
+                # NOTE: if the widget exists elsewhere, it is deleted at this
+                #   point and "sucked in" to the popup.
+                set inner [$popup component inner]
+                $inner.controls insert end $cntlpath
+                set _cpath2popup($cntlpath) $popup
+            } else {
+                puts stderr "unknown variable \"$varName\" in drawing item at $cpath"
+            }
+        }
+        $c delete $id
+    }
+
+    # create a parser to manage substitions of variable values
     set _parser [interp create -safe]
-    Redraw
+
     eval itk_initialize $args
+
+    # initialize the drawing at some point
+    $_dispatcher event -idle !redraw
 }
 
 itcl::body Rappture::DrawingEntry::destructor {} {
-    if { $_parser != "" } {
+    # stop monitoring controls for value changes
+    foreach cpath $_monitoring {
+        $_owner notify remove $this $cpath
+    }
+
+    # tear down the value subsitution parser
+    if {$_parser != ""} {
         $_parser delete 
     }
@@ -130 +264 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::DrawingEntry::label {} {
-return ""
-    set label [$_xmlobj get $_path.about.label]
-    if {"" == $label} {
+    set label [$_owner xml get $_path.about.label]
+    if {$label eq ""} {
         set label "Drawing"
     }
@@ -147 +280 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::DrawingEntry::tooltip {} {
-return ""
     set str [$_xmlobj get $_path.about.description]
     return [string trim $str]
@@ -163 +295 @@
 
 itcl::body Rappture::DrawingEntry::Redraw {} {
+    # If a popup is pending, redraw signals a value change; take it down
+    if {$_takedown ne ""} {
+        $_takedown deactivate
+        set _takedown ""
+    }
+
     # 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)
     }
-    array unset _name2path
     array unset _cname2id
-    array unset _cnames2controls
     array unset _cname2image
     
@@ -194 +331 @@
 #
 itcl::body Rappture::DrawingEntry::ParseDescription {} {
-    #puts stderr "ParseDescription owner=$_owner path=$_path"
     ParseBackground
-    ParseSubstitutions
+    UpdateSubstitutions
     foreach cname [$_xmlobj children $_path.components] {
         switch -glob -- $cname {
@@ -231 +367 @@
 #
 itcl::body Rappture::DrawingEntry::ParseGrid { cpath cname } {
-    #puts stderr "ParseGrid owner=$_owner cpath=$cpath"
     array set attr2option {
         "linewidth"     "-width"
@@ -247 +382 @@
     # Coords
     set xcoords [XmlGetSubst $cpath.xcoords]
-    set xcoords [string trim $xcoords]
     set ycoords [XmlGetSubst $cpath.ycoords]
-    set ycoords [string trim $ycoords]
     if { $ycoords == "" } {
         set ycoords "0 1"
@@ -290 +423 @@
         set xcoords $list
     }
-    #puts stderr "ParseGrid owner=$_owner cpath=$cpath xcoords=$xcoords ycoords=$ycoords"
+
     set list {}
     foreach attr [$_xmlobj children $cpath] {
@@ -321 +454 @@
         "anchor" "-anchor"
     }
-    #puts stderr "ParseHotspot owner=$_owner cpath=$cpath"
+
     # Set default options first and then let tool.xml override them.
     array set options {
@@ -327 +460 @@
         -anchor c
     }
-    array unset _cname2controls $cname
     foreach attr [$_xmlobj children $cpath] {
         if { [info exists attr2option($attr)] } {
@@ -333 +465 @@
             set value [XmlGetSubst $cpath.$attr]
             set options($option) $value
-        } elseif { [string match "controls*" $attr] } {
-            set value [XmlGetSubst $cpath.$attr]
-            lappend _cname2controls($cname) $value
-            $_xmlobj put $value.hide 1
         }
     }
     # Coordinates
     set coords [XmlGetSubst $cpath.coords]
-    set coords [ScreenCoords $coords]
-    if { $coords == "" } {
+    if {$coords eq ""} {
         set coords "0 0 1 1"
-    } 
+    }
     set c $itk_component(drawing)
-    set img [Rappture::icon hotspot_normal]
-    foreach { x1 y1 } $coords break
+    foreach {x1 y1} [ScreenCoords $coords] break
     set id [$itk_component(drawing) create image $x1 $y1]
     array unset options -fill
     set options(-tags) $cname
-    set options(-image) $img
+    set options(-image) [Rappture::icon hotspot_normal]
     eval $c itemconfigure $id [array get options]
     set _cname2id($cname) $id
     $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]
     set bbox [$c bbox $id]
     set y1 [lindex $bbox 1]
-    $c bind $id <ButtonPress-1> [itcl::code $this Invoke $cname $x1 $y1]
+    $c bind $id <ButtonPress-1> [itcl::code $this Invoke $cpath $x1 $y1]
 }
 
@@ -380 +505 @@
     }
     # Coords
-    set coords {}
     set coords [XmlGetSubst $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
+    if {$coords eq ""} {
         set coords "0 0"
-    } else {
-        set coords [ScreenCoords $coords]
-    }
-    #puts stderr "ParseLine owner=$_owner cpath=$cpath coords=$coords"
+    }
+    set coords [ScreenCoords $coords]
+
     set list {}
     foreach attr [$_xmlobj children $cpath] {
@@ -412 +534 @@
         "linewidth"     "-width"
     }
-    #puts stderr "ParseOval owner=$_owner cpath=$cpath"
 
     # Set default options first and then let tool.xml override them.
@@ -428 +549 @@
     }
     # Coordinates
-    set coords {}
     set coords [XmlGetSubst $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
+    if {$coords eq ""} {
         set coords "0 0 1 1"
     }
@@ -447 +566 @@
         "anchor"        "-anchor"
     }
-    #puts stderr "ParsePicture owner=$_owner cpath=$cpath"
+
     # Set default options first and then let tool.xml override them.
     array set options {
@@ -462 +581 @@
     set img ""
     if { [string compare -length 7 $contents "file://"] == 0 } {
-        set fileName [string range $contents 5 end]
+        set fileName [string range $contents 7 end]
         if { [file exists $fileName] } {
             set img [image create photo -file $fileName]
-        }
+        } else {
+            puts stderr "WARNING: can't find picture contents \"$fileName\""
+        }
     } elseif { [string compare -length 7 $contents "http://"] == 0 } {
         puts stderr  "don't know how to handle http"
@@ -472 +593 @@
         set img [image create photo -data $contents]
     }
-    if { $img == "" } {
+    if {$img eq ""} {
         return
     }
     # Coordinates
     set coords [XmlGetSubst $cpath.coords]
-    set coords [ScreenCoords $coords]
     if { [llength $coords] == 2 } {
-        foreach { x1 y1 } $coords break
+        foreach { x1 y1 } [ScreenCoords $coords] break
         set w [XmlGetSubst $cpath.width]
         if { $w == "" || ![string is number $w] || $w <= 0.0 } {
@@ -494 +614 @@
         if { $width != [image width $img] || $height != [image height $img] } {
             set dst [image create photo -width $width -height $height]
-            blt::winop resample $img $dest
+            blt::winop resample $img $dst
             image delete $img
             set img $dst
         }
     } elseif { [llength $coords] == 4 } {
-        foreach { x1 y1 x2 y2 } $coords break
+        foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
         if { $x1 > $x2 } {
             set tmp $x1 
@@ -510 +630 @@
             set x2 $tmp
         }
-        set width [expr $x2 - $x1 + 1]
-        set height [expr $x2 - $x1 + 1]
+        set width [expr {$x2 - $x1 + 1}]
+        set height [expr {$y2 - $y1 + 1}]
         if { $width != [image width $img] || $height != [image height $img] } {
             set dst [image create photo -width $width -height $height]
@@ -548 +668 @@
         -outline        black
     }
+
     # Coords
     set coords [XmlGetSubst $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
+    if {$coords eq ""} {
         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 coords [ScreenCoords $coords]
+
     set list {}
     foreach attr [$_xmlobj children $cpath] {
@@ -583 +699 @@
         "linewidth"     "-width"
     }
-    #puts stderr "ParseRectangle owner=$_owner cpath=$cpath"
 
     # Set default options first and then let tool.xml override them.
@@ -600 +715 @@
     # Coordinates
     set coords [XmlGetSubst $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
+    if {$coords eq ""} {
         set coords "0 0 1 1"
     }
     foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break 
-   set id [$itk_component(drawing) create rectangle $x1 $y1 $x2 $y2]
+    set id [$itk_component(drawing) create rectangle $x1 $y1 $x2 $y2]
     set _cname2id($cname) $id
     eval $itk_component(drawing) itemconfigure $id [array get options]
@@ -621 +735 @@
         "anchor"        "-anchor"
     }
-    #puts stderr "ParseText owner=$_owner cpath=$cpath"
 
     # Set default options first and then let tool.xml override them.
     array set options {
-        -font {Arial 12}
-        -valuefont {Arial 12}
+        -font {Arial -14}
+        -valuefont {Arial -14}
         -valueforeground blue3
         -text {}
@@ -645 +758 @@
     # Coords
     set coords [XmlGetSubst $cpath.coords]
-    set coords [string trim $coords]
-    if { $coords == "" } {
-        set coords "0 0"
-    } else {
-        set coords [ScreenCoords $coords]
-    }
+    if {$coords eq ""} {
+        set coords "0 0"
+    }
+    foreach {x0 y0} [ScreenCoords $coords] break
+
     set hotspot [XmlGetSubst $cpath.hotspot]
-    if { $hotspot == "inline" } {
+    if {$hotspot eq ""} {
+        # assume inline by default
+        set hotspot "inline"
+    } elseif {[lsearch {inline off} $hotspot] < 0} {
+        puts stderr "WARNING: bad hotspot value \"$hotspot\": should be inline or off"
+    }
+
+    if {$hotspot eq "inline"} {
         set options(-showicons) 1 
     }
     set c $itk_component(drawing)
     set options(-tags) $cname
-    set img [Rappture::icon hotspot_normal]
-    set options(-image) $img
-    set img [Rappture::icon hotspot_active]
-    set options(-activeimage) $img
-    set id [eval $c create hotspot $coords]
+    set options(-image) [Rappture::icon hotspot_normal]
+    set options(-activeimage) [Rappture::icon hotspot_active]
+    set id [$c create hotspot $x0 $y0]
     set _cname2id($cname) $id
     set options(-interp) $_parser
     eval $c itemconfigure $id [array get options]
-    if { $hotspot == "inline" } {
-        array unset _cname2controls $cname
-        foreach varName [Rappture::hotspot variables $c $id] {
-            if { [info exists _name2path($varName)] } {
-                set path $_name2path($varName)
-                $_xmlobj put $path.hide 1
-                lappend _cname2controls($cname) $path
-            } else {
-                puts stderr "unknown varName=$varName"
-            }
-        }
+
+    if {$hotspot eq "inline"} {
+        $c bind $id <Enter> \
+            [itcl::code $this Hotspot activate $cname $id %x %y]
         $c bind $id <Motion> \
-            [itcl::code $this Hotspot watch $cname $id %x %y]
+            [itcl::code $this Hotspot activate $cname $id %x %y]
         $c bind $id <Leave> \
             [itcl::code $this Hotspot deactivate $cname $id]
-        $c bind $id <Enter> \
-            [itcl::code $this Hotspot activate $cname $id %x %y]
         $c bind $id <ButtonRelease-1> \
             [itcl::code $this Hotspot invoke $cname $id %x %y]
@@ -689 +797 @@
 
 itcl::body Rappture::DrawingEntry::Hotspot { option cname item args } {
-    if { [NumControlsEnabled $cname] == 0 } {
-        return
-    }
     set c $itk_component(drawing)
+
+    # see what variable (if any) that we're touching within the text
+    set varName ""
+    if {[llength $args] >= 2} {
+        foreach {x y} $args break
+        foreach {varName x0 y0 x1 y1} [Rappture::hotspot identify $c $item $x $y] break
+    }
+
     switch -- $option {
-        "activate" {
-            foreach { x y } $args break
-            set varName  [Rappture::hotspot identify $c $item $x $y]
-            $c itemconfigure $item -activevalue $varName
-        }
-        "deactivate" {
+        activate {
+            if {$varName ne ""} {
+                set active [$c itemcget $item -activevalue]
+                if {$varName ne $active} {
+                    $c itemconfigure $item -activevalue $varName
+                }
+                $itk_component(drawing) configure -cursor center_ptr 
+
+                # put up a tooltip for this item
+                set cpath $_name2path($varName)
+                set tip [XmlGet $cpath.about.description]
+                if {$tip ne ""} {
+                    set x [expr {[winfo rootx $c]+$x0+10}]
+                    set y [expr {[winfo rooty $c]+$y1}]
+                    set tag "$c-[string map {. ""} $cpath]"
+                    Rappture::Tooltip::text $tag $tip -log $cpath
+                    Rappture::Tooltip::tooltip pending $tag @$x,$y
+                }
+            } else {
+                $c itemconfigure $item -activevalue ""
+                $itk_component(drawing) configure -cursor ""
+                Rappture::Tooltip::tooltip cancel
+            }
+        }
+        deactivate {
             $c itemconfigure $item -activevalue ""
-        }
-        "watch" {
-            foreach { x y } $args break
-            set active [$c itemcget $item -activevalue]
-            set varName  [Rappture::hotspot identify $c $item $x $y]
-            if { $varName != $active  } {
-                $c itemconfigure $item -activevalue $varName
-            }
-        }
-        "invoke" {
-            foreach { x y } $args break
-            set active [$c itemcget $item -activevalue]
-            set varName  [Rappture::hotspot identify $c $item $x $y]
-            if { $varName != "" } {
-                set bbox [$c bbox $item]
-                Invoke $cname $x [lindex $bbox 1]
-            }
-        }
+            $itk_component(drawing) configure -cursor ""
+            Rappture::Tooltip::tooltip cancel
+        }
+        invoke {
+            if {$varName ne ""} {
+                set x [expr {($x0+$x1)/2}]
+                Invoke $_name2path($varName) $x $y0
+            }
+        }
+        default {
+            error "bad option \"$option\": should be activate, deactivate, invoke"
+        }
     }
 }
@@ -724 +850 @@
 
 itcl::body Rappture::DrawingEntry::ScreenX { x } {
-    set norm [expr ($x - $_xMin) * $_xScale]
-    set x [expr int($norm * $_drawingWidth) + $_xOffset]
+    set norm [expr {($x - $_xMin) * $_xScale}]
+    set x [expr {int($norm * $_drawingWidth) + $_xOffset}]
     return $x
 }
 
 itcl::body Rappture::DrawingEntry::ScreenY { y } {
-    set norm [expr ($y - $_yMin) * $_yScale]
-    set y [expr int($norm * $_drawingHeight) + $_yOffset]
+    set norm [expr {($y - $_yMin) * $_yScale}]
+    set y [expr {int($norm * $_drawingHeight) + $_yOffset}]
     return $y
 }
@@ -860 +986 @@
 }
 
-itcl::body Rappture::DrawingEntry::ParseSubstitutions {} {
-    foreach var [$_xmlobj children $_path.substitutions] {
-        if { ![string match "variable*" $var] } {
-            continue
-        }
-        set varPath $_path.substitutions.$var
-        set map ""
-        set name ""
-        set path ""
-        foreach elem [$_xmlobj children $varPath] {
-            switch -glob -- $elem {
-                "name*" {
-                    set name [XmlGet $varPath.$elem]
-                }
-                "path*" {
-                    set path [XmlGet $varPath.$elem]
-                }
-                "map*" {
-                    set from [XmlGet $varPath.$elem.from]
-                    set to [XmlGet $varPath.$elem.to]
-                    if { $from == "" || $to == "" } {
-                        puts stderr "empty translation in map table \"$varPath\""
-                    }
-                    lappend map $from $to
-                }
-            }
-        }
-        if { $name == "" } {
-            puts stderr \
-                "no name defined for substituion variable \"$varPath\""
-            continue
-        }
-        if { [info exists _name2path($name)] } {
-            puts stderr \
-                "substitution variable \"$name\" already defined"
-            continue
-        }               
-        set _name2path($name) $path
-        if { $path == "" } {
-            puts stderr \
-                "no path defined for substituion variable \"$varPath\""
-            continue
-        }
-        set _name2map($name) $map
-    }
-    InitSubstitutions
-}
-
 #
 # Invoke -- 
 #
-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 controls dialog
-        Rappture::Balloon $popup -title "Change values..." \
-            -deactivatecommand [itcl::code $this Withdraw $cname]
-        set inner [$popup component inner]
-        Rappture::DrawingControls $inner.controls $_owner \
-            -deactivatecommand [list $popup deactivate]
-        pack $inner.controls -fill both -expand yes
+itcl::body Rappture::DrawingEntry::Invoke {cpath x y} {
+    if {![info exists _cpath2popup($cpath)]} {
+        error "internal error: no controls for hotspot at $cpath"
+    }
+    set popup $_cpath2popup($cpath)
+
+    # if this popup has only one control, watch for it to change and
+    # take it down automatically
+    set inner [$popup component inner]
+    set n [expr {[$inner.controls index end]+1}]
+    if {$n == 1} {
+        set _takedown $popup
     } else {
-        set inner [$popup component inner]
-        $inner.controls delete all
-    }
-    set count 0
-    foreach path $controls {
-        if { [IsEnabled $path] } {
-            $inner.controls add $path
-            incr count
-        }
-    }
-    if { $count == 0 } {
-        return
-    }
-    update
+        set _takedown ""
+    }
+
     # Activate the popup and call for the output.
     incr x [winfo rootx $itk_component(drawing)]
@@ -961 +1024 @@
 #
 itcl::body Rappture::DrawingEntry::Deactivate { cname } {
-    $itk_component(drawing) configure -cursor left_ptr 
+    $itk_component(drawing) configure -cursor ""
     $itk_component(drawing) itemconfigure $_cname2id($cname) \
         -image [Rappture::icon hotspot_normal]
-}
-
-#
-# Withdraw -- 
-#
-itcl::body Rappture::DrawingEntry::Withdraw { cname } {
-    Redraw
 }
 
@@ -987 +1043 @@
         set libobj [lindex $args 0]
         if { $libobj != "" } { 
-            Redraw
+            $_dispatcher event -idle !redraw
         }
     }
@@ -993 +1049 @@
 }
 
-
-#
-# InitSubstitutions -- 
-#
-itcl::body Rappture::DrawingEntry::InitSubstitutions {} {
-    # Load a new parser with the variables representing the substitution
+itcl::body Rappture::DrawingEntry::UpdateSubstitutions {} {
+    # Load parser with the variables representing the substitution
     foreach name [array names _name2path] {
         set path $_name2path($name)
         set w [$_owner widgetfor $path]
-        if { $w != "" } {
+        if {$w ne ""} {
             set value [$w value]
         } else {
             set value ""
         }
+        if {$_name2map($name) ne ""} {
+            set value [string map $_name2map($name) $value]
+        }
         $_parser eval [list set $name $value]
     }
@@ -1018 +1073 @@
 itcl::body Rappture::DrawingEntry::XmlGetSubst { path } {
     set value [$_xmlobj get $path]
-    if { $_parser == "" } {
-        return $value
+    if {$_parser == ""} {
+        return [string trim $value]
     }
     return [string trim [$_parser eval [list subst -nocommands $value]]]
 }
-
-itcl::body Rappture::DrawingEntry::IsEnabled { path } {
-    set enable [string trim [$_xmlobj get $path.about.enable]]
-    if {"" == $enable} {
-        return 1
-    }
-    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
-            }
-        }
-    }
-    return [expr $enable]
-}
-
-# ----------------------------------------------------------------------
-# USAGE: ControlValue <path> ?<units>?
-#
-# Used internally to get the value of a control with the specified
-# <path>.  Returns the current value for the control.
-# ----------------------------------------------------------------------
-itcl::body Rappture::DrawingEntry::ControlValue {path {units ""}} {
-    if {"" != $_owner} {
-        set val [$_owner valuefor $path]
-         if {"" != $units} {
-            set val [Rappture::Units::convert $val -to $units -units off]
-        }
-        return $val
-    }
-    return ""
-}
-
-itcl::body Rappture::DrawingEntry::NumControlsEnabled { cname } {
-    set controls $_cname2controls($cname)
-    set count 0
-    foreach path $controls {
-        if { [IsEnabled $path] } {
-            incr count
-        }
-    }
-    return $count
-}

trunk/gui/scripts/page.tcl

@@ -197 +197 @@
 
             # if this is a group, then build that group
-            if {[$xmlobj element -as type $path.$cname] == "group"} {
-                if {[$xmlobj element -as id $path.$cname] == "ambient"
+            if {[$xmlobj element -as type $path.$cname] eq "group"} {
+                if {[$xmlobj element -as id $path.$cname] eq "ambient"
                        && $deveditor != ""} {
                     set w [$deveditor component top]
                 } else {
-                    if {[catch {$frame.cntls insert end $path.$cname} c]} {
+                    if {[$_owner widgetfor $path.$cname] ne ""} {
+                        # widget already created -- skip this
+                    } elseif {[catch {$frame.cntls insert end $path.$cname} c]} {
                         global errorInfo
                         error $c "$c\n$errorInfo\n    (while building control for $path.$cname)"
@@ -212 +214 @@
                 _buildGroup $w $xmlobj $path.$cname
             } else {
-                if {[catch {$frame.cntls insert end $path.$cname} c]} {
+                if {[$_owner widgetfor $path.$cname] ne ""} {
+                    # widget already created -- skip this
+                } elseif {[catch {$frame.cntls insert end $path.$cname} c]} {
                     global errorInfo
                     error $c "$c\n$errorInfo\n    (while building control for $path.$cname)"

trunk/gui/scripts/pager.tcl

@@ -490 +490 @@
         pages {
             pack forget $itk_component(inside)
-            pack $itk_component(controls) -side bottom -fill x -padx 8 -pady 8
+            pack $itk_component(controls) -side bottom -fill x -padx 32 -pady 8
             pack $itk_component(breadcrumbarea) -side top -fill x
             pack $itk_component(line) -side top -fill x

trunk/gui/scripts/textentry.tcl

@@ -492 +492 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::TextEntry::_edit {option args} {
-puts "_edit $option $args"
     if {$itk_option(-state) == "disabled"} {
         return  ;# disabled? then bail out here!

trunk/gui/src/RpCanvHotspot.c

@@ -1726 +1726 @@
 }
 
-static const char *
+static Tcl_Obj *
 Identify(Tcl_Interp *interp, HotspotItem *itemPtr, double x, double y)
 {
+    Tcl_Obj* resultPtr = NULL;
     ItemSegment *segPtr;
+    Tcl_Obj* objPtr;
 
     x -= itemPtr->x1;
@@ -1739 +1741 @@
         if ((x >= segPtr->x) && (x < (segPtr->x + segPtr->width)) && 
             (y >= segPtr->y) && (y < (segPtr->y + segPtr->height))) {
-            return segPtr->text;
-        }
-    }
-    return "";
+
+            /* build return list: {string x0 y0 x1 y1} */
+            resultPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
+
+            objPtr = Tcl_NewStringObj(segPtr->text, -1);
+            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+
+            objPtr = Tcl_NewIntObj(itemPtr->x1 + segPtr->x);
+            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+            objPtr = Tcl_NewIntObj(itemPtr->y1 + segPtr->y);
+            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+
+            objPtr = Tcl_NewIntObj(itemPtr->x1 + segPtr->x + segPtr->width);
+            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+            objPtr = Tcl_NewIntObj(itemPtr->y1 + segPtr->y + segPtr->height);
+            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
+
+            return resultPtr;
+        }
+    }
+    return NULL;
 }
 
@@ -1770 +1789 @@
     } else if ((c == 'i') && (strncmp(string, "identify", length) == 0)) {
         double x, y;
-        const char *token;
         Tcl_Obj *objPtr;
 
@@ -1778 +1796 @@
             return TCL_ERROR;
         }
-        token = Identify(interp, itemPtr, x, y);
-        objPtr = Tcl_NewStringObj(token, -1);
-        Tcl_SetObjResult(interp, objPtr);
+        objPtr = Identify(interp, itemPtr, x, y);
+        if (objPtr != NULL) {
+            Tcl_SetObjResult(interp, objPtr);
+        }
     } else if ((c == 'v') && (strncmp(string, "variables", length) == 0)) {
         Tcl_Obj *listObjPtr;