Changeset 3636


Ignore:
Timestamp:
Apr 25, 2013 7:04:34 PM (8 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:
2 deleted
11 edited

Legend:

Unmodified
Added
Removed
  • trunk/builder/scripts/templates/ruby.tl

    r3177 r3636  
    8686    code "\n# save output value for $path"
    8787    code "# data should be base64-encoded image data"
    88     code "io.put(\"$path.current\", imdata)"
     88    code "io.put(\"$path.current\", imdata, Rappture::OVERWRITE)"
    8989  }
    9090  output * {
    9191    code "\n# save output value for $path"
    92     code "io.put(\"$path.current\",$id)"
     92    code "io.put(\"$path.current\",$id, Rappture::OVERWRITE)"
    9393  }
    9494}
  • trunk/examples/zoo/drawing/tool.xml

    r3077 r3636  
    9393     <anchor>nw</anchor>
    9494    </text>
    95     <hotspot id="feature_height">
    96      <coords>.95 .53</coords>
    97      <controls>input.choice(analysis)</controls>
    98      <controls>input.number(feature_height)</controls>
    99      <controls>input.number(feature_length)</controls>
    100      <controls>input.number(substrate_length)</controls>
    101     </hotspot>
    10295    <line id="substrate_length">
    10396     <coords>0 .8 1 .8</coords>
     
    133126     <linewidth>2</linewidth>
    134127    </line>
     128    <rectangle id="border">
     129     <coords>-0.05 0.05 0.3 0.35</coords>
     130     <outline>black</outline>
     131     <linewidth>5</linewidth>
     132    </rectangle>
    135133    <picture id="analysis">
    136      <coords>-.08 .06 0.17 0.15</coords>
    137      <contents>file:images/${analysis}_F-d.png</contents>
    138      <anchor>nw</anchor>
     134     <coords>-0.05 0.05 0.3 0.35</coords>
     135     <contents>file://images/${analysis}_F-d.png</contents>
    139136    </picture>
    140137    <text id="analysis">
    141      <coords>.05 .4</coords>
     138     <coords>.125 .36</coords>
    142139     <color>black</color>
    143140     <text>${analysis}</text>
    144141     <font>Arial 11</font>
    145142     <anchor>n</anchor>
    146      <hotspot>inline</hotspot>
    147143    </text>
    148144    <text id="string">
  • trunk/gui/scripts/Makefile.in

    r3471 r3636  
    4444                $(srcdir)/dispatcher.tcl \
    4545                $(srcdir)/drawing.tcl \
    46                 $(srcdir)/drawingcontrols.tcl \
    4746                $(srcdir)/drawingentry.tcl \
    4847                $(srcdir)/dropdown.tcl \
  • trunk/gui/scripts/contourresult.tcl

    r3330 r3636  
    591591                        return
    592592                    }
    593 puts stderr "ContourResult: dataobj=$dataobj mesh=$mesh "
    594593                    switch -- [$mesh GetClassName] {
    595594                      vtkPoints {
  • trunk/gui/scripts/controlOwner.tcl

    r3330 r3636  
    4040    protected variable _xmlobj ""    ;# Rappture XML description
    4141    private variable _path2widget    ;# maps path => widget on this page
     42    private variable _path2controls  ;# maps path => panel containing widget
    4243    private variable _owner2paths    ;# for notify: maps owner => interests
    4344    private variable _type2curpath   ;# maps type(path) => path's current value
     
    9697# ControlOwner knows what widgets to look at when syncing itself
    9798# to the underlying XML data.
     99#
     100# There can only be one widget per path, since the control owner will
     101# later query the widgets for current values.  If there is already an
     102# existing widget registered for the <path>, then it will be deleted
     103# and the new <widget> will take its place.  If the caller doesn't
     104# want to replace an existing widget, it should check before calling
     105# this method and make sure that the return value is "".
    98106# ----------------------------------------------------------------------
    99107itcl::body Rappture::ControlOwner::widgetfor {path args} {
     
    101109    if {[llength $args] == 0} {
    102110        set owner [ownerfor $path]
    103         if {$owner != $this && $owner != ""} {
     111        if {$owner ne $this && $owner ne ""} {
    104112            return [$owner widgetfor $path]
    105113        }
     
    112120    # otherwise, associate the path with the given widget
    113121    set widget [lindex $args 0]
    114     if {"" != $widget} {
     122    if {$widget ne ""} {
     123        # is there already a widget registered for this path?
    115124        if {[info exists _path2widget($path)]} {
    116             error "$path already associated with widget $_path2widget($path)"
    117         }
     125            # delete old widget and replace
     126            set panel $_path2controls($path)
     127            $panel delete $path
     128            set _path2controls($path) ""
     129        }
     130
     131        # register the new widget for the path
    118132        set _path2widget($path) $widget
     133
     134        # look up the containing panel and store it too
     135        set w [winfo parent $widget]
     136        while {$w ne ""} {
     137            if {[string match *Controls [winfo class $w]]} {
     138                set _path2controls($path) $w
     139                break
     140            }
     141            set w [winfo parent $w]
     142        }
    119143    } else {
     144        # empty name => forget about this widget
    120145        catch {unset _path2widget($path)}
     146        catch {unset _path2controls($path)}
    121147    }
    122148}
  • trunk/gui/scripts/controls.tcl

    r3513 r3636  
    115115# ----------------------------------------------------------------------
    116116itcl::body Rappture::Controls::insert {pos path} {
    117     if {"end" == $pos} {
    118         set pos [llength $_controls]
    119     } elseif {![string is integer $pos]} {
    120         error "bad index \"$pos\": should be integer or \"end\""
     117    if {$pos ne "end" && ![string is integer $pos]} {
     118        set pos [index $pos]
    121119    }
    122120
     
    267265    }
    268266    set _name2info($name-enable) $enable
    269 
    270     set hidden [string trim [$_owner xml get $_name2info($name-path).hide]]
    271     if { $hidden != "" } {
    272         set _name2info($name-enable) [expr !$hidden]
    273     }
    274267    $_owner widgetfor $path $w
    275268
    276     if {[lsearch {control group separator note} $type] < 0} {
     269    if {[lsearch {control group drawing separator note} $type] < 0} {
    277270        # make a label for this control
    278271        set label [$w label]
    279         if {"" != $label} {
     272        if {$label ne ""} {
    280273            set _name2info($name-label) $_frame.l$name
    281274            set font [option get $itk_component(hull) labelFont Font]
     
    286279        # register the tooltip for this control
    287280        set tip [$w tooltip]
    288         if {"" != $tip} {
     281        if {$tip ne ""} {
    289282            Rappture::Tooltip::for $w $tip -log $path
    290283
    291284            # add the tooltip to the label too, if there is one
    292             if {$_name2info($name-label) != ""} {
     285            if {$_name2info($name-label) ne ""} {
    293286                Rappture::Tooltip::for $_name2info($name-label) $tip -log $path
    294287            }
     
    321314        set last $first
    322315    }
    323     if {![regexp {^[0-9]+|end$} $first]} {
    324         error "bad index \"$first\": should be integer or \"end\""
    325     }
    326     if {![regexp {^[0-9]+|end$} $last]} {
    327         error "bad index \"$last\": should be integer or \"end\""
     316    if {![string is integer $first]} {
     317        set first [index $first]
     318    }
     319    if {![string is integer $last]} {
     320        set last [index $last]
    328321    }
    329322
     
    346339
    347340# ----------------------------------------------------------------------
    348 # USAGE: index <name>|@n
     341# USAGE: index <name>|<path>|@n|end
    349342#
    350343# Clients use this to convert a control <name> into its corresponding
    351344# integer index.  Returns an error if the <name> is not recognized.
    352345# ----------------------------------------------------------------------
    353 itcl::body Rappture::Controls::index {name} {
    354     set i [lsearch $_controls $name]
     346itcl::body Rappture::Controls::index {val} {
     347    set i [lsearch $_controls $val]
    355348    if {$i >= 0} {
    356349        return $i
    357350    }
    358     if {[regexp {^@([0-9]+)$} $name match i]} {
     351    if {[regexp {^@([0-9]+)$} $val match i]} {
    359352        return $i
    360353    }
    361     if {$name == "end"} {
     354    if {$val eq "end"} {
    362355        return [expr {[llength $_controls]-1}]
    363356    }
    364     error "bad control name \"$name\": should be @int or one of [join [lsort $_controls] {, }]"
     357
     358    # treat as a path name and search for this path
     359    foreach name $_controls {
     360        if {$_name2info($name-path) eq $val} {
     361            set i [lsearch $_controls $name]
     362            if {$i >= 0} {
     363                return $i
     364            }
     365        }
     366    }
     367
     368    error "bad control name \"$name\": should be @int or \"end\" or path name or one of [join [lsort $_controls] {, }]"
    365369}
    366370
     
    439443        set show 1
    440444        set cond $_name2info($name-enable)
    441         if {[string is boolean $cond] && !$cond} {
    442             # hard-coded "off" -- ignore completely
    443         } elseif {[catch {expr $cond} show] == 0} {
     445        if {[catch {expr $cond} show] == 0} {
    444446            set type $_name2info($name-type)
    445447            set disablestyle $_name2info($name-disablestyle)
  • trunk/gui/scripts/drawingentry.tcl

    r3330 r3636  
    2020    itk_option define -state state State "normal"
    2121
     22    private variable _dispatcher ""
     23    private variable _path
     24    private variable _owner
     25    private variable _monitoring ""
     26    private variable _xmlobj ""
     27
     28    # slave interpreter where all substituted variables are stored
     29    private variable _parser ""
     30
     31    # unique counter for popup names
     32    private common _popupnum 0
     33
    2234    private variable _canvasHeight 0
    2335    private variable _canvasWidth 0
    24     private variable _cname2controls
     36    private variable _cpath2popup
     37    private variable _takedown ""
    2538    private variable _cname2id
    2639    private variable _cname2image
    2740    private variable _name2path
     41    private variable _name2map
    2842    private variable _drawingHeight 0
    2943    private variable _drawingWidth 0
    30     private variable _owner
    31     private variable _xmlobj ""
    32     private variable _parser "";        # Slave interpreter where all
    33                                         # substituted variables are stored.
    34     private variable _path
    3544    private variable _showing ""
    3645    private variable _xAspect 0
     
    5665    private method Activate { tag }
    5766    private method AdjustDrawingArea { xAspect yAspect }
    58     private method ControlValue {path {units ""}}
    5967    private method Deactivate { tag }
    6068    private method Highlight { tag }
    61     private method InitSubstitutions {}
    6269    private method Invoke { name x y }
    6370    private method ParseBackground {}
     
    7178    private method ParseRectangle { cpath cname }
    7279    private method ParseScreenCoordinates { values }
    73     private method ParseSubstitutions {}
    7480    private method ParseText { cpath cname }
    7581    private method Redraw {}
     
    7783    private method ScreenX { x }
    7884    private method ScreenY { y }
     85    private method UpdateSubstitutions {}
    7986    private method XmlGet { path }
    8087    private method XmlGetSubst { path }
    81     private method Withdraw { cname }
    8288    private method Hotspot { option cname item args }
    83     private method IsEnabled { path }
    84     private method NumControlsEnabled { cname }
    8589}
    8690
     
    102106    set _owner $owner
    103107    set _xmlobj [$_owner xml object]
     108
     109    Rappture::dispatcher _dispatcher
     110    $_dispatcher register !redraw
     111    $_dispatcher dispatch $this !redraw "[itcl::code $this Redraw]; list"
     112
    104113    #
    105114    # Display the current drawing.
     
    112121    }
    113122    pack $itk_component(drawing) -expand yes -fill both
    114     bind $itk_component(drawing) <Configure> [itcl::code $this Redraw]
     123    bind $itk_component(drawing) <Configure> \
     124        [itcl::code $_dispatcher event -idle !redraw]
     125
     126    # scan through all variables and attach notifications for changes
     127    foreach cpath [$_xmlobj children -as path -type variable $_path.substitutions] {
     128        set map ""
     129        set name ""
     130        set path ""
     131        foreach elem [$_xmlobj children $cpath] {
     132            switch -glob -- $elem {
     133                "name*" {
     134                    set name [XmlGet $cpath.$elem]
     135                }
     136                "path*" {
     137                    set path [XmlGet $cpath.$elem]
     138                }
     139                "map*" {
     140                    set from [XmlGet $cpath.$elem.from]
     141                    set to [XmlGet $cpath.$elem.to]
     142                    if {$from eq "" || $to eq ""} {
     143                        puts stderr "empty translation in map table \"$cpath\""
     144                    }
     145                    lappend map $from $to
     146                }
     147            }
     148        }
     149        if {$name eq ""} {
     150            puts stderr "no name defined for substituion variable \"$cpath\""
     151            continue
     152        }
     153        if {[info exists _name2path($name)]} {
     154            puts stderr "substitution variable \"$name\" already defined"
     155            continue
     156        }
     157        set _name2path($name) $path
     158        if {$path eq ""} {
     159            puts stderr "no path defined for substituion variable \"$cpath\""
     160            continue
     161        }
     162        set _name2map($name) $map
     163
     164        # keep track of controls built for each variable (see below)
     165        set controls($path) unused
     166
     167        # whenever variable changes, update drawing to report new values
     168        if {[lsearch $_monitoring $path] < 0} {
     169            $_owner notify add $this $path \
     170                [itcl::code $_dispatcher event -idle !redraw]
     171            lappend _monitoring $path
     172        }
     173    }
     174
     175    # find all embedded controls and build a popup for each hotspot
     176    foreach cpath [$_xmlobj children -type hotspot -as path $_path.components] {
     177        set listOfControls [$_xmlobj children -type controls $cpath]
     178        if {[llength $listOfControls] > 0} {
     179            set popup .drawingentrypopup[incr _popupnum]
     180            Rappture::Balloon $popup -title "Change values..."
     181            set inner [$popup component inner]
     182            Rappture::Controls $inner.controls $_owner
     183            pack $inner.controls -fill both -expand yes
     184            set _cpath2popup($cpath) $popup
     185
     186            # Add control widgets to this popup.
     187            # NOTE: if the widget exists elsewhere, it is deleted at this
     188            #   point and "sucked in" to the popup.
     189            foreach cname $listOfControls {
     190                set cntlpath [XmlGetSubst $cpath.$cname]
     191                $inner.controls insert end $cntlpath
     192            }
     193        }
     194    }
     195
     196    set c $itk_component(drawing)
     197    foreach cpath [$_xmlobj children -type text -as path $_path.components] {
     198        set popup ""
     199        set mode [XmlGetSubst $cpath.hotspot]
     200        if {$mode eq "off"} {
     201            # no popup if hotspot is turned off
     202            continue
     203        }
     204
     205        # easiest way to parse embedded variables is to create a hotspot item
     206        set id [$c create hotspot 0 0 -text [XmlGet $cpath.text]]
     207        foreach varName [Rappture::hotspot variables $c $id] {
     208            if {[info exists _name2path($varName)]} {
     209                set cntlpath $_name2path($varName)
     210
     211                if {$controls($cntlpath) ne "unused"} {
     212                    puts stderr "WARNING: drawing variable \"$varName\" is used in two hotspots, but will appear in only one of them."
     213                    continue
     214                }
     215                set controls($cntlpath) "--"
     216
     217                if {$popup eq ""} {
     218                    # create the popup for this item, if we haven't already
     219                    set popup .drawingentrypopup[incr _popupnum]
     220                    Rappture::Balloon $popup -title "Change values..."
     221                    set inner [$popup component inner]
     222                    Rappture::Controls $inner.controls $_owner
     223                    pack $inner.controls -fill both -expand yes
     224                }
     225
     226                # Add the control widget for this variable to this popup.
     227                # NOTE: if the widget exists elsewhere, it is deleted at this
     228                #   point and "sucked in" to the popup.
     229                set inner [$popup component inner]
     230                $inner.controls insert end $cntlpath
     231                set _cpath2popup($cntlpath) $popup
     232            } else {
     233                puts stderr "unknown variable \"$varName\" in drawing item at $cpath"
     234            }
     235        }
     236        $c delete $id
     237    }
     238
     239    # create a parser to manage substitions of variable values
    115240    set _parser [interp create -safe]
    116     Redraw
     241
    117242    eval itk_initialize $args
     243
     244    # initialize the drawing at some point
     245    $_dispatcher event -idle !redraw
    118246}
    119247
    120248itcl::body Rappture::DrawingEntry::destructor {} {
    121     if { $_parser != "" } {
     249    # stop monitoring controls for value changes
     250    foreach cpath $_monitoring {
     251        $_owner notify remove $this $cpath
     252    }
     253
     254    # tear down the value subsitution parser
     255    if {$_parser != ""} {
    122256        $_parser delete
    123257    }
     
    130264# ----------------------------------------------------------------------
    131265itcl::body Rappture::DrawingEntry::label {} {
    132 return ""
    133     set label [$_xmlobj get $_path.about.label]
    134     if {"" == $label} {
     266    set label [$_owner xml get $_path.about.label]
     267    if {$label eq ""} {
    135268        set label "Drawing"
    136269    }
     
    147280# ----------------------------------------------------------------------
    148281itcl::body Rappture::DrawingEntry::tooltip {} {
    149 return ""
    150282    set str [$_xmlobj get $_path.about.description]
    151283    return [string trim $str]
     
    163295
    164296itcl::body Rappture::DrawingEntry::Redraw {} {
     297    # If a popup is pending, redraw signals a value change; take it down
     298    if {$_takedown ne ""} {
     299        $_takedown deactivate
     300        set _takedown ""
     301    }
     302
    165303    # Remove exists canvas items and hints
    166304    $itk_component(drawing) delete all
     305
    167306    # Delete any images that we created.
    168307    foreach name [array names _cname2image] {
    169308        image delete $_cname2image($name)
    170309    }
    171     array unset _name2path
    172310    array unset _cname2id
    173     array unset _cnames2controls
    174311    array unset _cname2image
    175312   
     
    194331#
    195332itcl::body Rappture::DrawingEntry::ParseDescription {} {
    196     #puts stderr "ParseDescription owner=$_owner path=$_path"
    197333    ParseBackground
    198     ParseSubstitutions
     334    UpdateSubstitutions
    199335    foreach cname [$_xmlobj children $_path.components] {
    200336        switch -glob -- $cname {
     
    231367#
    232368itcl::body Rappture::DrawingEntry::ParseGrid { cpath cname } {
    233     #puts stderr "ParseGrid owner=$_owner cpath=$cpath"
    234369    array set attr2option {
    235370        "linewidth"     "-width"
     
    247382    # Coords
    248383    set xcoords [XmlGetSubst $cpath.xcoords]
    249     set xcoords [string trim $xcoords]
    250384    set ycoords [XmlGetSubst $cpath.ycoords]
    251     set ycoords [string trim $ycoords]
    252385    if { $ycoords == "" } {
    253386        set ycoords "0 1"
     
    290423        set xcoords $list
    291424    }
    292     #puts stderr "ParseGrid owner=$_owner cpath=$cpath xcoords=$xcoords ycoords=$ycoords"
     425
    293426    set list {}
    294427    foreach attr [$_xmlobj children $cpath] {
     
    321454        "anchor" "-anchor"
    322455    }
    323     #puts stderr "ParseHotspot owner=$_owner cpath=$cpath"
     456
    324457    # Set default options first and then let tool.xml override them.
    325458    array set options {
     
    327460        -anchor c
    328461    }
    329     array unset _cname2controls $cname
    330462    foreach attr [$_xmlobj children $cpath] {
    331463        if { [info exists attr2option($attr)] } {
     
    333465            set value [XmlGetSubst $cpath.$attr]
    334466            set options($option) $value
    335         } elseif { [string match "controls*" $attr] } {
    336             set value [XmlGetSubst $cpath.$attr]
    337             lappend _cname2controls($cname) $value
    338             $_xmlobj put $value.hide 1
    339467        }
    340468    }
    341469    # Coordinates
    342470    set coords [XmlGetSubst $cpath.coords]
    343     set coords [ScreenCoords $coords]
    344     if { $coords == "" } {
     471    if {$coords eq ""} {
    345472        set coords "0 0 1 1"
    346     } 
     473    }
    347474    set c $itk_component(drawing)
    348     set img [Rappture::icon hotspot_normal]
    349     foreach { x1 y1 } $coords break
     475    foreach {x1 y1} [ScreenCoords $coords] break
    350476    set id [$itk_component(drawing) create image $x1 $y1]
    351477    array unset options -fill
    352478    set options(-tags) $cname
    353     set options(-image) $img
     479    set options(-image) [Rappture::icon hotspot_normal]
    354480    eval $c itemconfigure $id [array get options]
    355481    set _cname2id($cname) $id
    356482    $c bind $id <Enter> [itcl::code $this Activate $cname]
    357483    $c bind $id <Leave> [itcl::code $this Deactivate $cname]
    358     #$c bind $id <ButtonPress-1> [itcl::code $this Depress $cname]
    359484    set bbox [$c bbox $id]
    360485    set y1 [lindex $bbox 1]
    361     $c bind $id <ButtonPress-1> [itcl::code $this Invoke $cname $x1 $y1]
     486    $c bind $id <ButtonPress-1> [itcl::code $this Invoke $cpath $x1 $y1]
    362487}
    363488
     
    380505    }
    381506    # Coords
    382     set coords {}
    383507    set coords [XmlGetSubst $cpath.coords]
    384     set coords [string trim $coords]
    385     if { $coords == "" } {
     508    if {$coords eq ""} {
    386509        set coords "0 0"
    387     } else {
    388         set coords [ScreenCoords $coords]
    389     }
    390     #puts stderr "ParseLine owner=$_owner cpath=$cpath coords=$coords"
     510    }
     511    set coords [ScreenCoords $coords]
     512
    391513    set list {}
    392514    foreach attr [$_xmlobj children $cpath] {
     
    412534        "linewidth"     "-width"
    413535    }
    414     #puts stderr "ParseOval owner=$_owner cpath=$cpath"
    415536
    416537    # Set default options first and then let tool.xml override them.
     
    428549    }
    429550    # Coordinates
    430     set coords {}
    431551    set coords [XmlGetSubst $cpath.coords]
    432     set coords [string trim $coords]
    433     if { $coords == "" } {
     552    if {$coords eq ""} {
    434553        set coords "0 0 1 1"
    435554    }
     
    447566        "anchor"        "-anchor"
    448567    }
    449     #puts stderr "ParsePicture owner=$_owner cpath=$cpath"
     568
    450569    # Set default options first and then let tool.xml override them.
    451570    array set options {
     
    462581    set img ""
    463582    if { [string compare -length 7 $contents "file://"] == 0 } {
    464         set fileName [string range $contents 5 end]
     583        set fileName [string range $contents 7 end]
    465584        if { [file exists $fileName] } {
    466585            set img [image create photo -file $fileName]
    467         }
     586        } else {
     587            puts stderr "WARNING: can't find picture contents \"$fileName\""
     588        }
    468589    } elseif { [string compare -length 7 $contents "http://"] == 0 } {
    469590        puts stderr  "don't know how to handle http"
     
    472593        set img [image create photo -data $contents]
    473594    }
    474     if { $img == "" } {
     595    if {$img eq ""} {
    475596        return
    476597    }
    477598    # Coordinates
    478599    set coords [XmlGetSubst $cpath.coords]
    479     set coords [ScreenCoords $coords]
    480600    if { [llength $coords] == 2 } {
    481         foreach { x1 y1 } $coords break
     601        foreach { x1 y1 } [ScreenCoords $coords] break
    482602        set w [XmlGetSubst $cpath.width]
    483603        if { $w == "" || ![string is number $w] || $w <= 0.0 } {
     
    494614        if { $width != [image width $img] || $height != [image height $img] } {
    495615            set dst [image create photo -width $width -height $height]
    496             blt::winop resample $img $dest
     616            blt::winop resample $img $dst
    497617            image delete $img
    498618            set img $dst
    499619        }
    500620    } elseif { [llength $coords] == 4 } {
    501         foreach { x1 y1 x2 y2 } $coords break
     621        foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
    502622        if { $x1 > $x2 } {
    503623            set tmp $x1
     
    510630            set x2 $tmp
    511631        }
    512         set width [expr $x2 - $x1 + 1]
    513         set height [expr $x2 - $x1 + 1]
     632        set width [expr {$x2 - $x1 + 1}]
     633        set height [expr {$y2 - $y1 + 1}]
    514634        if { $width != [image width $img] || $height != [image height $img] } {
    515635            set dst [image create photo -width $width -height $height]
     
    548668        -outline        black
    549669    }
     670
    550671    # Coords
    551672    set coords [XmlGetSubst $cpath.coords]
    552     set coords [string trim $coords]
    553     if { $coords == "" } {
     673    if {$coords eq ""} {
    554674        set coords "0 0"
    555     } else {
    556         set coords [ScreenCoords $coords]
    557     }
    558     set x1 [lindex $coords 0]
    559     set y1 [lindex $coords 1]
    560     lappend coords $x1 $y1
    561     #puts stderr "ParsePolygon owner=$_owner cpath=$cpath coords=$coords"
     675    }
     676    set coords [ScreenCoords $coords]
     677
    562678    set list {}
    563679    foreach attr [$_xmlobj children $cpath] {
     
    583699        "linewidth"     "-width"
    584700    }
    585     #puts stderr "ParseRectangle owner=$_owner cpath=$cpath"
    586701
    587702    # Set default options first and then let tool.xml override them.
     
    600715    # Coordinates
    601716    set coords [XmlGetSubst $cpath.coords]
    602     set coords [string trim $coords]
    603     if { $coords == "" } {
     717    if {$coords eq ""} {
    604718        set coords "0 0 1 1"
    605719    }
    606720    foreach { x1 y1 x2 y2 } [ScreenCoords $coords] break
    607    set id [$itk_component(drawing) create rectangle $x1 $y1 $x2 $y2]
     721    set id [$itk_component(drawing) create rectangle $x1 $y1 $x2 $y2]
    608722    set _cname2id($cname) $id
    609723    eval $itk_component(drawing) itemconfigure $id [array get options]
     
    621735        "anchor"        "-anchor"
    622736    }
    623     #puts stderr "ParseText owner=$_owner cpath=$cpath"
    624737
    625738    # Set default options first and then let tool.xml override them.
    626739    array set options {
    627         -font {Arial 12}
    628         -valuefont {Arial 12}
     740        -font {Arial -14}
     741        -valuefont {Arial -14}
    629742        -valueforeground blue3
    630743        -text {}
     
    645758    # Coords
    646759    set coords [XmlGetSubst $cpath.coords]
    647     set coords [string trim $coords]
    648     if { $coords == "" } {
    649         set coords "0 0"
    650     } else {
    651         set coords [ScreenCoords $coords]
    652     }
     760    if {$coords eq ""} {
     761        set coords "0 0"
     762    }
     763    foreach {x0 y0} [ScreenCoords $coords] break
     764
    653765    set hotspot [XmlGetSubst $cpath.hotspot]
    654     if { $hotspot == "inline" } {
     766    if {$hotspot eq ""} {
     767        # assume inline by default
     768        set hotspot "inline"
     769    } elseif {[lsearch {inline off} $hotspot] < 0} {
     770        puts stderr "WARNING: bad hotspot value \"$hotspot\": should be inline or off"
     771    }
     772
     773    if {$hotspot eq "inline"} {
    655774        set options(-showicons) 1
    656775    }
    657776    set c $itk_component(drawing)
    658777    set options(-tags) $cname
    659     set img [Rappture::icon hotspot_normal]
    660     set options(-image) $img
    661     set img [Rappture::icon hotspot_active]
    662     set options(-activeimage) $img
    663     set id [eval $c create hotspot $coords]
     778    set options(-image) [Rappture::icon hotspot_normal]
     779    set options(-activeimage) [Rappture::icon hotspot_active]
     780    set id [$c create hotspot $x0 $y0]
    664781    set _cname2id($cname) $id
    665782    set options(-interp) $_parser
    666783    eval $c itemconfigure $id [array get options]
    667     if { $hotspot == "inline" } {
    668         array unset _cname2controls $cname
    669         foreach varName [Rappture::hotspot variables $c $id] {
    670             if { [info exists _name2path($varName)] } {
    671                 set path $_name2path($varName)
    672                 $_xmlobj put $path.hide 1
    673                 lappend _cname2controls($cname) $path
    674             } else {
    675                 puts stderr "unknown varName=$varName"
    676             }
    677         }
     784
     785    if {$hotspot eq "inline"} {
     786        $c bind $id <Enter> \
     787            [itcl::code $this Hotspot activate $cname $id %x %y]
    678788        $c bind $id <Motion> \
    679             [itcl::code $this Hotspot watch $cname $id %x %y]
     789            [itcl::code $this Hotspot activate $cname $id %x %y]
    680790        $c bind $id <Leave> \
    681791            [itcl::code $this Hotspot deactivate $cname $id]
    682         $c bind $id <Enter> \
    683             [itcl::code $this Hotspot activate $cname $id %x %y]
    684792        $c bind $id <ButtonRelease-1> \
    685793            [itcl::code $this Hotspot invoke $cname $id %x %y]
     
    689797
    690798itcl::body Rappture::DrawingEntry::Hotspot { option cname item args } {
    691     if { [NumControlsEnabled $cname] == 0 } {
    692         return
    693     }
    694799    set c $itk_component(drawing)
     800
     801    # see what variable (if any) that we're touching within the text
     802    set varName ""
     803    if {[llength $args] >= 2} {
     804        foreach {x y} $args break
     805        foreach {varName x0 y0 x1 y1} [Rappture::hotspot identify $c $item $x $y] break
     806    }
     807
    695808    switch -- $option {
    696         "activate" {
    697             foreach { x y } $args break
    698             set varName  [Rappture::hotspot identify $c $item $x $y]
    699             $c itemconfigure $item -activevalue $varName
    700         }
    701         "deactivate" {
     809        activate {
     810            if {$varName ne ""} {
     811                set active [$c itemcget $item -activevalue]
     812                if {$varName ne $active} {
     813                    $c itemconfigure $item -activevalue $varName
     814                }
     815                $itk_component(drawing) configure -cursor center_ptr
     816
     817                # put up a tooltip for this item
     818                set cpath $_name2path($varName)
     819                set tip [XmlGet $cpath.about.description]
     820                if {$tip ne ""} {
     821                    set x [expr {[winfo rootx $c]+$x0+10}]
     822                    set y [expr {[winfo rooty $c]+$y1}]
     823                    set tag "$c-[string map {. ""} $cpath]"
     824                    Rappture::Tooltip::text $tag $tip -log $cpath
     825                    Rappture::Tooltip::tooltip pending $tag @$x,$y
     826                }
     827            } else {
     828                $c itemconfigure $item -activevalue ""
     829                $itk_component(drawing) configure -cursor ""
     830                Rappture::Tooltip::tooltip cancel
     831            }
     832        }
     833        deactivate {
    702834            $c itemconfigure $item -activevalue ""
    703         }
    704         "watch" {
    705             foreach { x y } $args break
    706             set active [$c itemcget $item -activevalue]
    707             set varName  [Rappture::hotspot identify $c $item $x $y]
    708             if { $varName != $active  } {
    709                 $c itemconfigure $item -activevalue $varName
    710             }
    711         }
    712         "invoke" {
    713             foreach { x y } $args break
    714             set active [$c itemcget $item -activevalue]
    715             set varName  [Rappture::hotspot identify $c $item $x $y]
    716             if { $varName != "" } {
    717                 set bbox [$c bbox $item]
    718                 Invoke $cname $x [lindex $bbox 1]
    719             }
    720         }
     835            $itk_component(drawing) configure -cursor ""
     836            Rappture::Tooltip::tooltip cancel
     837        }
     838        invoke {
     839            if {$varName ne ""} {
     840                set x [expr {($x0+$x1)/2}]
     841                Invoke $_name2path($varName) $x $y0
     842            }
     843        }
     844        default {
     845            error "bad option \"$option\": should be activate, deactivate, invoke"
     846        }
    721847    }
    722848}
     
    724850
    725851itcl::body Rappture::DrawingEntry::ScreenX { x } {
    726     set norm [expr ($x - $_xMin) * $_xScale]
    727     set x [expr int($norm * $_drawingWidth) + $_xOffset]
     852    set norm [expr {($x - $_xMin) * $_xScale}]
     853    set x [expr {int($norm * $_drawingWidth) + $_xOffset}]
    728854    return $x
    729855}
    730856
    731857itcl::body Rappture::DrawingEntry::ScreenY { y } {
    732     set norm [expr ($y - $_yMin) * $_yScale]
    733     set y [expr int($norm * $_drawingHeight) + $_yOffset]
     858    set norm [expr {($y - $_yMin) * $_yScale}]
     859    set y [expr {int($norm * $_drawingHeight) + $_yOffset}]
    734860    return $y
    735861}
     
    860986}
    861987
    862 itcl::body Rappture::DrawingEntry::ParseSubstitutions {} {
    863     foreach var [$_xmlobj children $_path.substitutions] {
    864         if { ![string match "variable*" $var] } {
    865             continue
    866         }
    867         set varPath $_path.substitutions.$var
    868         set map ""
    869         set name ""
    870         set path ""
    871         foreach elem [$_xmlobj children $varPath] {
    872             switch -glob -- $elem {
    873                 "name*" {
    874                     set name [XmlGet $varPath.$elem]
    875                 }
    876                 "path*" {
    877                     set path [XmlGet $varPath.$elem]
    878                 }
    879                 "map*" {
    880                     set from [XmlGet $varPath.$elem.from]
    881                     set to [XmlGet $varPath.$elem.to]
    882                     if { $from == "" || $to == "" } {
    883                         puts stderr "empty translation in map table \"$varPath\""
    884                     }
    885                     lappend map $from $to
    886                 }
    887             }
    888         }
    889         if { $name == "" } {
    890             puts stderr \
    891                 "no name defined for substituion variable \"$varPath\""
    892             continue
    893         }
    894         if { [info exists _name2path($name)] } {
    895             puts stderr \
    896                 "substitution variable \"$name\" already defined"
    897             continue
    898         }               
    899         set _name2path($name) $path
    900         if { $path == "" } {
    901             puts stderr \
    902                 "no path defined for substituion variable \"$varPath\""
    903             continue
    904         }
    905         set _name2map($name) $map
    906     }
    907     InitSubstitutions
    908 }
    909 
    910988#
    911989# Invoke --
    912990#
    913 itcl::body Rappture::DrawingEntry::Invoke { cname x y } {
    914     set controls $_cname2controls($cname)
    915     if { [llength $controls] == 0 } {
    916         puts stderr "no controls defined for $cname"
    917         return
    918     }
    919     # Build a popup with the designated controls
    920     set popup .drawingentrypopup
    921     if { ![winfo exists $popup] } {
    922         # Create a popup for the controls dialog
    923         Rappture::Balloon $popup -title "Change values..." \
    924             -deactivatecommand [itcl::code $this Withdraw $cname]
    925         set inner [$popup component inner]
    926         Rappture::DrawingControls $inner.controls $_owner \
    927             -deactivatecommand [list $popup deactivate]
    928         pack $inner.controls -fill both -expand yes
     991itcl::body Rappture::DrawingEntry::Invoke {cpath x y} {
     992    if {![info exists _cpath2popup($cpath)]} {
     993        error "internal error: no controls for hotspot at $cpath"
     994    }
     995    set popup $_cpath2popup($cpath)
     996
     997    # if this popup has only one control, watch for it to change and
     998    # take it down automatically
     999    set inner [$popup component inner]
     1000    set n [expr {[$inner.controls index end]+1}]
     1001    if {$n == 1} {
     1002        set _takedown $popup
    9291003    } else {
    930         set inner [$popup component inner]
    931         $inner.controls delete all
    932     }
    933     set count 0
    934     foreach path $controls {
    935         if { [IsEnabled $path] } {
    936             $inner.controls add $path
    937             incr count
    938         }
    939     }
    940     if { $count == 0 } {
    941         return
    942     }
    943     update
     1004        set _takedown ""
     1005    }
     1006
    9441007    # Activate the popup and call for the output.
    9451008    incr x [winfo rootx $itk_component(drawing)]
     
    9611024#
    9621025itcl::body Rappture::DrawingEntry::Deactivate { cname } {
    963     $itk_component(drawing) configure -cursor left_ptr
     1026    $itk_component(drawing) configure -cursor ""
    9641027    $itk_component(drawing) itemconfigure $_cname2id($cname) \
    9651028        -image [Rappture::icon hotspot_normal]
    966 }
    967 
    968 #
    969 # Withdraw --
    970 #
    971 itcl::body Rappture::DrawingEntry::Withdraw { cname } {
    972     Redraw
    9731029}
    9741030
     
    9871043        set libobj [lindex $args 0]
    9881044        if { $libobj != "" } {
    989             Redraw
     1045            $_dispatcher event -idle !redraw
    9901046        }
    9911047    }
     
    9931049}
    9941050
    995 
    996 #
    997 # InitSubstitutions --
    998 #
    999 itcl::body Rappture::DrawingEntry::InitSubstitutions {} {
    1000     # Load a new parser with the variables representing the substitution
     1051itcl::body Rappture::DrawingEntry::UpdateSubstitutions {} {
     1052    # Load parser with the variables representing the substitution
    10011053    foreach name [array names _name2path] {
    10021054        set path $_name2path($name)
    10031055        set w [$_owner widgetfor $path]
    1004         if { $w != "" } {
     1056        if {$w ne ""} {
    10051057            set value [$w value]
    10061058        } else {
    10071059            set value ""
    10081060        }
     1061        if {$_name2map($name) ne ""} {
     1062            set value [string map $_name2map($name) $value]
     1063        }
    10091064        $_parser eval [list set $name $value]
    10101065    }
     
    10181073itcl::body Rappture::DrawingEntry::XmlGetSubst { path } {
    10191074    set value [$_xmlobj get $path]
    1020     if { $_parser == "" } {
    1021         return $value
     1075    if {$_parser == ""} {
     1076        return [string trim $value]
    10221077    }
    10231078    return [string trim [$_parser eval [list subst -nocommands $value]]]
    10241079}
    1025 
    1026 itcl::body Rappture::DrawingEntry::IsEnabled { path } {
    1027     set enable [string trim [$_xmlobj get $path.about.enable]]
    1028     if {"" == $enable} {
    1029         return 1
    1030     }
    1031     if {![string is boolean $enable]} {
    1032         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/]+)?}
    1033         set rest $enable
    1034         set enable ""
    1035         set deps ""
    1036         while {1} {
    1037             if {[regexp -indices $re $rest match]} {
    1038                 foreach {s0 s1} $match break
    1039 
    1040                 if {[string index $rest [expr {$s0-1}]] == "\""
    1041                       && [string index $rest [expr {$s1+1}]] == "\""} {
    1042                     # string in ""'s? then leave it alone
    1043                     append enable [string range $rest 0 $s1]
    1044                     set rest [string range $rest [expr {$s1+1}] end]
    1045                 } else {
    1046                     #
    1047                     # This is a symbol which should be substituted
    1048                     # it can be either:
    1049                     #   input.foo.bar
    1050                     #   input.foo.bar:units
    1051                     #
    1052                     set cpath [string range $rest $s0 $s1]
    1053                     set parts [split $cpath :]
    1054                     set ccpath [lindex $parts 0]
    1055                     set units [lindex $parts 1]
    1056 
    1057                     # make sure we have the standard path notation
    1058                     set stdpath [$_owner regularize $ccpath]
    1059                     if {"" == $stdpath} {
    1060                         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."
    1061                         set stdpath $ccpath
    1062                     }
    1063                     # substitute [_controlValue ...] call in place of path
    1064                     append enable [string range $rest 0 [expr {$s0-1}]]
    1065                     append enable [format {[ControlValue %s %s]} $stdpath $units]
    1066                     lappend deps $stdpath
    1067                     set rest [string range $rest [expr {$s1+1}] end]
    1068                 }
    1069             } else {
    1070                 append enable $rest
    1071                 break
    1072             }
    1073         }
    1074     }
    1075     return [expr $enable]
    1076 }
    1077 
    1078 # ----------------------------------------------------------------------
    1079 # USAGE: ControlValue <path> ?<units>?
    1080 #
    1081 # Used internally to get the value of a control with the specified
    1082 # <path>.  Returns the current value for the control.
    1083 # ----------------------------------------------------------------------
    1084 itcl::body Rappture::DrawingEntry::ControlValue {path {units ""}} {
    1085     if {"" != $_owner} {
    1086         set val [$_owner valuefor $path]
    1087          if {"" != $units} {
    1088             set val [Rappture::Units::convert $val -to $units -units off]
    1089         }
    1090         return $val
    1091     }
    1092     return ""
    1093 }
    1094 
    1095 itcl::body Rappture::DrawingEntry::NumControlsEnabled { cname } {
    1096     set controls $_cname2controls($cname)
    1097     set count 0
    1098     foreach path $controls {
    1099         if { [IsEnabled $path] } {
    1100             incr count
    1101         }
    1102     }
    1103     return $count
    1104 }
  • trunk/gui/scripts/page.tcl

    r3330 r3636  
    197197
    198198            # if this is a group, then build that group
    199             if {[$xmlobj element -as type $path.$cname] == "group"} {
    200                 if {[$xmlobj element -as id $path.$cname] == "ambient"
     199            if {[$xmlobj element -as type $path.$cname] eq "group"} {
     200                if {[$xmlobj element -as id $path.$cname] eq "ambient"
    201201                       && $deveditor != ""} {
    202202                    set w [$deveditor component top]
    203203                } else {
    204                     if {[catch {$frame.cntls insert end $path.$cname} c]} {
     204                    if {[$_owner widgetfor $path.$cname] ne ""} {
     205                        # widget already created -- skip this
     206                    } elseif {[catch {$frame.cntls insert end $path.$cname} c]} {
    205207                        global errorInfo
    206208                        error $c "$c\n$errorInfo\n    (while building control for $path.$cname)"
     
    212214                _buildGroup $w $xmlobj $path.$cname
    213215            } else {
    214                 if {[catch {$frame.cntls insert end $path.$cname} c]} {
     216                if {[$_owner widgetfor $path.$cname] ne ""} {
     217                    # widget already created -- skip this
     218                } elseif {[catch {$frame.cntls insert end $path.$cname} c]} {
    215219                    global errorInfo
    216220                    error $c "$c\n$errorInfo\n    (while building control for $path.$cname)"
  • trunk/gui/scripts/pager.tcl

    r3330 r3636  
    490490        pages {
    491491            pack forget $itk_component(inside)
    492             pack $itk_component(controls) -side bottom -fill x -padx 8 -pady 8
     492            pack $itk_component(controls) -side bottom -fill x -padx 32 -pady 8
    493493            pack $itk_component(breadcrumbarea) -side top -fill x
    494494            pack $itk_component(line) -side top -fill x
  • trunk/gui/scripts/textentry.tcl

    r3513 r3636  
    492492# ----------------------------------------------------------------------
    493493itcl::body Rappture::TextEntry::_edit {option args} {
    494 puts "_edit $option $args"
    495494    if {$itk_option(-state) == "disabled"} {
    496495        return  ;# disabled? then bail out here!
  • trunk/gui/src/RpCanvHotspot.c

    r3405 r3636  
    17261726}
    17271727
    1728 static const char *
     1728static Tcl_Obj *
    17291729Identify(Tcl_Interp *interp, HotspotItem *itemPtr, double x, double y)
    17301730{
     1731    Tcl_Obj* resultPtr = NULL;
    17311732    ItemSegment *segPtr;
     1733    Tcl_Obj* objPtr;
    17321734
    17331735    x -= itemPtr->x1;
     
    17391741        if ((x >= segPtr->x) && (x < (segPtr->x + segPtr->width)) &&
    17401742            (y >= segPtr->y) && (y < (segPtr->y + segPtr->height))) {
    1741             return segPtr->text;
    1742         }
    1743     }
    1744     return "";
     1743
     1744            /* build return list: {string x0 y0 x1 y1} */
     1745            resultPtr = Tcl_NewListObj(0, (Tcl_Obj **)NULL);
     1746
     1747            objPtr = Tcl_NewStringObj(segPtr->text, -1);
     1748            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
     1749
     1750            objPtr = Tcl_NewIntObj(itemPtr->x1 + segPtr->x);
     1751            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
     1752            objPtr = Tcl_NewIntObj(itemPtr->y1 + segPtr->y);
     1753            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
     1754
     1755            objPtr = Tcl_NewIntObj(itemPtr->x1 + segPtr->x + segPtr->width);
     1756            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
     1757            objPtr = Tcl_NewIntObj(itemPtr->y1 + segPtr->y + segPtr->height);
     1758            Tcl_ListObjAppendElement(interp, resultPtr, objPtr);
     1759
     1760            return resultPtr;
     1761        }
     1762    }
     1763    return NULL;
    17451764}
    17461765
     
    17701789    } else if ((c == 'i') && (strncmp(string, "identify", length) == 0)) {
    17711790        double x, y;
    1772         const char *token;
    17731791        Tcl_Obj *objPtr;
    17741792
     
    17781796            return TCL_ERROR;
    17791797        }
    1780         token = Identify(interp, itemPtr, x, y);
    1781         objPtr = Tcl_NewStringObj(token, -1);
    1782         Tcl_SetObjResult(interp, objPtr);
     1798        objPtr = Identify(interp, itemPtr, x, y);
     1799        if (objPtr != NULL) {
     1800            Tcl_SetObjResult(interp, objPtr);
     1801        }
    17831802    } else if ((c == 'v') && (strncmp(string, "variables", length) == 0)) {
    17841803        Tcl_Obj *listObjPtr;
Note: See TracChangeset for help on using the changeset viewer.