Changeset 11 for trunk/gui/scripts

Timestamp:

May 30, 2005, 9:33:49 PM (19 years ago)

Author:

mmc

Message:

Major reorganization of the entire package. The config.xml file
is now irrelevant. All the action is in the tool.xml file. The
main program now organizes all input into 1) side-by-side pages,
2) input/result (wizard-style) pages, or 3) a series of wizard-
style pages. The <input> can have <phase> parts representing
the various pages.

Added a new ContourResult? widget based on Swaroop's vtk plotting
code.

Also, added easymesh and showmesh to the "tools" directory.
We need these for Eric Polizzi's code.

Location:

trunk/gui/scripts

Files:

• analyzer.tcl (modified) (8 diffs)
• animover.tcl (modified) (1 diff)
• choiceentry.tcl (added)
• cloud.tcl (added)
• combobox.tcl (modified) (2 diffs)
• contourresult.tcl (added)
• controls.tcl (added)
• curve.tcl (modified) (9 diffs)
• deviceEditor.tcl (added)
• deviceLayout1D.tcl (modified) (21 diffs)
• deviceViewer1D.tcl (modified) (19 diffs)
• dispatcher.tcl (modified) (1 diff)
• dropdown.tcl (modified) (1 diff)
• dropdownlist.tcl (modified) (3 diffs)
• editor.tcl (modified) (1 diff)
• energyLevels.tcl (modified) (5 diffs)
• field.tcl (modified) (10 diffs)
• gauge.tcl (modified) (2 diffs)
• getopts.tcl (added)
• groupentry.tcl (added)
• images/knob.gif (added)
• images/molecule.gif (deleted)
• images/reset.xbm (added)
• images/zoomin.xbm (added)
• images/zoomout.xbm (added)
• loader.tcl (added)
• mainwin.tcl (modified) (1 diff)
• moleculeViewer.tcl (modified) (7 diffs)
• notebook.tcl (modified) (10 diffs)
• numberentry.tcl (added)
• page.tcl (added)
• pager.tcl (modified) (6 diffs)
• panes.tcl (added)
• radiodial.tcl (added)
• resultset.tcl (added)
• resultviewer.tcl (added)
• scroller.tcl (modified) (9 diffs)
• spectrum.tcl (modified) (2 diffs)
• table.tcl (added)
• tempgauge.tcl (modified) (1 diff)
• textentry.tcl (added)
• textresult.tcl (added)
• tool.tcl (added)
• tooltip.tcl (modified) (9 diffs)
• tuples.tcl (added)
• units.tcl (modified) (2 diffs)
• xyplot.tcl (deleted)
• xyresult.tcl (added)

trunk/gui/scripts/analyzer.tcl

@@ -10 +10 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
-package require BLT
-
+
+option add *Analyzer.width 5i widgetDefault
+option add *Analyzer.height 5i widgetDefault
+option add *Analyzer.simControl "auto" widgetDefault
+option add *Analyzer.simControlBackground "" widgetDefault
+option add *Analyzer.simControlOutline gray widgetDefault
+option add *Analyzer.simControlActiveBackground #ffffcc widgetDefault
+option add *Analyzer.simControlActiveOutline black widgetDefault
+
+option add *Analyzer.font \
+    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
 option add *Analyzer.textFont \
     -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
+option add *Analyzer.boldTextFont \
+    -*-helvetica-bold-r-normal-*-*-120-* widgetDefault
 
 itcl::class Rappture::Analyzer {
     inherit itk::Widget
 
-    itk_option define -tool tool Tool ""
-    itk_option define -device device Device ""
-    itk_option define -analysis analysis Analysis ""
+    itk_option define -textfont textFont Font ""
+    itk_option define -boldtextfont boldTextFont Font ""
+    itk_option define -simcontrol simControl SimControl ""
+    itk_option define -simcontroloutline simControlOutline Background ""
+    itk_option define -simcontrolbackground simControlBackground Background ""
+    itk_option define -simcontrolactiveoutline simControlActiveOutline Background ""
+    itk_option define -simcontrolactivebackground simControlActiveBackground Background ""
     itk_option define -holdwindow holdWindow HoldWindow ""
 
-    constructor {args} { # defined below }
+    constructor {tool args} { # defined below }
     destructor { # defined below }
 
-    public method simulate {}
+    public method simulate {args}
     public method reset {}
     public method load {file}
-
+    public method clear {}
+
+    protected method _plot {args}
+    protected method _reorder {comps}
+    protected method _autoLabel {xmlobj path title cntVar}
     protected method _fixResult {}
-
-    private variable _run ""           ;# results from last run
+    protected method _fixSize {}
+    protected method _fixSimControl {}
+    protected method _simState {state args}
+
+    private variable _tool ""          ;# belongs to this tool
     private variable _control "manual" ;# start mode
-    private variable _widgets          ;# maps analyze section => widget
+    private variable _runs ""          ;# list of XML objects with results
+    private variable _pages 0          ;# number of pages for result sets
+    private variable _label2page       ;# maps output label => result set
+    private variable _plotlist ""      ;# items currently being plotted
 
     private common job                 ;# array var used for blt::bgexec jobs
@@ -49 +75 @@
 # CONSTRUCTOR
 # ----------------------------------------------------------------------
-itcl::body Rappture::Analyzer::constructor {args} {
+itcl::body Rappture::Analyzer::constructor {tool args} {
+    set _tool $tool
+
+    itk_option add hull.width hull.height
+    pack propagate $itk_component(hull) no
+
+    frame $itk_interior.simol -borderwidth 1 -relief flat
+    pack $itk_interior.simol -fill x
+
+    frame $itk_interior.simol.simbg -borderwidth 0
+    pack $itk_interior.simol.simbg -expand yes -fill both
+
+    itk_component add simulate {
+        button $itk_interior.simol.simbg.simulate -text "Simulate" \
+            -command [itcl::code $this simulate]
+    }
+    pack $itk_component(simulate) -side left -padx 4 -pady 4
+
+    itk_component add simstatus {
+        text $itk_interior.simol.simbg.simstatus -borderwidth 0 \
+            -highlightthickness 0 -height 1 -width 1 -wrap none \
+            -state disabled
+    } {
+        usual
+        ignore -highlightthickness
+        rename -font -textfont textFont Font
+    }
+    pack $itk_component(simstatus) -side left -expand yes -fill x
+
+    $itk_component(simstatus) tag configure popup \
+        -underline 1 -foreground blue
+
+    $itk_component(simstatus) tag bind popup \
+        <Enter> {%W configure -cursor center_ptr}
+    $itk_component(simstatus) tag bind popup \
+        <Leave> {%W configure -cursor ""}
+    $itk_component(simstatus) tag bind popup \
+        <ButtonPress> {after idle {Rappture::Tooltip::tooltip show %W}}
+
+
     itk_component add notebook {
         Rappture::Notebook $itk_interior.nb
     }
     pack $itk_interior.nb -expand yes -fill both
+
+    # ------------------------------------------------------------------
+    # ABOUT PAGE
+    # ------------------------------------------------------------------
+    set w [$itk_component(notebook) insert end about]
+
+    Rappture::Scroller $w.info -xscrollmode off -yscrollmode auto
+    pack $w.info -expand yes -fill both -padx 4 -pady 20
+    itk_component add toolinfo {
+        text $w.info.text -width 1 -height 1 -wrap word \
+            -borderwidth 0 -highlightthickness 0
+    } {
+        usual
+        ignore -borderwidth -relief
+        rename -font -textfont textFont Font
+    }
+    $w.info contents $w.info.text
 
     # ------------------------------------------------------------------
@@ -60 +142 @@
     set w [$itk_component(notebook) insert end simulate]
     frame $w.cntls
-    pack $w.cntls -side top -fill x -padx {20 2}
-
-    itk_component add simulate {
-        button $w.cntls.sim -text "Simulate" \
-            -command [itcl::code $this simulate]
-    }
-    pack $itk_component(simulate) -side left
-
-    itk_component add status {
-        label $w.cntls.info -width 1 -text "" -anchor w
-    } {
-        usual
-        rename -font -textfont textFont Font
-    }
-    pack $itk_component(status) -side left -expand yes -fill both
+    pack $w.cntls -side bottom -fill x -pady 12
+    frame $w.cntls.sep -background black -height 1
+    pack $w.cntls.sep -side top -fill x
+
+    itk_component add abort {
+        button $w.cntls.abort -text "Abort" \
+            -command [itcl::code $_tool abort]
+    }
+    pack $itk_component(abort) -side left -expand yes -padx 4 -pady 4
 
     Rappture::Scroller $w.info -xscrollmode off -yscrollmode auto
-    pack $w.info -expand yes -fill both -padx {20 2} -pady {20 2}
-    itk_component add info {
+    pack $w.info -expand yes -fill both -padx 4 -pady 4
+    itk_component add runinfo {
         text $w.info.text -width 1 -height 1 -wrap word \
             -borderwidth 0 -highlightthickness 0 \
@@ -94 +170 @@
     set w [$itk_component(notebook) insert end analyze]
 
+    frame $w.top
+    pack $w.top -side top -fill x -pady 8
+    label $w.top.l -text "Result:" -font $itk_option(-font)
+    pack $w.top.l -side left
+
     itk_component add resultselector {
-        Rappture::Combobox $w.sel -width 30 -editable no
+        Rappture::Combobox $w.top.sel -width 50 -editable no
     } {
         usual
         rename -font -textfont textFont Font
     }
-    pack $itk_component(resultselector) -side top -fill x -padx {20 2}
+    pack $itk_component(resultselector) -side left -expand yes -fill x
     bind $itk_component(resultselector) <<Value>> [itcl::code $this _fixResult]
 
     itk_component add results {
-        Rappture::Notebook $w.nb
-    }
-    pack $itk_component(results) -expand yes -fill both -pady 4
+        Rappture::Panes $w.pane
+    }
+    pack $itk_component(results) -expand yes -fill both
+    set f [$itk_component(results) pane 0]
+
+    itk_component add resultpages {
+        Rappture::Notebook $f.nb
+    }
+    pack $itk_component(resultpages) -expand yes -fill both
+
+    set f [$itk_component(results) insert end -fraction 0.1]
+    itk_component add resultset {
+        Rappture::ResultSet $f.rset \
+            -clearcommand [itcl::code $this clear] \
+            -settingscommand [itcl::code $this _plot] \
+            -promptcommand [itcl::code $this _simState]
+    }
+    pack $itk_component(resultset) -expand yes -fill both
+    bind $itk_component(resultset) <<Control>> [itcl::code $this _fixSize]
 
     eval itk_initialize $args
+
+    #
+    # Load up tool info on the first page.
+    #
+    $itk_component(toolinfo) tag configure title \
+        -font $itk_option(-boldtextfont)
+
+    set mesg [$tool xml get tool.title]
+    if {"" != $mesg} {
+        $itk_component(toolinfo) insert end $mesg title
+        $itk_component(toolinfo) insert end "\n\n"
+    }
+
+    set mesg [$tool xml get tool.about]
+    if {"" != $mesg} {
+        $itk_component(toolinfo) insert end $mesg
+    }
+    $itk_component(toolinfo) configure -state disabled
+    $itk_component(notebook) current about
+
+    # reset everything to a clean state
     reset
+
+    # tool can run on "manual" (default) or "auto"
+    set cntl [$tool xml get tool.control]
+    if {"" != $cntl} {
+        set _control $cntl
+    }
 }
 
@@ -116 +240 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Analyzer::destructor {} {
-    if {$_run != ""} {
-        itcl::delete object $_run
-    }
-}
-
-# ----------------------------------------------------------------------
-# USAGE: simulate
-#
-# If the simulation page is showing, this kicks off the simulator
-# by executing the tool.command associated with the -tool.  While
-# the simulation is running, it shows status.  When the simulation is
-# finished, it switches automatically to "analyze" mode and shows
-# the results.
-# ----------------------------------------------------------------------
-itcl::body Rappture::Analyzer::simulate {} {
-    if {[$itk_component(notebook) current] == "simulate"} {
-        $itk_component(status) configure -text "Running simulation..."
-        $itk_component(simulate) configure -text "Abort" \
-            -command {set ::Rappture::Analyzer::job(control) abort}
-
-        set job(control) ""
-        set job(error) ""
-
-        # if the hold window is set, then put up a busy cursor
-        if {$itk_option(-holdwindow) != ""} {
-            blt::busy hold $itk_option(-holdwindow)
-            raise $itk_component(hull)
-            update
-        }
-
-        # write out the driver.xml file for the tool
-        set status [catch {
-            set fid [open driver.xml w]
-            puts $fid "<?xml version=\"1.0\"?>"
-            set xml [$itk_option(-tool) xml]
-            if {$itk_option(-device) != ""} {
-                set xml2 [$itk_option(-device) xml]
-                regsub -all {&} $xml2 {\\\&} xml2
-                regsub {</run>} $xml "$xml2</run>" xml
+    foreach obj $_runs {
+        itcl::delete object $obj
+    }
+    after cancel [itcl::code $this simulate]
+}
+
+# ----------------------------------------------------------------------
+# USAGE: simulate ?-ifneeded?
+# USAGE: simulate ?<path1> <value1> <path2> <value2> ...?
+#
+# Kicks off the simulator by executing the tool.command associated
+# with the tool.  If any arguments are specified, they are used to
+# set parameters for the simulation.  While the simulation is running,
+# it shows status.  When the simulation is finished, it switches
+# automatically to "analyze" mode and shows the results.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::simulate {args} {
+    if {$args == "-ifneeded"} {
+        # check to see if simulation is really needed
+        $_tool sync
+        if {[$itk_component(resultset) contains [$_tool xml object]]} {
+            # not needed -- show results and return
+            $itk_component(notebook) current analyze
+            return
+        }
+        set args ""
+    }
+
+    # simulation is needed -- go to simulation page
+    $itk_component(notebook) current simulate
+
+    _simState off
+    $itk_component(runinfo) configure -state normal
+    $itk_component(runinfo) delete 1.0 end
+    $itk_component(runinfo) insert end "Running simulation..."
+    $itk_component(runinfo) configure -state disabled
+
+    # if the hold window is set, then put up a busy cursor
+    if {$itk_option(-holdwindow) != ""} {
+        blt::busy hold $itk_option(-holdwindow)
+        raise $itk_component(hull)
+        update
+    }
+
+    # execute the job
+    foreach {status result} [eval $_tool run $args] break
+
+    # if job was aborted, then allow simulation again
+    if {$result == "ABORT"} {
+        _simState on "Aborted"
+    }
+
+    # read back the results from run.xml
+    if {$status == 0 && $result != "ABORT"} {
+        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
+            set status [catch {load $file} msg]
+            if {$status != 0} {
+                set result $msg
             }
-            puts $fid $xml
-            close $fid
-        } result]
-
-        # execute the tool using the path from the tool description
-        if {$status == 0} {
-            set cmd [$itk_option(-tool) get tool.command]
-
-            set status [catch {eval blt::bgexec \
-                ::Rappture::Analyzer::job(control) \
-                -output ::Rappture::Analyzer::job(output) \
-                -error ::Rappture::Analyzer::job(error) $cmd} result]
-        }
-
-        # read back the results from run.xml
-        if {$status == 0} {
-            set status [catch {load run.xml} result]
-        }
-
-        # back to normal
-        if {$itk_option(-holdwindow) != ""} {
-            blt::busy release $itk_option(-holdwindow)
-        }
-        $itk_component(status) configure -text ""
-        $itk_component(simulate) configure -text "Simulate" \
-            -command [itcl::code $this simulate]
-
-        # if anything went wrong, tell the user; otherwise, analyze
-        if {[regexp {^KILLED} $job(control)]} {
-            # job aborted -- do nothing
-        } elseif {$status != 0} {
-            $itk_component(info) configure -state normal
-            $itk_component(info) delete 1.0 end
-            $itk_component(info) insert end "Problem launching job:\n"
-            if {[string length $job(error)] > 0} {
-                $itk_component(info) insert end $job(error)
-            } else {
-                $itk_component(info) insert end $result
-            }
-            $itk_component(info) configure -state disabled
         } else {
-            $itk_component(notebook) current analyze
-        }
+            set status 1
+            set result "Can't find result file in output:\n\n$result"
+        }
+    }
+
+    # back to normal
+    if {$itk_option(-holdwindow) != ""} {
+        blt::busy release $itk_option(-holdwindow)
+    }
+    $itk_component(abort) configure -state disabled
+
+    if {$status != 0} {
+        $itk_component(runinfo) configure -state normal
+        $itk_component(runinfo) delete 1.0 end
+        $itk_component(runinfo) insert end "Problem launching job:\n\n"
+        $itk_component(runinfo) insert end $result
+        $itk_component(runinfo) configure -state disabled
+    } else {
+        $itk_component(notebook) current analyze
     }
 }
@@ -211 +331 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Analyzer::reset {} {
-    $itk_component(notebook) current simulate
-
-    # if control mode is "auto", then simulate right away
-    if {[string match auto* $_control]} {
-        simulate
+    # check to see if simulation is really needed
+    $_tool sync
+    if {![$itk_component(resultset) contains [$_tool xml object]]} {
+        # if control mode is "auto", then simulate right away
+        if {[string match auto* $_control]} {
+            # auto control -- don't need button
+            pack forget $itk_interior.simol
+
+            after cancel [itcl::code $this simulate]
+            after idle [itcl::code $this simulate]
+        } else {
+            _simState on "new input parameters"
+        }
+    } else {
+        _simState off
     }
 }
@@ -222 +352 @@
 # USAGE: load <file>
 #
-# Used to reset the analyzer whenever the input to a simulation has
-# changed.  Sets the mode back to "simulate", so the user has to
-# simulate again to see the output.
+# Loads the data from the given <file> into the appropriate results
+# sets.  If necessary, new results sets are created to store the data.
 # ----------------------------------------------------------------------
 itcl::body Rappture::Analyzer::load {file} {
-    # clear any old results
-    if {$_run != ""} {
-        itcl::delete object $_run
-        set _run ""
-    }
-
     # try to load new results from the given file
-    set _run [Rappture::library $file]
-
-    # go through the analysis and create widgets to display results
-    foreach item [array names _widgets] {
-        $_widgets($item) configure -output $_run
-    }
+    set xmlobj [Rappture::library $file]
+    lappend _runs $xmlobj
+
+    # go through the analysis and find all result sets
+    set haveresults 0
+    foreach item [_reorder [$xmlobj children output]] {
+        switch -glob -- $item {
+            log* {
+                _autoLabel $xmlobj output.$item "Output Log" counters
+            }
+            curve* - field* {
+                _autoLabel $xmlobj output.$item "Plot" counters
+            }
+            table* {
+                _autoLabel $xmlobj output.$item "Energy Levels" counters
+            }
+        }
+        set label [$xmlobj get output.$item.about.label]
+
+        if {"" != $label} {
+            set haveresults 1
+        }
+    }
+
+    # if there are any valid results, add them to the resultset
+    if {$haveresults} {
+        set size [$itk_component(resultset) size]
+        set op [$itk_component(resultset) add $xmlobj]
+
+        # add each result to a result viewer
+        foreach item [_reorder [$xmlobj children output]] {
+            set label [$xmlobj get output.$item.about.label]
+
+            if {"" != $label} {
+                if {![info exists _label2page($label)]} {
+                    set name "page[incr _pages]"
+                    set page [$itk_component(resultpages) insert end $name]
+                    set _label2page($label) $page
+                    Rappture::ResultViewer $page.rviewer
+                    pack $page.rviewer -expand yes -fill both -pady 4
+
+                    $itk_component(resultselector) choices insert end \
+                        $name $label
+
+                    #
+                    # NOTE:
+                    #
+                    # If this result is showing up late in the game, then
+                    # we must fill the resultviewer with a series of blank
+                    # entries, so the latest result will align with (have
+                    # the same index as) results in all other viewers.
+                    #
+                    for {set i 0} {$i < $size} {incr i} {
+                        $page.rviewer add $xmlobj ""
+                    }
+                }
+
+                # add/replace the latest result into this viewer
+                set page $_label2page($label)
+                eval $page.rviewer $op [list $xmlobj output.$item]
+            }
+        }
+    }
+
+    # if there is only one result page, take down the selector
+    set w [$itk_component(notebook) page analyze]
+    if {[$itk_component(resultselector) choices size] <= 1} {
+        pack forget $w.top
+    } else {
+        pack $w.top -before $itk_component(results) -side top -fill x
+    }
+
+    # show the first page by default
+    set first [$itk_component(resultselector) choices get -label 0]
+    if {$first != ""} {
+        $itk_component(resultpages) current page1
+        $itk_component(resultselector) value $first
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: clear
+#
+# Discards all results previously loaded into the analyzer.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::clear {} {
+    foreach obj $_runs {
+        itcl::delete object $obj
+    }
+    set _runs ""
+
+    foreach label [array names _label2page] {
+        set page $_label2page($label)
+        $page.rviewer clear
+    }
+
+    $itk_component(resultset) clear
+    $itk_component(results) fraction end 0.1
+
+    _simState on
+    _fixSimControl
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _plot ?<index> <options> <index> <options>...?
+#
+# Used internally to update the plot shown in the current result
+# viewer whenever the resultset settings have changed.  Causes the
+# desired results to show up on screen.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::_plot {args} {
+    set _plotlist $args
+
+    set page [$itk_component(resultselector) value]
+    set page [$itk_component(resultselector) translate $page]
+    set f [$itk_component(resultpages) page $page]
+    $f.rviewer plot clear
+    foreach {index opts} $_plotlist {
+        $f.rviewer plot add $index $opts
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _reorder
+#
+# Used internally to change the order of a series of output components
+# found in the <output> section.  Moves the <log> elements to the end
+# and returns the updated list.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::_reorder {comps} {
+    set i 0
+    set max [llength $comps]
+    while {$i < $max} {
+        set c [lindex $comps $i]
+        if {[string match log* $c]} {
+            set comps [lreplace $comps $i $i]
+            lappend comps $c
+            incr max -1
+        } else {
+            incr i
+        }
+    }
+    return $comps
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _autoLabel <xmlobj> <path> <title> <cntVar>
+#
+# Used internally to check for an about.label property at the <path>
+# in <xmlobj>.  If this object doesn't have a label, then one is
+# supplied using the given <title>.  The <cntVar> is an array of
+# counters in the calling scopes for titles that have been used
+# in the past.  This is used to create titles like "Plot #2" the
+# second time it is encountered.
+#
+# The <xmlobj> is updated so that the label is inserted directly in
+# the tree.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::_autoLabel {xmlobj path title cntVar} {
+    upvar $cntVar counters
+
+    set label [$xmlobj get $path.about.label]
+    if {"" == $label} {
+        # no label -- make one up using the title specified
+        if {![info exists counters($title)]} {
+            set counters($title) 1
+            set label $title
+        } else {
+            set label "$title #[incr counters($title)]"
+        }
+        $xmlobj put $path.about.label $label
+    } else {
+        # handle the case of two identical labels in <output>
+        if {![info exists counters($label)]} {
+            set counters($label) 1
+        } else {
+            set label "$label #[incr counters($label)]"
+            $xmlobj put $path.about.label $label
+        }
+    }
+    return $label
 }
 
@@ -251 +549 @@
     set page [$itk_component(resultselector) value]
     set page [$itk_component(resultselector) translate $page]
-    $itk_component(results) current $page
-}
-
-# ----------------------------------------------------------------------
-# CONFIGURATION OPTION: -tool
-#
-# Set to the Rappture::library object representing the tool being
-# run in this analyzer.
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::Analyzer::tool {
-    if {![Rappture::library isvalid $itk_option(-tool)]} {
-        error "bad value \"$itk_option(-tool)\": should be Rappture::library"
-    }
-
-    $itk_component(info) configure -state normal
-    $itk_component(info) delete 1.0 end
-    $itk_component(info) insert end [$itk_option(-tool) get tool.about]
-    $itk_component(info) configure -state disabled
-}
-
-# ----------------------------------------------------------------------
-# CONFIGURATION OPTION: -device
-#
-# Set to the Rappture::library object representing the device being
-# run in this analyzer.
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::Analyzer::device {
-    if {$itk_option(-device) != ""
-          && ![Rappture::library isvalid $itk_option(-device)]} {
-        error "bad value \"$itk_option(-device)\": should be Rappture::library"
-    }
-    reset
-}
-
-# ----------------------------------------------------------------------
-# CONFIGURATION OPTION: -analysis
-#
-# Set to the Rappture::library object representing the analysis that
-# should be shown in this analyzer.
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::Analyzer::analysis {
-    if {![Rappture::library isvalid $itk_option(-analysis)]} {
-        error "bad value \"$itk_option(-analysis)\": should be Rappture::library"
-    }
-    set _control [$itk_option(-analysis) get control]
-
-    # go through the analysis and create widgets to display results
-    $itk_component(results) delete -all
-    catch {unset _widgets}
-
-    set counter 0
-    foreach item [$itk_option(-analysis) children] {
-        switch -glob -- $item {
-            xyplot* {
-                set name "page[incr counter]"
-                set label [$itk_option(-analysis) get $item.label]
-                if {$label == ""} { set label $name }
-
-                set page [$itk_component(results) insert end $name]
-                $itk_component(resultselector) choices insert end \
-                    $name $label
-
-                set _widgets($item) [Rappture::Xyplot $page.#auto \
-                    -layout [$itk_option(-analysis) element -flavor object $item]]
-                pack $_widgets($item) -expand yes -fill both
+    $itk_component(resultpages) current $page
+
+    set f [$itk_component(resultpages) page $page]
+    $f.rviewer plot clear
+    eval $f.rviewer plot add $_plotlist
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _fixSize
+#
+# Used internally to change the size of the result set area whenever
+# a new control appears.  Adjusts the size available for the result
+# set up to some maximum.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::_fixSize {} {
+    set f [$itk_component(results) fraction end]
+    if {$f < 0.4} {
+        $itk_component(results) fraction end [expr {$f+0.15}]
+    }
+    _fixSimControl
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _simState <boolean> ?<message>? ?<settings>?
+#
+# Used internally to change the "Simulation" button on or off.
+# If the <boolean> is on, then any <message> and <settings> are
+# displayed as well.  The <message> is a note to the user about
+# what will be simulated, and the <settings> are a list of
+# tool parameter settings of the form {path1 val1 path2 val2 ...}.
+# When these are in place, the next Simulate operation will use
+# these settings.  This helps fill in missing data values.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::_simState {state args} {
+    if {$state} {
+        $itk_interior.simol configure \
+            -background $itk_option(-simcontrolactiveoutline)
+        $itk_interior.simol.simbg configure \
+            -background $itk_option(-simcontrolactivebackground)
+        $itk_component(simulate) configure \
+            -highlightbackground $itk_option(-simcontrolactivebackground)
+        $itk_component(simstatus) configure \
+            -background $itk_option(-simcontrolactivebackground)
+
+        $itk_component(abort) configure -state disabled
+        $itk_component(simulate) configure -state normal \
+            -command [itcl::code $this simulate]
+
+        #
+        # If there's a special message, then put it up next to the button.
+        #
+        set mesg [lindex $args 0]
+        if {"" != $mesg} {
+            $itk_component(simstatus) configure -state normal
+            $itk_component(simstatus) delete 1.0 end
+            $itk_component(simstatus) insert end $mesg
+
+            #
+            # If there are any settings, then install them in the
+            # "Simulate" button.  Also, pop them up as a tooltip
+            # for the message.
+            #
+            set settings [lindex $args 1]
+            if {[llength $settings] > 0} {
+                $itk_component(simulate) configure \
+                    -command [eval itcl::code $this simulate $settings]
+
+                set details ""
+                foreach {path val} $settings {
+                    set str [$_tool xml get $path.about.label]
+                    if {"" == $str} {
+                        set str [$_tool xml element -as id $path]
+                    }
+                    append details "$str = $val\n"
+                }
+                set details [string trim $details]
+
+                Rappture::Tooltip::for $itk_component(simstatus) $details
+                $itk_component(simstatus) insert end " "
+                $itk_component(simstatus) insert end "(details...)" popup
             }
-            elevels* {
-                set name "page[incr counter]"
-
-                set page [$itk_component(results) insert end $name]
-                $itk_component(resultselector) choices insert end \
-                    $name "Energy Levels"
-
-                set _widgets($item) [Rappture::EnergyLevels $page.#auto \
-                    -layout [$itk_option(-analysis) element -flavor object $item]]
-                pack $_widgets($item) -expand yes -fill both
+            $itk_component(simstatus) configure -state disabled
+        }
+    } else {
+        if {"" != $itk_option(-simcontrolbackground)} {
+            set simcbg $itk_option(-simcontrolbackground)
+        } else {
+            set simcbg $itk_option(-background)
+        }
+        $itk_interior.simol configure \
+            -background $itk_option(-simcontroloutline)
+        $itk_interior.simol.simbg configure -background $simcbg
+        $itk_component(simulate) configure -highlightbackground $simcbg
+        $itk_component(simstatus) configure -background $simcbg
+
+        $itk_component(simulate) configure -state disabled
+        $itk_component(abort) configure -state normal
+
+        $itk_component(simstatus) configure -state normal
+        $itk_component(simstatus) delete 1.0 end
+        $itk_component(simstatus) configure -state disabled
+        Rappture::Tooltip::for $itk_component(simstatus) ""
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _fixSimControl
+#
+# Used internally to add or remove the simulation control at the
+# top of the analysis area.  This is controlled by the -simcontrol
+# option.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Analyzer::_fixSimControl {} {
+    switch -- $itk_option(-simcontrol) {
+        on {
+            pack $itk_interior.simol -fill x -before $itk_interior.nb
+        }
+        off {
+            pack forget $itk_interior.simol
+        }
+        auto {
+            #
+            # If we have two or more radiodials, then there is a
+            # chance of encountering a combination of parameters
+            # with no data, requiring simulation.
+            #
+            if {[$itk_component(resultset) size -controls] >= 2} {
+                pack $itk_interior.simol -fill x -before $itk_interior.nb
+            } else {
+                pack forget $itk_interior.simol
             }
         }
-    }
-
-    # if there is only one page, take down the selector
-    if {[$itk_component(resultselector) choices size] <= 1} {
-        pack forget $itk_component(resultselector)
-    } else {
-        pack $itk_component(resultselector) -before $itk_component(results) \
-            -side top -fill x -padx {20 2}
-    }
-
-    # show the first page by default
-    set first [$itk_component(resultselector) choices get -label 0]
-    if {$first != ""} {
-        $itk_component(results) current page1
-        $itk_component(resultselector) value $first
-    }
-}
+        default {
+            error "bad value \"$itk_option(-simcontrol)\": should be on, off, auto"
+        }
+    }
+}
+
+# ----------------------------------------------------------------------
+# CONFIGURATION OPTION: -simcontrol
+#
+# Controls whether or not the Simulate button is showing.  In some
+# cases, it is not needed.
+# ----------------------------------------------------------------------
+itcl::configbody Rappture::Analyzer::simcontrol {
+    _fixSimControl
+}

trunk/gui/scripts/animover.tcl

@@ -7 +7 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk

trunk/gui/scripts/combobox.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -121 +122 @@
         }
 
-        event generate $itk_component(hull) <<Value>>
+        after 10 [list event generate $itk_component(hull) <<Value>>]
     } elseif {[llength $args] != 0} {
         error "wrong # args: should be \"value ?newval?\""

trunk/gui/scripts/curve.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itcl
@@ -17 +18 @@
 
 itcl::class Rappture::Curve {
-    constructor {libobj path} { # defined below }
+    constructor {xmlobj path} { # defined below }
     destructor { # defined below }
 
     public method components {{pattern *}}
-    public method vectors {{what -overall}}
-    public method controls {option args}
+    public method mesh {{what -overall}}
+    public method values {{what -overall}}
+    public method limits {which}
     public method hints {{key ""}}
 
     protected method _build {}
 
-    private variable _libobj ""  ;# ref to lib obj with curve data
+    private variable _xmlobj ""  ;# ref to lib obj with curve data
     private variable _curve ""   ;# lib obj representing this curve
-    private variable _comp2vecs  ;# maps component name => x,y vectors
+    private variable _comp2xy    ;# maps component name => x,y vectors
 
     private common _counter 0    ;# counter for unique vector names
@@ -37 +39 @@
 # CONSTRUCTOR
 # ----------------------------------------------------------------------
-itcl::body Rappture::Curve::constructor {libobj path} {
-    if {![Rappture::library isvalid $libobj]} {
-        error "bad value \"$libobj\": should be LibraryObj"
-    }
-    set _libobj $libobj
-    set _curve [$libobj element -flavor object $path]
+itcl::body Rappture::Curve::constructor {xmlobj path} {
+    if {![Rappture::library isvalid $xmlobj]} {
+        error "bad value \"$xmlobj\": should be LibraryObj"
+    }
+    set _xmlobj $xmlobj
+    set _curve [$xmlobj element -as object $path]
 
     # build up vectors for various components of the curve
@@ -53 +55 @@
 itcl::body Rappture::Curve::destructor {} {
     itcl::delete object $_curve
-    # don't destroy the _libobj! we don't own it!
-
-    foreach name [array names _comp2vecs] {
-        eval blt::vector destroy $_comp2vecs($name)
+    # don't destroy the _xmlobj! we don't own it!
+
+    foreach name [array names _comp2xy] {
+        eval blt::vector destroy $_comp2xy($name)
     }
 }
@@ -69 +71 @@
 itcl::body Rappture::Curve::components {{pattern *}} {
     set rlist ""
-    foreach name [array names _comp2vecs] {
+    foreach name [array names _comp2xy] {
         if {[string match $pattern $name]} {
             lappend rlist $name
@@ -78 +80 @@
 
 # ----------------------------------------------------------------------
-# USAGE: vectors ?<name>?
-#
-# Returns a list {xvec yvec} for the specified curve component <name>.
+# USAGE: mesh ?<name>?
+#
+# Returns the xvec for the specified curve component <name>.
 # If the name is not specified, then it returns the vectors for the
 # overall curve (sum of all components).
 # ----------------------------------------------------------------------
-itcl::body Rappture::Curve::vectors {{what -overall}} {
-    if {[info exists _comp2vecs($what)]} {
-        return $_comp2vecs($what)
-    }
-    error "bad option \"$what\": should be [join [lsort [array names _comp2vecs]] {, }]"
+itcl::body Rappture::Curve::mesh {{what -overall}} {
+    if {[info exists _comp2xy($what)]} {
+        return [lindex $_comp2xy($what) 0]  ;# return xv
+    }
+    error "bad option \"$what\": should be [join [lsort [array names _comp2xy]] {, }]"
+}
+
+# ----------------------------------------------------------------------
+# USAGE: values ?<name>?
+#
+# Returns the xvec for the specified curve component <name>.
+# If the name is not specified, then it returns the vectors for the
+# overall curve (sum of all components).
+# ----------------------------------------------------------------------
+itcl::body Rappture::Curve::values {{what -overall}} {
+    if {[info exists _comp2xy($what)]} {
+        return [lindex $_comp2xy($what) 1]  ;# return yv
+    }
+    error "bad option \"$what\": should be [join [lsort [array names _comp2xy]] {, }]"
+}
+
+# ----------------------------------------------------------------------
+# USAGE: limits x|y
+#
+# Returns the {min max} limits for the specified axis.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Curve::limits {which} {
+    set min ""
+    set max ""
+    switch -- $which {
+        x { set pos 0 }
+        y { set pos 1 }
+        default {
+            error "bad option \"$which\": should be x or y"
+        }
+    }
+    foreach comp [array names _comp2xy] {
+        set vname [lindex $_comp2xy($comp) $pos]
+        $vname variable vec
+        if {"" == $min} {
+            set min $vec(min)
+        } elseif {$vec(min) < $min} {
+            set min $vec(min)
+        }
+        if {"" == $max} {
+            set max $vec(max)
+        } elseif {$vec(max) > $max} {
+            set max $vec(max)
+        }
+    }
+    return [list $min $max]
 }
 
@@ -116 +164 @@
     }
 
+    if {[info exists hints(xlabel)] && "" != $hints(xlabel)
+          && [info exists hints(xunits)] && "" != $hints(xunits)} {
+        set hints(xlabel) "$hints(xlabel) ($hints(xunits))"
+    }
+    if {[info exists hints(ylabel)] && "" != $hints(ylabel)
+          && [info exists hints(yunits)] && "" != $hints(yunits)} {
+        set hints(ylabel) "$hints(ylabel) ($hints(yunits))"
+    }
+
     if {$keyword != ""} {
         if {[info exists hints($keyword)]} {
@@ -135 +192 @@
 itcl::body Rappture::Curve::_build {} {
     # discard any existing data
-    foreach name [array names _comp2vecs] {
-        eval blt::vector destroy $_comp2vecs($name)
-    }
-    catch {unset _comp2vecs}
+    foreach name [array names _comp2xy] {
+        eval blt::vector destroy $_comp2xy($name)
+    }
+    catch {unset _comp2xy}
 
     #
@@ -162 +219 @@
 
         if {$xv != "" && $yv != ""} {
-            set _comp2vecs($cname) [list $xv $yv]
+            set _comp2xy($cname) [list $xv $yv]
             incr _counter
         }

trunk/gui/scripts/deviceLayout1D.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -25 +26 @@
 
     itk_option define -font font Font ""
-    itk_option define -library library Library ""
     itk_option define -device device Device ""
     itk_option define -devicesize deviceSize DeviceSize 0
@@ -40 +40 @@
     protected method _redraw {}
     protected method _drawLayer {index x0 x1}
-    protected method _drawMolecule {index x0 x1}
+    protected method _drawIcon {index x0 x1 imh}
     protected method _drawAnnotation {index x0 x1}
     protected method _mater2color {mater}
@@ -47 +47 @@
     private variable _sizes         ;# maps size name => pixels
 
-    private variable _library ""    ;# LibraryObj for library information
     private variable _device ""     ;# LibraryObj for device representation
     private variable _slabs ""      ;# list of node names for slabs in device
     private variable _z0 ""         ;# list parallel to _slabs with z0
                                     ;#   coord for lhs of each slab
-    private variable _zthick ""     ;# list parallel to _slabs with thickness
-                                    ;#   for each slab
+    private variable _z1 ""         ;# list parallel to _slabs with z1
+                                    ;#   coord for rhs of each slab
     private variable _maters ""     ;# list parallel to _slabs with material
                                     ;#   for each slab
+    private variable _colors ""     ;# list parallel to _slabs with color
+                                    ;#   for each slab
 
     private variable _controls      ;# maps control path => status on/off
 
-    private common _icons
-    set _icons(molecule) [image create photo -file \
-        [file join $Rappture::installdir scripts images molecule.gif]]
+    private variable _icons         ;# maps icon data => image handle
 }
                                                                                 
 itk::usual DeviceLayout1D {
     keep -background -cursor
-    keep -library -device
-    keep -deviceoutline -devicesize
+    keep -device -deviceoutline -devicesize
     keep -selectbackground -selectforeground -selectborderwidth
     keep -width
@@ -112 +110 @@
     }
     set zmin [lindex $_z0 0]
-    set zmax [lindex $_z0 end]
+    set zmax [lindex $_z1 end]
     return [list $zmin $zmax]
 }
@@ -166 +164 @@
 itcl::body Rappture::DeviceLayout1D::_layout {} {
     # first, recompute the overall height of this widget
-    set h [expr {$_sizes(bar)+$_sizes(bar45)+20}]
+    set h [expr {$_sizes(bar)+$_sizes(bar45)+2}]
 
     set fnt $itk_option(-font)
-    if {[regexp {\.material} [array names _controls]]} {
-        # one of the slabs has its material displayed
-        set extra [expr {1.2*[font metrics $fnt -linespace]}] 
-        set h [expr {$h+$extra}]
-    }
-    if {[regexp {\.thickness} [array names _controls]]} {
-        # one of the slabs has its thickness displayed
-        set extra [expr {1.2*[font metrics $fnt -linespace]}] 
-        set h [expr {$h+$extra}]
+    # see if any of the slabs has a material
+    foreach m $_maters {
+        if {"" != $m} {
+            set extra [expr {1.5*[font metrics $fnt -linespace]}] 
+            set h [expr {$h+$extra}]
+            break
+        }
     }
 
@@ -191 +187 @@
     }
 
-    # a little extra height for the molecule image
-    if {"" != [$_device element components.molecule]} {
-        set h [expr {$h+15}]
-    }
-
     set oldh [component hull cget -height]
     if {$h != $oldh} {
@@ -205 +196 @@
     set slabs ""
     set z0 ""
-    set zthick ""
+    set z1 ""
     set maters ""
-
-    set z 0
+    set colors ""
+
     if {$_device != ""} {
+        # get the default system of units
+        set units [set defunits [$_device get units]]
+        if {$units == "arbitrary"} {
+            set defunits "m"
+            set units "um"
+        }
+
         foreach nn [$_device children components] {
             switch -glob -- $nn {
-                slab* - molecule* {
-                    set tval [$_device get components.$nn.thickness]
-                    set tval [Rappture::Units::convert $tval \
-                        -context um -to um -units off]
+                box* {
+                    # get x-coord for each corner
+                    set c0 [lindex [$_device get components.$nn.corner0] 0]
+                    set c0 [Rappture::Units::convert $c0 \
+                        -context $defunits -to $units -units off]
+
+                    set c1 [lindex [$_device get components.$nn.corner1] 0]
+                    set c1 [Rappture::Units::convert $c1 \
+                        -context $defunits -to $units -units off]
+
                     lappend slabs components.$nn
-                    lappend z0 $z
-                    lappend zthick $tval
-                    lappend maters [$_device get components.$nn.material]
-
-                    set z [expr {$z+$tval}]
+                    lappend z0 $c0
+                    lappend z1 $c1
+
+                    set m [$_device get components.$nn.material]
+                    lappend maters $m
+
+                    if {"" != $m} {
+                        set c [_mater2color $m]
+                    } else {
+                        set c [$_device get components.$nn.about.color]
+                    }
+                    if {"" == $c} { set c gray }
+                    lappend colors $c
                 }
                 default {
@@ -229 +241 @@
         }
     }
-    lappend z0 $z
 
     # something change? then store new layout and redraw
     if {![string equal $z0 $_z0]
-          || ![string equal $zthick $_zthick]
-          || ![string equal $maters $_maters]} {
+          || ![string equal $z1 $_z1]
+          || ![string equal $maters $_maters]
+          || ![string equal $colors $_colors]} {
         set _slabs $slabs
         set _z0 $z0
-        set _zthick $zthick
+        set _z1 $z1
         set _maters $maters
+        set _colors $colors
 
         $_dispatcher event -idle !redraw
@@ -254 +267 @@
 
     # clean up images and delete all other items
-    foreach item [$c find withtag image] {
-        image delete [$c itemcget $item -image]
-    }
     $c delete all
 
@@ -264 +274 @@
     set x1 [expr {$x0 + $w}]
 
-    set zmax [lindex $_z0 end]
+    set zmax [lindex $_z1 end]
     set xx0 $x0
     set xx1 $x1
 
-    set drewslab 0
     for {set i 0} {$i < [llength $_slabs]} {incr i} {
         set name [lindex $_slabs $i]
-        if {[regexp {slab[0-9]*$} $name]} {
-            set z0 [lindex $_z0 $i]
-            set zthick [lindex $_zthick $i]
-            set xx0 [expr {double($z0)/$zmax * ($x1-$x0) + $x0}]
-            set xx1 [expr {double($z0+$zthick)/$zmax * ($x1-$x0) + $x0}]
+        set z0 [lindex $_z0 $i]
+        set z1 [lindex $_z1 $i]
+        set xx0 [expr {double($z0)/$zmax * ($x1-$x0) + $x0}]
+        set xx1 [expr {double($z1)/$zmax * ($x1-$x0) + $x0}]
+
+        set icon [$_device get $name.about.icon]
+        if {"" != $icon} {
+            if {[info exists _icons($icon)]} {
+                set imh $_icons($icon)
+            } else {
+                set imh [image create photo -data $icon]
+                set _icons($icon) $imh
+            }
+            _drawIcon $i $xx0 $xx1 $imh
+        } else {
             _drawLayer $i $xx0 $xx1
-            _drawAnnotation $i $xx0 $xx1
-            set drewslab 1
-        } else {
-            if {$drewslab} {
-                _drawLayer cap $xx0 $xx1  ;# draw the end cap
-                set drewslab 0
-            }
-            if {[regexp {molecule[0-9]*$} $name]} {
-                set z0 [lindex $_z0 $i]
-                set zthick [lindex $_zthick $i]
-                set xx0 [expr {double($z0)/$zmax * ($x1-$x0) + $x0}]
-                set xx1 [expr {double($z0+$zthick)/$zmax * ($x1-$x0) + $x0}]
-                _drawMolecule $i $xx0 $xx1
-                _drawAnnotation $i $xx0 $xx1
-            }
-        }
-    }
-    if {[llength $_slabs] > 0} {
-        _drawLayer cap $xx0 $xx1  ;# draw the end cap
+        }
+        _drawAnnotation $i $xx0 $xx1
     }
 }
@@ -309 +311 @@
     set c $itk_component(area)
     set h [expr {[winfo height $c]-1}]
-    # a little extra height for the molecule image
-    if {"" != [$_device element components.molecule]} {
-        set h [expr {$h-15}]
-    }
 
     set y0 $h
@@ -324 +322 @@
     set lcolor $itk_option(-deviceoutline)
 
-    if {$index == "cap"} {
-        #
-        # Draw the outline around the end cap
-        #
-        $c create line $x1 $y0  $x1 $y1p  $x1p $y1 -fill $lcolor
-
-    } elseif {$index < [llength $_slabs]} {
-        set fcolor [_mater2color [lindex $_maters $index]]
+    if {$index < [llength $_slabs]} {
+        set fcolor [lindex $_colors $index]
 
         #
@@ -347 +339 @@
             -outline $lcolor -fill $fcolor
         $c create line $x0 $y1p  $x1 $y1p -fill $lcolor
-    }
-}
-
-# ----------------------------------------------------------------------
-# USAGE: _drawMolecule <index> <x0> <x1>
-#
-# Used internally within _redraw to draw one molecule layer at the
-# <index> within the slab list into the active area.  The layer is
-# drawn between coordinates <x0> and <x1> on the canvas.
-# ----------------------------------------------------------------------
-itcl::body Rappture::DeviceLayout1D::_drawMolecule {index x0 x1} {
+
+        #
+        # Draw the outline around the end cap
+        #
+        $c create line $x1 $y0  $x1 $y1p  $x1p $y1 -fill $lcolor
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _drawIcon <index> <x0> <x1> <imh>
+#
+# Used internally within _redraw to draw a material layer that is
+# represented by an icon.  The layer sits at <index> within the slab
+# list into the active area.  The layer is drawn between coordinates
+# <x0> and <x1> on the canvas.
+# ----------------------------------------------------------------------
+itcl::body Rappture::DeviceLayout1D::_drawIcon {index x0 x1 imh} {
     set c $itk_component(area)
     set h [expr {[winfo height $c]-1}]
-    # a little extra height for the molecule image
-    if {"" != [$_device element components.molecule]} {
-        set h [expr {$h-15}]
-    }
 
     set y0 $h
@@ -370 +364 @@
     set y1 [expr {$y1p-$_sizes(bar45)}]
     set x0p [expr {$x0+$_sizes(bar45)}]
-
-    set x [expr {0.5*($x0+$x0p)}]
+    set x1p [expr {$x1+$_sizes(bar45)}]
+
+    set xx0 [expr {0.5*($x0+$x0p)}]
+    set xx1 [expr {0.5*($x1+$x1p)}]
     set y [expr {0.5*($y0+$y0p) + 0.5*($y1-$y0p)}]
 
-    set w [image width $_icons(molecule)]
-    set h [image height $_icons(molecule)]
-    set dx [expr {round($x1-$x0)}]
-    set dy [expr {round(double($x1-$x0)/$w*$h)}]
-    set imh [image create photo -width $dx -height $dy]
-    blt::winop resample $_icons(molecule) $imh
-
-    $c create image $x $y -anchor w -image $imh -tags image
+    ##set lcolor $itk_option(-deviceoutline)
+    ##$c create line $xx0 $y $xx1 $y -width 3
+
+    $c create image [expr {0.5*($xx0+$xx1)}] $y -anchor c -image $imh
 }
 
@@ -394 +386 @@
     set c $itk_component(area)
     set h [expr {[winfo height $c]-1}]
-    # a little extra height for the molecule image
-    if {"" != [$_device element components.molecule]} {
-        set h [expr {$h-15}]
-    }
 
     set y0 $h
@@ -409 +397 @@
     set lh [font metrics $fnt -linespace]
     set ymid [expr {$y1-2-0.5*$lh}]
-    set y [expr {$y1-2}]
-
-    #
-    # If there's a .thickness control for this slab, draw it here.
-    #
-    set elem [lindex $_slabs $index]
-    set path "structure.$elem.thickness"
-    if {[info exists _controls($path)] && $_controls($path)} {
-        set zthick [lindex $_zthick $index]
-        set zthick [Rappture::Units::convert $zthick -context um -to um]
-
-        $c create line $x0p $y $x0p [expr {$y-$lh}]
-        $c create line $x1p $y $x1p [expr {$y-$lh}]
-
-        $c create line $x0p $ymid $x1p $ymid -arrow both
-        $c create text $xmid [expr {$ymid-2}] -anchor s -text $zthick
-        set y [expr {$y-2.0*$lh}]
-    }
+    set y [expr {$y1-4}]
 
     #
@@ -432 +403 @@
     #
     set elem [lindex $_slabs $index]
-    set path "structure.$elem.material"
-    if {[info exists _controls($path)] && $_controls($path)} {
-        set mater [lindex $_maters $index]
-        set w [expr {12+[font measure $fnt $mater]}]
-        set x [expr {$x1p - 0.5*($x1p-$x0p-$w)}]
-        $c create rectangle [expr {$x-10}] [expr {$y-10}] \
-            $x $y -outline black -fill [_mater2color $mater]
-        $c create text [expr {$x-12}] [expr {$y-5}] -anchor e \
+    set mater [lindex $_maters $index]
+    if {"" != $mater} {
+        set x $x1p
+        $c create rectangle [expr {$x-10}] [expr {$y-14}] \
+            [expr {$x-0}] [expr {$y-4}] \
+            -outline black -fill [_mater2color $mater]
+        set x [expr {$x-12}]
+        $c create text $x [expr {$y-7}] -anchor e \
             -text $mater
-        set y [expr {$y-1.2*$lh}]
+        set y [expr {$y-1.5*$lh}]
     }
 
@@ -450 +421 @@
         set label [$_device get $elem.about.label]
         if {"" != $label} {
-            set y [expr {$y-0.5*$lh}]
             $c create text [expr {0.5*($x0p+$x1p)}] $y -anchor s \
                 -text $label
@@ -464 +434 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::DeviceLayout1D::_mater2color {mater} {
-    if {$_library != ""} {
-        set color [$_library get materials.($mater).color]
-        if {$color != ""} {
-            return $color
-        }
+    set lib [Rappture::library standard]
+    set color [$lib get materials.($mater).color]
+    if {$color != ""} {
+        return $color
     }
     return gray
@@ -481 +450 @@
 itcl::configbody Rappture::DeviceLayout1D::font {
     $_dispatcher event -idle !layout
-}
-
-# ----------------------------------------------------------------------
-# CONFIGURATION OPTION: -library
-#
-# Set to the Rappture::Library object representing the library with
-# material properties and other info.
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::DeviceLayout1D::library {
-    if {$itk_option(-library) != ""} {
-        if {![Rappture::library isvalid $itk_option(-library)]} {
-            error "bad value \"$itk_option(-library)\": should be Rappture::Library"
-        }
-    }
-    set _library $itk_option(-library)
-    $_dispatcher event -idle !redraw
 }
 

trunk/gui/scripts/deviceViewer1D.tcl

@@ -10 +10 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -25 +26 @@
 
     itk_option define -device device Device ""
-    itk_option define -tool tool Tool ""
-
-    constructor {args} { # defined below }
+
+    constructor {tool args} { # defined below }
     destructor { # defined below }
 
     public method controls {option args}
                                                                                 
-    protected method _fixTabs {}
+    protected method _loadDevice {}
     protected method _changeTabs {}
     protected method _fixAxes {}
@@ -42 +42 @@
     protected method _controlSet {widget libObj path}
 
-    private variable _device ""     ;# LibraryObj for device rep
-    private variable _tool ""       ;# LibraryObj for tool parameters
+    private variable _tool ""       ;# tool controlling this viewer
+    private variable _device ""     ;# XML library with <structure>
     private variable _tab2fields    ;# maps tab name => list of fields
+    private variable _field2parm    ;# maps field path => parameter name
     private variable _units ""      ;# units for field being edited
     private variable _restrict ""   ;# restriction expr for field being edited
@@ -56 +57 @@
 # CONSTRUCTOR
 # ----------------------------------------------------------------------
-itcl::body Rappture::DeviceViewer1D::constructor {args} {
+itcl::body Rappture::DeviceViewer1D::constructor {tool args} {
+    set _tool $tool
+
     itk_option add hull.width hull.height
     pack propagate $itk_component(hull) no
@@ -79 +82 @@
     }
 
-    itk_component add ambient {
-        frame $itk_component(inner).ambient
-    }
-    pack $itk_component(ambient) -side top -fill x
+    itk_component add top {
+        frame $itk_component(inner).top
+    }
+    pack $itk_component(top) -fill x
 
     itk_component add layout {
@@ -101 +104 @@
     bind $itk_component(graph) <Configure> "
         after cancel [itcl::code $this _fixAxes]
-        after idle [itcl::code $this _fixAxes]
+        after 100 [itcl::code $this _fixAxes]
     "
 
@@ -132 +135 @@
 
 # ----------------------------------------------------------------------
-# USAGE: controls add <parameter>
-# USAGE: controls remove <parameter>|all
+# USAGE: controls insert <pos> <xmlobj> <path>
 #
 # Clients use this to add a control to the internal panels of this
-# widget.  If the <parameter> is ambient*, then the control is added
-# to the top, so it goes along with the layout of the device.  If
-# it is structure.fields.field*, then it goes in one of the field
-# panels.
+# widget.  Such controls are usually placed at the top of the widget,
+# but if possible, they are integrated directly onto the device
+# layout or the field area.
 # ----------------------------------------------------------------------
 itcl::body Rappture::DeviceViewer1D::controls {option args} {
     switch -- $option {
-        add {
-            if {[llength $args] != 1} {
-                error "wrong # args: should be \"controls add parameter\""
-            }
-            set path [lindex $args 0]
-            if {[string match structure.fields.field* $path]} {
+        insert {
+            if {[llength $args] != 3} {
+                error "wrong # args: should be \"controls insert pos xmlobj path\""
+            }
+            set pos [lindex $args 0]
+            set xmlobj [lindex $args 1]
+            set path [lindex $args 2]
+            if {[string match *structure.parameters* $path]} {
             } elseif {[string match structure.components* $path]} {
-                $itk_component(layout) controls add $path
-            } else {
-                _controlCreate $itk_component(ambient) $_tool $path
-            }
-        }
-        remove {
-            error "not yet implemented"
+                $itk_component(layout) controls insert $pos $xmlobj $path
+            }
         }
         default {
-            error "bad option \"$option\": should be add or remove"
-        }
-    }
-}
-
-# ----------------------------------------------------------------------
-# USAGE: _fixTabs
+            error "bad option \"$option\": should be insert"
+        }
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _loadDevice
 #
 # Used internally to search for fields and create corresponding
 # tabs whenever a device is installed into this viewer.
-#
-# If there are no tabs, then the widget is packed so that it appears
-# directly.  Otherwise, the interior reconfigured and assigned to
-# the current tab.
-# ----------------------------------------------------------------------
-itcl::body Rappture::DeviceViewer1D::_fixTabs {} {
+# ----------------------------------------------------------------------
+itcl::body Rappture::DeviceViewer1D::_loadDevice {} {
     #
     # Release any info left over from the last device.
@@ -182 +176 @@
     }
     catch {unset _tab2fields}
+    catch {unset _field2parm}
 
     #
@@ -189 +184 @@
     if {$_device != ""} {
         foreach nn [$_device children fields] {
-            if {[string match field* $nn]} {
-                set name [$_device get $nn.label]
-                if {$name == ""} {
-                    set name $nn
-                }
-
-                set fobj [Rappture::Field ::#auto $_device $_device $nn]
-                lappend _tab2fields($name) $fobj
-            }
+            set name [$_device get fields.$nn.about.label]
+            if {$name == ""} {
+                set name $nn
+            }
+
+            set fobj [Rappture::Field ::#auto $_device fields.$nn]
+            lappend _tab2fields($name) $fobj
         }
     }
@@ -207 +200 @@
 
     if {[llength $tabs] <= 0} {
+        #
+        # == DEPRECATED FUNCTIONALITY ==
+        # (I like the look of the tab, even if there's only one)
         #
         # No fields or one field?  Then we don't need to bother
@@ -234 +230 @@
         $itk_component(tabs) select 0
     }
+
+    #
+    # Scan through and look for any parameters in the <structure>.
+    # Register any parameters associated with fields, so we can
+    # add them as active controls whenever we install new fields.
+    # Create controls for any remaining parameters, so the user
+    # can see that there's something to adjust.
+    #
+    if {$_device != ""} {
+        foreach cname [$_device children parameters] {
+            set handled 0
+            if {[$_device element -as type parameters.$cname] == "number"} {
+                set name [$_device element -as id parameters.$cname]
+
+                # look for a field that uses this parameter
+                set found ""
+                foreach fname [$_device children fields] {
+                    foreach comp [$_device children fields.$fname] {
+                        set v [$_device get fields.$fname.$comp.constant]
+                        if {[string equal $v $name]} {
+                            set found "fields.$fname.$comp"
+                            break
+                        }
+                    }
+                    if {"" != $found} break
+                }
+
+                if {"" != $found} {
+                    set _field2parm($found) $name
+                    set handled 1
+                }
+            }
+
+            #
+            # Any parameter that was not handled above should be handled
+            # here, by adding it to a control panel above the device
+            # layout area.
+            #
+            if {!$handled} {
+                set t $itk_component(top)
+                if {![winfo exists $t.cntls]} {
+                    Rappture::Controls $t.cntls $_tool
+                    pack $t.cntls -expand yes -fill both
+                }
+                $t.cntls insert end $_device parameters.$cname
+            }
+        }
+    }
+
+    #
+    # Install the first tab
+    #
     _changeTabs
 
@@ -273 +321 @@
 
     foreach {zmin zmax} [$itk_component(layout) limits] { break }
-    if {$zmax > $zmin} {
-        $graph axis configure x -min $zmin -max $zmax -title "Position (um)"
+    if {$_device != ""} {
+        set units [$_device get units]
+        if {$units != "arbitrary" && $zmax > $zmin} {
+            $graph axis configure x -hide no -min $zmin -max $zmax \
+                -title "Position ($units)"
+        } else {
+            $graph axis configure x -hide yes
+        }
+    } else {
+        $graph axis configure x -hide no -min $zmin -max $zmax \
+            -title "Position"
     }
 
@@ -312 +369 @@
 
         foreach comp [$fobj components] {
+            # can only handle 1D meshes here
+            if {[$fobj components -dimensions $comp] != "1D"} {
+                continue
+            }
+
             set elem "elem[incr n]"
-            foreach {xv yv} [$fobj vectors $comp] { break }
-            $graph element create $elem -x $xv -y $yv -symbol "" -linewidth 2
+            set xv [$fobj mesh $comp]
+            set yv [$fobj values $comp]
+
+            $graph element create $elem -x $xv -y $yv \
+                -color black -symbol "" -linewidth 2
 
             if {[info exists hints(color)]} {
@@ -321 +386 @@
 
             foreach {path x y val} [$fobj controls get $comp] {
-                $graph marker create text -coords [list $x $y] \
-                    -text $val -anchor s -name $comp.$x -background ""
-                $graph marker bind $comp.$x <Enter> \
-                    [itcl::code $this _marker enter $comp.$x]
-                $graph marker bind $comp.$x <Leave> \
-                    [itcl::code $this _marker leave $comp.$x]
-                $graph marker bind $comp.$x <ButtonPress> \
-                    [itcl::code $this _marker edit $comp.$x $fobj/$path]
+                if {$path != ""} {
+                    set id "control[incr n]"
+                    $graph marker create text -coords [list $x $y] \
+                        -text $val -anchor s -name $id -background ""
+                    $graph marker bind $id <Enter> \
+                        [itcl::code $this _marker enter $id]
+                    $graph marker bind $id <Leave> \
+                        [itcl::code $this _marker leave $id]
+                    $graph marker bind $id <ButtonPress> \
+                        [itcl::code $this _marker edit $id $fobj/$path]
+                }
             }
         }
@@ -335 +403 @@
     # let the widget settle, then fix the axes to "nice" values
     after cancel [itcl::code $this _fixAxes]
-    after 20 [itcl::code $this _fixAxes]
+    after 100 [itcl::code $this _fixAxes]
 }
 
@@ -347 +415 @@
 itcl::body Rappture::DeviceViewer1D::_fixAxes {} {
     set graph $itk_component(graph)
+    if {![winfo ismapped $graph]} {
+        after cancel [itcl::code $this _fixAxes]
+        after 100 [itcl::code $this _fixAxes]
+        return
+    }
 
     #
@@ -356 +429 @@
     #
     set log [$graph axis cget y -logscale]
+    $graph axis configure y -min "" -max ""
     foreach {min max} [$graph axis limits y] { break }
 
@@ -503 +577 @@
 
             $_marker(fobj) controls put $_marker(path) $value
+            $_tool changed $_marker(path)
             event generate $itk_component(hull) <<Edit>>
 
@@ -613 +688 @@
     }
     set _device $itk_option(-device)
-    _fixTabs
-}
-
-# ----------------------------------------------------------------------
-# CONFIGURATION OPTION: -tool
-#
-# Set to the Rappture::Library object containing tool parameters.
-# Needed only if controls are added to the widget, so the controls
-# can update the tool parameters.
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::DeviceViewer1D::tool {
-    if {$itk_option(-tool) != ""} {
-        if {![Rappture::library isvalid $itk_option(-tool)]} {
-            error "bad value \"$itk_option(-tool)\": should be Rappture::Library"
-        }
-    }
-    set _tool $itk_option(-tool)
-}
+    _loadDevice
+}

trunk/gui/scripts/dispatcher.tcl

@@ -13 +13 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itcl

trunk/gui/scripts/dropdown.tcl

@@ -8 +8 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk

trunk/gui/scripts/dropdownlist.tcl

@@ -7 +7 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -135 +136 @@
     set _values [lreplace $_values $first $last]
     set _labels [lreplace $_labels $first $last]
+    $itk_component(list) delete $first $last
 }
 
@@ -273 +275 @@
         if {$maxw < [winfo width $widget]} { set maxw [winfo width $widget] }
     }
-    set avg [font measure $fnt "x"]
+    set avg [font measure $fnt "n"]
     $itk_component(list) configure -width [expr {round($maxw/double($avg))+1}]
 

trunk/gui/scripts/editor.tcl

@@ -27 +27 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk

trunk/gui/scripts/energyLevels.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -343 +344 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::EnergyLevels::_getColumn {name} {
-    if {$itk_option(-layout) == "" || $itk_option(-output) == ""} {
+puts "_getColumn $name"
+    if {$itk_option(-output) == ""} {
         return
     }
@@ -352 +354 @@
     # the position of the column from the list of all column names.
     #
-    set table [$itk_option(-layout) get $name.table]
-    set col [$itk_option(-layout) get $name.column]
-
-    set clist ""
-    foreach c [$itk_option(-output) children -type column $table] {
-        lappend clist [$itk_option(-output) get $table.$c.label]
-    }
-    set ipos [lsearch $clist $col]
-    if {$ipos < 0} {
-        return  ;# can't find data -- bail out!
-    }
-
-    set units [$itk_option(-output) get $table.column$ipos.units]
+    if {$itk_option(-layout) != ""} {
+        set table [$itk_option(-layout) get $name.table]
+        set col [$itk_option(-layout) get $name.column]
+
+        set clist ""
+        foreach c [$itk_option(-output) children -type column $table] {
+            lappend clist [$itk_option(-output) get $table.$c.label]
+        }
+        set ipos [lsearch $clist $col]
+        if {$ipos < 0} {
+            return  ;# can't find data -- bail out!
+        }
+        set units [$itk_option(-output) get $table.column$ipos.units]
+        set path "$table.data"
+    } else {
+        set clist ""
+        foreach c [$itk_option(-output) children -type column] {
+            lappend clist [$itk_option(-output) get $c.units]
+        }
+        if {$name == "energies"} {
+            set units "eV"
+        } else {
+            set units ""
+        }
+        set ipos [lsearch -exact $clist $units]
+        if {$ipos < 0} {
+            return  ;# can't find data -- bail out!
+        }
+        set path "data"
+    }
 
     set rlist ""
-    foreach line [split [$itk_option(-output) get $table.data] "\n"] {
+    foreach line [split [$itk_option(-output) get $path] "\n"] {
         if {"" != [string trim $line]} {
             set val [lindex $line $ipos]
@@ -391 +410 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::EnergyLevels::_getUnits {name} {
-    if {$itk_option(-layout) == "" || $itk_option(-output) == ""} {
+    if {$itk_option(-output) == ""} {
         return
     }
@@ -400 +419 @@
     # the position of the column from the list of all column names.
     #
-    set table [$itk_option(-layout) get $name.table]
-    set col [$itk_option(-layout) get $name.column]
-
-    set clist ""
-    foreach c [$itk_option(-output) children -type column $table] {
-        lappend clist [$itk_option(-output) get $table.$c.label]
-    }
-    set ipos [lsearch $clist $col]
-    if {$ipos < 0} {
-        return  ;# can't find data -- bail out!
-    }
-
-    return [$itk_option(-output) get $table.column$ipos.units]
+    if {$itk_option(-layout) != ""} {
+        set table [$itk_option(-layout) get $name.table]
+        set col [$itk_option(-layout) get $name.column]
+
+        set clist ""
+        foreach c [$itk_option(-output) children -type column $table] {
+            lappend clist [$itk_option(-output) get $table.$c.label]
+        }
+        set ipos [lsearch $clist $col]
+        if {$ipos < 0} {
+            return  ;# can't find data -- bail out!
+        }
+        set units [$itk_option(-output) get $table.column$ipos.units]
+    } else {
+        if {$name == "energies"} {
+            set units "eV"
+        } else {
+            set units ""
+        }
+    }
+    return $units
 }
 

trunk/gui/scripts/field.tcl

@@ -7 +7 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itcl
@@ -15 +16 @@
 
 itcl::class Rappture::Field {
-    constructor {devobj libobj path} { # defined below }
+    constructor {xmlobj path} { # defined below }
     destructor { # defined below }
 
-    public method components {{pattern *}}
-    public method vectors {{what -overall}}
+    public method components {args}
+    public method mesh {{what -overall}}
+    public method values {{what -overall}}
+    public method limits {axis}
     public method controls {option args}
     public method hints {{key ""}}
 
     protected method _build {}
-
-    private variable _device ""  ;# ref to lib obj with device data
-    private variable _libobj ""  ;# ref to lib obj with field data
+    protected method _getValue {expr}
+
+    private variable _xmlobj ""  ;# ref to XML obj with device data
 
     private variable _units ""   ;# system of units for this field
-    private variable _limits     ;# maps slab name => {z0 z1} limits
+    private variable _limits     ;# maps box name => {z0 z1} limits
     private variable _zmax 0     ;# length of the device
 
     private variable _field ""   ;# lib obj representing this field
-    private variable _comp2vecs  ;# maps component name => x,y vectors
+    private variable _comp2dims  ;# maps component name => dimensionality
+    private variable _comp2xy    ;# maps component name => x,y vectors
+    private variable _comp2vtk   ;# maps component name => vtkFloatArray
     private variable _comp2cntls ;# maps component name => x,y control points
 
@@ -42 +47 @@
 # CONSTRUCTOR
 # ----------------------------------------------------------------------
-itcl::body Rappture::Field::constructor {devobj libobj path} {
-    if {![Rappture::library isvalid $devobj]} {
-        error "bad value \"$devobj\": should be LibraryObj"
-    }
-    if {![Rappture::library isvalid $libobj]} {
-        error "bad value \"$libobj\": should be LibraryObj"
-    }
-    set _device $devobj
-    set _libobj $libobj
-    set _field [$libobj element -flavor object $path]
+itcl::body Rappture::Field::constructor {xmlobj path} {
+    if {![Rappture::library isvalid $xmlobj]} {
+        error "bad value \"$xmlobj\": should be Rappture::library"
+    }
+    set _xmlobj $xmlobj
+    set _field [$xmlobj element -as object $path]
     set _units [$_field get units]
 
     # determine the overall size of the device
     set z0 [set z1 0]
-    foreach elem [$_device children components] {
+    foreach elem [$_xmlobj children components] {
         switch -glob -- $elem {
-            slab* - molecule* {
+            box* {
                 if {![regexp {[0-9]$} $elem]} {
                     set elem "${elem}0"
                 }
-                set tval [$_device get components.$elem.thickness]
-                set tval [Rappture::Units::convert $tval \
+                set z0 [$_xmlobj get components.$elem.corner0]
+                set z0 [Rappture::Units::convert $z0 \
                     -context um -to um -units off]
-                set z1 [expr {$z0+$tval}]
+
+                set z1 [$_xmlobj get components.$elem.corner1]
+                set z1 [Rappture::Units::convert $z1 \
+                    -context um -to um -units off]
+
                 set _limits($elem) [list $z0 $z1]
-
-                set z0 $z1
             }
         }
@@ -83 +86 @@
 itcl::body Rappture::Field::destructor {} {
     itcl::delete object $_field
-    # don't destroy the _device! we don't own it!
-
-    foreach name [array names _comp2vecs] {
-        eval blt::vector destroy $_comp2vecs($name)
-    }
-}
-
-# ----------------------------------------------------------------------
-# USAGE: components ?<pattern>?
-#
-# Returns a list of names for the various components of this field.
-# If the optional glob-style <pattern> is specified, then it returns
-# only the component names matching the pattern.
-# ----------------------------------------------------------------------
-itcl::body Rappture::Field::components {{pattern *}} {
+    # don't destroy the _xmlobj! we don't own it!
+
+    foreach name [array names _comp2xy] {
+        eval blt::vector destroy $_comp2xy($name)
+    }
+    foreach name [array names _comp2vtk] {
+        set cobj [lindex $_comp2vtk($name) 0]
+        Rappture::Cloud::release $cobj
+
+        set fobj [lindex $_comp2vtk($name) 1]
+        rename $fobj ""
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: components ?-name|-dimensions? ?<pattern>?
+#
+# Returns a list of names or types for the various components of
+# this field.  If the optional glob-style <pattern> is specified,
+# then it returns only the components with names matching the pattern.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Field::components {args} {
+    Rappture::getopts args params {
+        flag what -name default
+        flag what -dimensions
+    }
+
+    set pattern *
+    if {[llength $args] > 0} {
+        set pattern [lindex $args 0]
+        set args [lrange $args 1 end]
+    }
+    if {[llength $args] > 0} {
+        error "wrong # args: should be \"components ?switches? ?pattern?\""
+    }
+
     set rlist ""
-    foreach name [array names _comp2vecs] {
-        if {[string match $pattern $name]} {
-            lappend rlist $name
+    foreach name [array names _comp2dims $pattern] {
+        switch -- $params(what) {
+            -name { lappend rlist $name }
+            -dimensions { lappend rlist $_comp2dims($name) }
         }
     }
@@ -108 +133 @@
 
 # ----------------------------------------------------------------------
-# USAGE: vectors ?<name>?
+# USAGE: mesh ?<name>?
 #
 # Returns a list {xvec yvec} for the specified field component <name>.
@@ -114 +139 @@
 # overall field (sum of all components).
 # ----------------------------------------------------------------------
-itcl::body Rappture::Field::vectors {{what -overall}} {
+itcl::body Rappture::Field::mesh {{what -overall}} {
     if {$what == "component0"} {
         set what "component"
     }
-    if {[info exists _comp2vecs($what)]} {
-        return $_comp2vecs($what)
-    }
-    error "bad option \"$what\": should be [join [lsort [array names _comp2vecs]] {, }]"
+    if {[info exists _comp2xy($what)]} {
+        return [lindex $_comp2xy($what) 0]  ;# return xv
+    }
+    if {[info exists _comp2vtk($what)]} {
+        set cobj [lindex $_comp2vtk($what) 0]
+        return [$cobj points]
+    }
+    error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
+}
+
+# ----------------------------------------------------------------------
+# USAGE: values ?<name>?
+#
+# Returns a list {xvec yvec} for the specified field component <name>.
+# If the name is not specified, then it returns the vectors for the
+# overall field (sum of all components).
+# ----------------------------------------------------------------------
+itcl::body Rappture::Field::values {{what -overall}} {
+    if {$what == "component0"} {
+        set what "component"
+    }
+    if {[info exists _comp2xy($what)]} {
+        return [lindex $_comp2xy($what) 1]  ;# return yv
+    }
+    if {[info exists _comp2vtk($what)]} {
+        return [lindex $_comp2vtk($what) 1]  ;# return vtkFloatArray
+    }
+    error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
+}
+
+# ----------------------------------------------------------------------
+# USAGE: limits <axis>
+#
+# Returns a list {min max} representing the limits for the specified
+# axis.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Field::limits {axis} {
+    foreach val {xmin xmax ymin ymax zmin zmax} {
+        set results($val) ""
+    }
+    foreach comp [array names _comp2dims] {
+        switch -- $_comp2dims($comp) {
+            1D {
+                foreach {xv yv} $_comp2xy($comp) break
+
+                $xv variable x
+                set lims(xmin) $x(min)
+                set lims(xmax) $x(max)
+
+                $yv variable y
+                set lims(ymin) $y(min)
+                set lims(ymax) $y(max)
+
+                set lims(zmin) 0
+                set lims(zmax) 0
+            }
+            2D - 3D {
+                foreach {xv yv} $_comp2vtk($comp) break
+
+                foreach {lims(xmin) lims(xmax)} [$xv limits x] break
+                foreach {lims(ymin) lims(ymax)} [$xv limits y] break
+                foreach {lims(zmin) lims(zmax)} [$yv GetRange] break
+            }
+        }
+        foreach val {xmin ymin zmin} {
+            if {"" == $results($val) || $lims($val) < $results($val)} {
+                set results($val) $lims($val)
+            }
+        }
+        foreach val {xmax ymax zmax} {
+            if {"" == $results($val) || $lims($val) > $results($val)} {
+                set results($val) $lims($val)
+            }
+        }
+    }
+    return [list $results(${axis}min) $results(${axis}max)]
 }
 
@@ -138 +235 @@
                 return $_comp2cntls($what)
             }
-            error "bad option \"$what\": should be [join [lsort [array names _comp2cntls]] {, }]"
+            return ""
         }
         put {
             set path [lindex $args 0]
             set value [lindex $args 1]
-            $_field put $path $value
+            $_xmlobj put $path.current $value
             _build
         }
@@ -160 +257 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Field::hints {{keyword ""}} {
-    foreach key {label scale color units restrict} {
+    foreach key {label scale color units} {
         set str [$_field get $key]
         if {"" != $str} {
@@ -186 +283 @@
 itcl::body Rappture::Field::_build {} {
     # discard any existing data
-    foreach name [array names _comp2vecs] {
-        eval blt::vector destroy $_comp2vecs($name)
-    }
-    catch {unset _comp2vecs}
+    foreach name [array names _comp2xy] {
+        eval blt::vector destroy $_comp2xy($name)
+    }
+    foreach name [array names _comp2vtk] {
+        set cobj [lindex $_comp2vtk($name) 0]
+        Rappture::Cloud::release $cobj
+
+        set fobj [lindex $_comp2vtk($name) 1]
+        rename $fobj ""
+    }
+    catch {unset _comp2xy}
+    catch {unset _comp2vtk}
+    catch {unset _comp2dims}
 
     #
@@ -196 +302 @@
     #
     foreach cname [$_field children -type component] {
-        set xv ""
-        set yv ""
-
-        set val [$_field get $cname.constant]
-        if {$val != ""} {
-            set domain [$_field get $cname.domain]
-            if {$domain == "" || ![info exists _limits($domain)]} {
-                set z0 0
-                set z1 $_zmax
+        set type ""
+        if {( [$_field element $cname.constant] != ""
+                && [$_field element $cname.domain] != "" )
+              || [$_field element $cname.xy] != ""} {
+            set type "1D"
+        } elseif {[$_field element $cname.mesh] != ""
+                    && [$_field element $cname.values] != ""} {
+            set type "points-on-mesh"
+        }
+
+        if {$type == "1D"} {
+            #
+            # 1D data can be represented as 2 BLT vectors,
+            # one for x and the other for y.
+            #
+            set xv ""
+            set yv ""
+
+            set val [$_field get $cname.constant]
+            if {$val != ""} {
+                set domain [$_field get $cname.domain]
+                if {$domain == "" || ![info exists _limits($domain)]} {
+                    set z0 0
+                    set z1 $_zmax
+                } else {
+                    foreach {z0 z1} $_limits($domain) { break }
+                }
+                set xv [blt::vector create x$_counter]
+                $xv append $z0 $z1
+
+                foreach {val pcomp} [_getValue $val] break
+                set yv [blt::vector create y$_counter]
+                $yv append $val $val
+
+                if {$pcomp != ""} {
+                    set zm [expr {0.5*($z0+$z1)}]
+                    set _comp2cntls($cname) \
+                        [list $pcomp $zm $val "$val$_units"]
+                }
             } else {
-                foreach {z0 z1} $_limits($domain) { break }
-            }
-            set xv [blt::vector create x$_counter]
-            $xv append $z0 $z1
-
-            if {$_units != ""} {
-                set val [Rappture::Units::convert $val \
-                    -context $_units -to $_units -units off]
-            }
-            set yv [blt::vector create y$_counter]
-            $yv append $val $val
-
-            set zm [expr {0.5*($z0+$z1)}]
-            set _comp2cntls($cname) \
-                [list $cname.constant $zm $val "$val$_units"]
-        } else {
-            set xydata [$_field get $cname.xy]
-            if {"" != $xydata} {
-                set xv [blt::vector create x$_counter]
-                set yv [blt::vector create y$_counter]
-
-                foreach line [split $xydata \n] {
-                    if {[scan $line {%g %g} xval yval] == 2} {
-                        $xv append $xval
-                        $yv append $yval
+                set xydata [$_field get $cname.xy]
+                if {"" != $xydata} {
+                    set xv [blt::vector create x$_counter]
+                    set yv [blt::vector create y$_counter]
+
+                    foreach line [split $xydata \n] {
+                        if {[scan $line {%g %g} xval yval] == 2} {
+                            $xv append $xval
+                            $yv append $yval
+                        }
                     }
                 }
             }
-        }
-
-        if {$xv != "" && $yv != ""} {
-            set _comp2vecs($cname) [list $xv $yv]
-            incr _counter
-        }
-    }
-}
+
+            if {$xv != "" && $yv != ""} {
+                set _comp2dims($cname) "1D"
+                set _comp2xy($cname) [list $xv $yv]
+                incr _counter
+            }
+        } elseif {$type == "points-on-mesh"} {
+            #
+            # More complex 2D/3D data is represented by a mesh
+            # object and an associated vtkFloatArray for field
+            # values.
+            #
+            set path [$_field get $cname.mesh]
+            if {[$_xmlobj element $path] != ""} {
+                set cobj [Rappture::Cloud::fetch $_xmlobj $path]
+                set values [$_field get $cname.values]
+                set farray [vtkFloatArray ::vals$_counter]
+
+                foreach v $values {
+                    if {"" != $_units} {
+                        set v [Rappture::Units::convert $v \
+                            -context $_units -to $_units -units off]
+                    }
+                    $farray InsertNextValue $v
+                }
+
+                set _comp2dims($cname) "[$cobj dimensions]D"
+                set _comp2vtk($cname) [list $cobj $farray]
+                incr _counter
+            } else {
+                puts "WARNING: can't find mesh $path for field component"
+            }
+        }
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _getValue <expr>
+#
+# Used internally to get the value for an expression <expr>.  Returns
+# a list of the form {val parameterPath}, where val is the numeric
+# value of the expression, and parameterPath is the XML path to the
+# parameter representing the value, or "" if the <expr> does not
+# depend on any parameters.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Field::_getValue {expr} {
+    #
+    # First, look for the expression among the <parameter>'s
+    # associated with the device.
+    #
+    set found 0
+    foreach pcomp [$_xmlobj children parameters] {
+        set id [$_xmlobj element -as id parameters.$pcomp]
+        if {[string equal $id $expr]} {
+            set val [$_xmlobj get parameters.$pcomp.current]
+            if {"" == $val} {
+                set val [$_xmlobj get parameters.$pcomp.default]
+            }
+            if {"" != $val} {
+                set expr $val
+                set found 1
+                break
+            }
+        }
+    }
+    if {$found} {
+        set pcomp "parameters.$pcomp"
+    } else {
+        set pcomp ""
+    }
+
+    if {$_units != ""} {
+        set expr [Rappture::Units::convert $expr \
+            -context $_units -to $_units -units off]
+    }
+
+    return [list $expr $pcomp]
+}

trunk/gui/scripts/gauge.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -146 +147 @@
         # the value is bound by any min/max value constraints.
         #
-        set newval [lindex $args 0]
-        if {$itk_option(-units) != ""} {
-            set units $itk_option(-units)
-            set newval [Rappture::Units::convert $newval -context $units]
-            set nv [Rappture::Units::convert $newval \
+        set newval [set nv [lindex $args 0]]
+        set units $itk_option(-units)
+        if {$units != ""} {
+            set newval [Rappture::Units::convert $newval \
+                -context $units]
+            set nv [Rappture::Units::convert $nv \
                 -context $units -to $units -units off]
-
-            if {"" != $itk_option(-minvalue)} {
-                set minv [Rappture::Units::convert $itk_option(-minvalue) \
+        }
+
+        if {"" != $itk_option(-minvalue)} {
+            set minv $itk_option(-minvalue)
+            if {$units != ""} {
+                set minv [Rappture::Units::convert $minv \
                     -context $units -to $units -units off]
-                if {$nv < $minv} {
-                    error "minimum value allowed here is $itk_option(-minvalue)"
-                }
-            }
-
-            if {"" != $itk_option(-maxvalue)} {
-                set maxv [Rappture::Units::convert $itk_option(-maxvalue) \
+            }
+            if {$nv < $minv} {
+                error "minimum value allowed here is $itk_option(-minvalue)"
+            }
+        }
+
+        if {"" != $itk_option(-maxvalue)} {
+            set maxv $itk_option(-maxvalue)
+            if {$units != ""} {
+                set maxv [Rappture::Units::convert $maxv \
                     -context $units -to $units -units off]
-                if {$nv > $maxv} {
-                    error "maximum value allowed here is $itk_option(-maxvalue)"
-                }
-            }
-        } elseif {![string is double -strict $newval]} {
+            }
+            if {$nv > $maxv} {
+                error "maximum value allowed here is $itk_option(-maxvalue)"
+            }
+        }
+
+        if {![string is double -strict $nv]} {
             error "Should be a real number"
         }

trunk/gui/scripts/mainwin.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk

trunk/gui/scripts/moleculeViewer.tcl

@@ -7 +7 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -22 +23 @@
     itk_option define -backdrop backdrop Backdrop "black"
     itk_option define -device device Device ""
-    itk_option define -library library Library ""
-
-    constructor {args} { # defined below }
+
+    constructor {tool args} { # defined below }
     destructor { # defined below }
 
@@ -30 +30 @@
     protected method _color2rgb {color}
 
+    private variable _tool ""    ;# tool containing this viewer
     private variable _actors ""  ;# list of actors in renderer
 }
@@ -39 +40 @@
 # CONSTRUCTOR
 # ----------------------------------------------------------------------
-itcl::body Rappture::MoleculeViewer::constructor {args} {
+itcl::body Rappture::MoleculeViewer::constructor {tool args} {
+    set _tool $tool
+
     itk_option add hull.width hull.height
     pack propagate $itk_component(hull) no
@@ -93 +96 @@
     if {$itk_option(-device) != ""} {
         set dev $itk_option(-device)
+        set lib [Rappture::library standard]
+
         set counter 0
         foreach atom [$dev children -type atom components.molecule] {
@@ -105 +110 @@
             $this-ren AddActor $aname
 
-            if {$itk_option(-library) != ""} {
-                set sfac 0.7
-                set scale [$itk_option(-library) get elements.($symbol).scale]
-                if {$scale != ""} {
-                    $aname SetScale [expr {$sfac*$scale}]
-                }
-                set color [$itk_option(-library) get elements.($symbol).color]
-                if {$color != ""} {
-                    eval [$aname GetProperty] SetColor [_color2rgb $color]
-                }
+            set sfac 0.7
+            set scale [$lib get elements.($symbol).scale]
+            if {$scale != ""} {
+                $aname SetScale [expr {$sfac*$scale}]
+            }
+            set color [$lib get elements.($symbol).color]
+            if {$color != ""} {
+                eval [$aname GetProperty] SetColor [_color2rgb $color]
             }
 
@@ -157 +160 @@
 }
 
-# ----------------------------------------------------------------------
-# OPTION: -library
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::MoleculeViewer::library {
-    _render
-}
-
 #package require Rappture
-#Rappture::MoleculeViewer .e -library [Rappture::library -std library.xml]
+#Rappture::MoleculeViewer .e
 #pack .e -expand yes -fill both
 #

trunk/gui/scripts/notebook.tcl

@@ -8 +8 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -33 +34 @@
 
     private variable _count 0       ;# counter for unique names
+    private variable _dispatcher "" ;# dispatcher for !events
     private variable _pages ""      ;# list of page frames
     private variable _name2page     ;# maps name => frame for page
@@ -47 +49 @@
 itcl::body Rappture::Notebook::constructor {args} {
     pack propagate $itk_component(hull) no
+
+    Rappture::dispatcher _dispatcher
+    $_dispatcher register !fixsize
+    $_dispatcher dispatch $this !fixsize "[itcl::code $this _fixSize]; list"
+
     eval itk_initialize $args
-}
-
-# ----------------------------------------------------------------------
-# DESTRUCTOR
-# ----------------------------------------------------------------------
-itcl::body Rappture::Notebook::destructor {} {
-    after cancel [itcl::code $this _fixSize]
 }
 
@@ -77 +77 @@
         set _name2page($name) $itk_component($pname)
 
-        bind $itk_component($pname) <Configure> [itcl::code $this _fixSize]
-
-        after cancel [itcl::code $this _fixSize]
-        after idle [itcl::code $this _fixSize]
+        bind $itk_component($pname) <Configure> \
+            [itcl::code $_dispatcher event -after 100 !fixsize]
 
         lappend rlist $itk_component($pname)
@@ -139 +137 @@
 
 # ----------------------------------------------------------------------
-# USAGE: current ?<name>|next>>|<<prev?
+# USAGE: current ?<name>|next>|<back?
 #
 # Used to query/set the current page in the notebook.  With no args,
 # it returns the name of the current page.  Otherwise, it sets the
-# current page.  The special token "next>>" is used to set the notebook
-# to the next logical page, and "<<prev" sets to the previous.
+# current page.  The special token "next>" is used to set the notebook
+# to the next logical page, and "<back" sets to the previous.
 # ----------------------------------------------------------------------
 itcl::body Rappture::Notebook::current {args} {
@@ -154 +152 @@
             set name [lindex $args 0]
             set index 0
-            if {$name == "next>>"} {
+            if {$name == "next>"} {
                 if {$_current == ""} {
                     set index 0
@@ -164 +162 @@
                     }
                 }
-            } elseif {$name == "<<prev"} {
+            } elseif {$name == "<back"} {
                 if {$_current == ""} {
                     set index end
@@ -189 +187 @@
         }
         default {
-            error "wrong # args: should be \"current name|next>>|<<prev\""
+            error "wrong # args: should be \"current name|next>|<back\""
         }
     }
@@ -230 +228 @@
 # ----------------------------------------------------------------------
 itcl::configbody Rappture::Notebook::width {
-    after cancel [itcl::code $this _fixSize]
-    after idle [itcl::code $this _fixSize]
+    $_dispatcher event -idle !fixsize
 }
 
@@ -238 +235 @@
 # ----------------------------------------------------------------------
 itcl::configbody Rappture::Notebook::height {
-    after cancel [itcl::code $this _fixSize]
-    after idle [itcl::code $this _fixSize]
-}
+    $_dispatcher event -idle !fixsize
+}

trunk/gui/scripts/pager.tcl

@@ -7 +7 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
 package require BLT
 
+option add *Pager.arrangement "pages" widgetDefault
 option add *Pager.width 0 widgetDefault
 option add *Pager.height 0 widgetDefault
-option add *Pager.arrangement "tabs/top" widgetDefault
-option add *Pager.tearoff 0 widgetDefault
+option add *Pager.padding 8 widgetDefault
+option add *Pager.crumbColor black widgetDefault
+option add *Pager.crumbNumberColor white widgetDefault
+option add *Pager.dimCrumbColor gray70 widgetDefault
+option add *Pager.activeCrumbColor blue widgetDefault
+option add *Pager.crumbFont \
+    -*-helvetica-bold-r-normal-*-*-120-* widgetDefault
+
+blt::bitmap define Pager-arrow {
+#define arrow_width 9
+#define arrow_height 9
+static unsigned char arrow_bits[] = {
+   0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xff, 0x00, 0xff, 0x01, 0xff, 0x00,
+   0x70, 0x00, 0x30, 0x00, 0x10, 0x00};
+}
 
 itcl::class Rappture::Pager {
     inherit itk::Widget
 
-    itk_option define -arrangement arrangement Arrangement ""
     itk_option define -width width Width 0
     itk_option define -height height Height 0
+    itk_option define -padding padding Padding 0
+    itk_option define -crumbcolor crumbColor Foreground ""
+    itk_option define -crumbnumbercolor crumbNumberColor Foreground ""
+    itk_option define -crumbfont crumbFont Font ""
+    itk_option define -dimcrumbcolor dimCrumbColor DimForeground ""
+    itk_option define -activecrumbcolor activeCrumbColor ActiveForeground ""
+    itk_option define -arrangement arrangement Arrangement ""
 
     constructor {args} { # defined below }
@@ -29 +50 @@
     public method delete {first {last ""}}
     public method index {name}
-    public method get {{name ""}}
+    public method page {args}
+    public method current {args}
 
     protected method _layout {}
-
+    protected method _fixSize {}
+    protected method _drawCrumbs {how}
+
+    private variable _counter 0      ;# counter for page names
     private variable _dispatcher ""  ;# dispatcher for !events
     private variable _pages ""       ;# list of known pages
-    private variable _page2frame     ;# maps page name => frame
-    private variable _counter 0      ;# counter for frame names
-    private variable _arrangement "" ;# last value of -arrangment
+    private variable _page2info      ;# maps page name => -frame,-title,-command
+    private variable _current ""     ;# page currently shown
 }
                                                                                 
@@ -50 +74 @@
     $_dispatcher register !layout
     $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
-
-    itk_component add tabs {
-        blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
-            -side bottom -selectcommand [itcl::code $this _layout]
-    } {
-        keep -activebackground -activeforeground
-        keep -background -cursor -font
-        rename -highlightbackground -background background Background
-        keep -highlightcolor -highlightthickness
-        keep -selectbackground -selectforeground
-        keep -tabbackground -tabforeground
-        keep -tearoff
-    }
-    pack $itk_component(tabs) -expand yes -fill both
+    $_dispatcher register !fixsize
+    $_dispatcher dispatch $this !fixsize "[itcl::code $this _fixSize]; list"
+
+    itk_component add controls {
+        frame $itk_interior.cntls
+    }
+
+    itk_component add next {
+        button $itk_component(controls).next -width 6 -text "Next >" \
+            -command [itcl::code $this current next>]
+    }
+    pack $itk_component(next) -side right
+
+    itk_component add back {
+        button $itk_component(controls).back -width 6 -text "< Back" \
+            -command [itcl::code $this current <back]
+    }
+    pack $itk_component(back) -side left
+
+    set font [$itk_component(next) cget -font]
+    set ht [font metrics $font -linespace]
+    itk_component add breadcrumbs {
+        canvas $itk_interior.breadcrumbs -width 10 -height [expr {$ht+2}]
+    }
+
+    itk_component add line {
+        frame $itk_interior.line -height 2 -borderwidth 1 -relief sunken
+    }
+
 
     itk_component add inside {
-        frame $itk_component(tabs).inside
-    }
+        frame $itk_interior.inside
+    }
+    pack $itk_component(inside) -expand yes -fill both
+    pack propagate $itk_component(inside) no
+
+    eval itk_initialize $args
     $_dispatcher event -idle !layout
-
-    eval itk_initialize $args
-}
-
-# ----------------------------------------------------------------------
-# USAGE: insert <pos> <name> ?<name>...?
-#
-# Clients use this to insert one or more new pages into this pager.
-# The pages are inserted into the list at position <pos>, which can
-# be an integer starting from 0 or the keyword "end".  Each <name>
-# is the name used to identify the page.  Returns the name of a frame
-# for each page created.
+}
+
+# ----------------------------------------------------------------------
+# USAGE: insert <pos> ?-name <name>? ?-title <label>? ?-command <str>?
+#
+# Clients use this to insert a new page into this pager.  The page is
+# inserted into the list at position <pos>, which can be an integer
+# starting from 0 or the keyword "end".  The optional <name> can be
+# used to identify the page.  If it is not supplied, a name is created
+# for the page.  The -title and -command are other values associated
+# with the page.
+#
+# Returns the name used to identify the page.
 # ----------------------------------------------------------------------
 itcl::body Rappture::Pager::insert {pos args} {
@@ -89 +133 @@
     }
 
-    set rlist ""
-    foreach name $args {
-        if {[info exists _page2frame($name)]} {
-            error "page \"$name\" already exists"
-        }
-        set win $itk_component(inside).page[incr _counter]
-        frame $win
-        set _page2frame($name) $win
-        set _pages [linsert $_pages $pos $name]
-        lappend rlist $win
-
-        if {[string match tabs/* $_arrangement]} {
-            $itk_component(tabs) insert $pos $name
-        }
-    }
+    Rappture::getopts args params {
+        value -name page#auto
+        value -title "Page #auto"
+        value -command ""
+    }
+    if {[llength $args] > 0} {
+        error "wrong # args: should be \"insert pos ?-name n? ?-title t? ?-command c?\""
+    }
+
+    incr _counter
+    if {$_counter > 1} {
+        set subst "#$_counter"
+    } else {
+        set subst ""
+    }
+    if {[regexp {#auto} $params(-name)]} {
+        regsub -all {#auto} $params(-name) $subst params(-name)
+    }
+    if {[regexp {#auto} $params(-title)]} {
+        regsub -all {#auto} $params(-title) $subst params(-title)
+    }
+
+    # allocate the page
+    if {[info exists _page2info($params(-name)-frame)]} {
+        error "page \"$params(-name)\" already exists"
+    }
+    set win $itk_component(inside).page$_counter
+    frame $win
+    set _page2info($params(-name)-frame) $win
+    set _page2info($params(-name)-title) $params(-title)
+    set _page2info($params(-name)-command) $params(-command)
+    set _pages [linsert $_pages $pos $params(-name)]
+
+    #bind $win <Configure> \
+    #    [itcl::code $_dispatcher event -idle !fixsize]
+
     $_dispatcher event -idle !layout
 
-    return $rlist
+    return $params(-name)
 }
 
@@ -131 +196 @@
 
     foreach name [lrange $_pages $first $last] {
-        if {[info exists _page2frame($name)]} {
-            destroy $_page2frame($name)
-            unset _page2frame($name)
+        if {[info exists _page2info($name-frame)]} {
+            destroy $_page2info($name-frame)
+            unset _page2info($name-frame)
+            unset _page2info($name-title)
+            unset _page2info($name-command)
         }
     }
     set _pages [lreplace $_pages $first $last]
 
-    if {[string match tabs/* $_arrangement]} {
-        $itk_component(tabs) delete $first $last
-    }
     $_dispatcher event -idle !layout
 }
 
 # ----------------------------------------------------------------------
-# USAGE: index <name>
+# USAGE: index <name>|@n
 #
 # Clients use this to convert a page <name> into its corresponding
-# integer index.  Returns -1 if the <name> is not recognized.
+# integer index.  Returns an error if the <name> is not recognized.
 # ----------------------------------------------------------------------
 itcl::body Rappture::Pager::index {name} {
-    return [lsearch -exact $_pages $name]
-}
-
-# ----------------------------------------------------------------------
-# USAGE: get ?<name>?
+    set i [lsearch $_pages $name]
+    if {$i >= 0} {
+        return $i
+    }
+    if {[regexp {^@([0-9]+)$} $name match i]} {
+        return $i
+    }
+    error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]"
+}
+
+# ----------------------------------------------------------------------
+# USAGE: page
+# USAGE: page <name>|@n ?-frame|-title|-command? ?<newvalue>?
 #
 # Clients use this to get information about pages.  With no args, it
-# returns a list of all page names.  Otherwise, it returns the frame
-# associated with a page name.
-# ----------------------------------------------------------------------
-itcl::body Rappture::Pager::get {{name ""}} {
-    if {$name == ""} {
+# returns a list of all page names.  Otherwise, it returns the
+# requested information for a page specified by its <name> or index
+# @n.  By default, it returns the -frame for the page, but it can
+# also return the -title and -command.  The -title and -command
+# can also be set to a <newvalue>.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Pager::page {args} {
+    if {[llength $args] == 0} {
         return $_pages
     }
-    if {[info exists _page2frame($name)]} {
-        return $_page2frame($name)
-    }
-    return ""
+    set i [index [lindex $args 0]]
+    set name [lindex $_pages $i]
+
+    set args [lrange $args 1 end]
+    Rappture::getopts args params {
+        flag what -frame default
+        flag what -title
+        flag what -command
+    }
+
+    if {[llength $args] == 0} {
+        set opt $params(what)
+        return $_page2info($name$opt)
+    } elseif {[llength $args] == 1} {
+        set val [lindex $args 0]
+        if {$params(-title)} {
+            set _page2info($name-title) $val
+        } elseif {$params(-command)} {
+            set _page2info($name-command) $val
+        }
+    } else {
+        error "wrong # args: should be \"page ?which? ?-frame|-title|-command? ?newvalue?\""
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: current ?<name>|next>|<back?
+#
+# Used to query/set the current page in the notebook.  With no args,
+# it returns the name of the current page.  Otherwise, it sets the
+# current page.  The special token "next>" is used to set the pager
+# to the next logical page, and "<back" sets to the previous.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Pager::current {args} {
+    switch -- [llength $args] {
+        0 {
+            return $_current
+        }
+        1 {
+            if {$itk_option(-arrangement) != "pages"} {
+                return ""
+            }
+            set name [lindex $args 0]
+            set index 0
+            if {$name == "next>"} {
+                if {$_current == ""} {
+                    set index 0
+                } else {
+                    set i [lsearch -exact $_pages $_current]
+                    set index [expr {$i+1}]
+                    if {$index >= [llength $_pages]} {
+                        set index [expr {[llength $_pages]-1}]
+                    }
+                }
+                set _current [lindex $_pages $index]
+            } elseif {$name == "<back"} {
+                if {$_current == ""} {
+                    set index end
+                } else {
+                    set i [lsearch -exact $_pages $_current]
+                    set index [expr {$i-1}]
+                    if {$index < 0} {
+                        set index 0
+                    }
+                }
+                set _current [lindex $_pages $index]
+            } else {
+                if {$name == ""} {
+                    set _current ""
+                    set index 0
+                } else {
+                    set index [lsearch -exact $_pages $name]
+                    if {$index < 0} {
+                        error "can't move to page \"$name\""
+                    }
+                    set _current [lindex $_pages $index]
+                }
+            }
+
+            foreach w [pack slaves $itk_component(inside)] {
+                pack forget $w
+            }
+            if {$_current != ""} {
+                pack $_page2info($_current-frame) -expand yes -fill both \
+                    -padx $itk_option(-padding) -pady $itk_option(-padding)
+            }
+
+            if {$index == 0} {
+                pack forget $itk_component(back)
+            } else {
+                set prev [expr {$index-1}]
+                if {$prev >= 0} {
+                    set label "< [page @$prev -title]"
+                } else {
+                    set label "< Back"
+                }
+                $itk_component(back) configure -text $label
+                pack $itk_component(back) -side left
+            }
+            if {$index == [expr {[llength $_pages]-1}]} {
+                pack forget $itk_component(next)
+            } else {
+                set next [expr {$index+1}]
+                if {$next <= [llength $_pages]} {
+                    set label "[page @$next -title] >"
+                } else {
+                    set label "Next >"
+                }
+                $itk_component(next) configure -text $label
+                pack $itk_component(next) -side right
+            }
+            _drawCrumbs current
+
+            #
+            # If this new page has a command associated with it, then
+            # invoke it now.
+            #
+            if {"" != $_current
+                  && [string length $_page2info($_current-command)] > 0} {
+                uplevel #0 $_page2info($_current-command)
+            }
+        }
+        default {
+            error "wrong # args: should be \"current name|next>|<back\""
+        }
+    }
 }
 
@@ -178 +375 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Pager::_layout {} {
-    #
-    # If the new arrangement doesn't match the last one, then
-    # clear the effects of the old arrangement.
-    #
-    regexp {(.*)/?} $_arrangement match oldatype
-    regexp {(.*)/?} $itk_option(-arrangement) match newatype
-
-    if {$newatype != $oldatype} {
-        switch -glob -- $_arrangement {
-            tabs/* {
+    if {$itk_option(-arrangement) == "pages"} {
+        if {$_current == ""} {
+            set _current [lindex $_pages 0]
+            if {$_current != ""} {
+                current $_current
+            }
+        }
+        _drawCrumbs all
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _fixSize
+#
+# Invoked automatically whenever a page changes size or the -width
+# or -height options change.  When the -width/-height are zero, this
+# method computes the minimum size needed to accommodate all pages.
+# Otherwise, it passes the size request onto the hull.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Pager::_fixSize {} {
+    switch -- $itk_option(-arrangement) {
+        pages {
+            if {$itk_option(-width) <= 0} {
+                update idletasks
+                set maxw [expr {
+                    [winfo reqwidth $itk_component(next)]
+                    + 10
+                    + [winfo reqwidth $itk_component(back)]}]
+
                 foreach name $_pages {
-                    pack forget $_page2frame($name)
-                }
-                pack forget $itk_component(inside)
-                catch {$itk_component(tabs) delete 0 end}
-            }
-            stack {
+                    set w [winfo reqwidth $_page2info($name-frame)]
+                    if {$w > $maxw} { set maxw $w }
+                }
+                set maxw [expr {$maxw + 2*$itk_option(-padding)}]
+                $itk_component(inside) configure -width $maxw
+            } else {
+                $itk_component(inside) configure -width $itk_option(-width)
+            }
+
+            if {$itk_option(-height) <= 0} {
+                update idletasks
+                set maxh 0
                 foreach name $_pages {
-                    pack forget $_page2frame($name)
-                }
-            }
-        }
-        switch -glob -- $itk_option(-arrangement) {
-            tabs/* {
+                    set h [winfo reqheight $_page2info($name-frame)]
+                    if {$h > $maxh} { set maxh $h }
+                }
+                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
+                $itk_component(inside) configure -height $maxh
+            } else {
+                $itk_component(inside) configure -height $itk_option(-height)
+            }
+        }
+        side-by-side {
+            if {$itk_option(-width) <= 0} {
+                update idletasks
+                set maxw [expr {
+                    [winfo reqwidth $itk_component(next)]
+                    + 10
+                    + [winfo reqwidth $itk_component(back)]}]
+
+                set wtotal 0
                 foreach name $_pages {
-                    $itk_component(tabs) insert end $name
-                }
-                if {[llength $_pages] > 0} {
-                    $itk_component(tabs) select 0
-                }
-            }
-        }
-    }
-    set _arrangement $itk_option(-arrangement)
-
-    #
-    # Apply the new arrangement.
-    #
-    switch -glob -- $itk_option(-arrangement) {
-        tabs/* {
-            set side [lindex [split $itk_option(-arrangement) /] 1]
-            if {$side == ""} { set side "top" }
-            $itk_component(tabs) configure -side $side
-
-            if {[llength $_pages] <= 1} {
-                pack $itk_component(inside) -expand yes -fill both
-                set first [lindex $_pages 0]
-                if {$first != ""} {
-                    pack $_page2frame($first) -expand yes -fill both
-                }
-            } else {
-                pack forget $itk_component(inside)
-                set i [$itk_component(tabs) index select]
-                if {$i != ""} {
-                    set name [$itk_component(tabs) get $i]
-                    $itk_component(tabs) tab configure $name \
-                        -window $itk_component(inside) -fill both
-                }
-
+                    set w [winfo reqwidth $_page2info($name-frame)]
+                    set wtotal [expr {$wtotal + $w + 2*$itk_option(-padding)}]
+                }
+                if {$wtotal > $maxw} { set maxw $wtotal }
+                $itk_component(inside) configure -width $maxw
+            } else {
+                $itk_component(inside) configure -width $itk_option(-width)
+            }
+
+            if {$itk_option(-height) <= 0} {
+                update idletasks
+                set maxh 0
                 foreach name $_pages {
-                    pack forget $_page2frame($name)
-                }
-                if {$i != ""} {
-                    set name [lindex $_pages $i]
-                    if {$name != ""} {
-                        pack $_page2frame($name) -expand yes -fill both
-                    }
-                }
-            }
-        }
-        stack {
+                    set h [winfo reqheight $_page2info($name-frame)]
+                    if {$h > $maxh} { set maxh $h }
+                }
+                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
+                $itk_component(inside) configure -height $maxh
+            } else {
+                $itk_component(inside) configure -height $itk_option(-height)
+            }
+        }
+    }
+}
+
+# ----------------------------------------------------------------------
+# OPTION: -arrangement
+# ----------------------------------------------------------------------
+itcl::configbody Rappture::Pager::arrangement {
+    switch -- $itk_option(-arrangement) {
+        pages {
+            pack forget $itk_component(inside)
+            pack $itk_component(controls) -side bottom -fill x -padx 8 -pady 8
+            if {[llength $_pages] > 2} {
+                pack $itk_component(breadcrumbs) -side top -fill x \
+                    -padx 8 -pady 8
+                pack $itk_component(line) -side top -fill x
+            }
+            pack $itk_component(inside) -expand yes -fill both
+            current [lindex $_pages 0]
+        }
+        side-by-side {
+            pack forget $itk_component(controls)
+            pack forget $itk_component(line)
+            pack forget $itk_component(breadcrumbs)
+
+            foreach w [pack slaves $itk_component(inside)] {
+                pack forget $w
+            }
             foreach name $_pages {
-                pack forget $_page2frame($name)
-            }
+                pack $_page2info($name-frame) -side left \
+                    -expand yes -fill both \
+                    -padx $itk_option(-padding) -pady $itk_option(-padding)
+            }
+        }
+        default {
+            error "bad value \"$itk_option(-arrangement)\": should be pages or side-by-side"
+        }
+    }
+    $_dispatcher event -now !fixsize
+}
+
+# ----------------------------------------------------------------------
+# OPTION: -width
+# ----------------------------------------------------------------------
+itcl::configbody Rappture::Pager::width {
+    $_dispatcher event -idle !fixsize
+}
+
+# ----------------------------------------------------------------------
+# OPTION: -height
+# ----------------------------------------------------------------------
+itcl::configbody Rappture::Pager::height {
+    $_dispatcher event -idle !fixsize
+}
+
+# ----------------------------------------------------------------------
+# OPTION: -padding
+# ----------------------------------------------------------------------
+itcl::configbody Rappture::Pager::padding {
+    if {$_current != ""} {
+        pack $_page2info($_current-frame) -expand yes -fill both \
+            -padx $itk_option(-padding) -pady $itk_option(-padding)
+    }
+    $_dispatcher event -idle !fixsize
+}
+
+# ----------------------------------------------------------------------
+# USAGE: _drawCrumbs all|current
+#
+# Invoked automatically whenever the pages change.  The value "all"
+# signifies that the number of pages has changed, so all should be
+# redrawn.  The value "current" means that the current page has
+# changed, so there is just a simple color change.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Pager::_drawCrumbs {how} {
+    set c $itk_component(breadcrumbs)
+    set fnt $itk_option(-crumbfont)
+
+    switch -- $how {
+        all {
+            $c delete all
+
+            set x 0
+            set y [expr {[winfo reqheight $c]/2}]
+            set last [lindex $_pages end]
+
+            set num 1
             foreach name $_pages {
-                pack $_page2frame($name) -expand yes -fill both
-            }
-            pack $itk_component(inside) -expand yes -fill both
-        }
-    }
-}
-
-# ----------------------------------------------------------------------
-# CONFIGURATION OPTION: -arrangement
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::Pager::arrangement {
-    set legal {tabs/top tabs/bottom tabs/left tabs/right stack}
-    if {[lsearch -exact $legal $itk_option(-arrangement)] < 0} {
-        error "bad option \"$itk_option(-arrangement)\": should be one of [join [lsort $legal] {, }]"
-    }
-    $_dispatcher event -idle !layout
-}
-
-source dispatcher.tcl
-
-Rappture::Pager .p
-pack .p -expand yes -fill both
-
-set f [.p component inside]
-label $f.top -text "top"
-pack $f.top -fill x
-
-set f [.p insert end "Electrical"]
-label $f.l -text "Electrical" -background black -foreground white
-pack $f.l -expand yes -fill both
-
-set f [.p insert end "Doping"]
-label $f.l -text "Doping" -background black -foreground white
-pack $f.l -expand yes -fill both
+                set ht [expr {[font metrics $fnt -linespace]+2}]
+                set id [$c create oval $x [expr {$y-$ht/2}] \
+                    [expr {$x+$ht}] [expr {$y+$ht/2}] \
+                    -outline "" -fill $itk_option(-dimcrumbcolor) \
+                    -tags $name]
+                set id [$c create text [expr {$x+$ht/2}] [expr {$y+1}] \
+                    -text $num -fill $itk_option(-crumbnumbercolor) \
+                    -tags [list $name $name-num]]
+                set x [expr {$x + $ht+2}]
+
+                set id [$c create text $x [expr {$y+1}] -anchor w \
+                    -text [page $name -title] -font $fnt -tags $name]
+
+                $c bind $name <Enter> [itcl::code $this _drawCrumbs active]
+                $c bind $name <Leave> [itcl::code $this _drawCrumbs current]
+                $c bind $name <ButtonPress> [itcl::code $this current $name]
+
+                foreach {x0 y0 x1 y1} [$c bbox $id] break
+                set x [expr {$x + ($x1-$x0)+6}]
+
+                if {$name != $last} {
+                    set id [$c create bitmap $x $y -anchor w \
+                        -bitmap Pager-arrow \
+                        -foreground $itk_option(-dimcrumbcolor)]
+                    foreach {x0 y0 x1 y1} [$c bbox $id] break
+                    set x [expr {$x + ($x1-$x0)+6}]
+                }
+
+                incr num
+            }
+
+            # fix the scrollregion in case we go off screen
+            $c configure -scrollregion [$c bbox all]
+
+            _drawCrumbs current
+        }
+        current {
+            # make all crumbs dim
+            foreach name $_pages {
+                $c itemconfigure $name \
+                    -fill $itk_option(-dimcrumbcolor)
+                $c itemconfigure $name-num \
+                    -fill $itk_option(-crumbnumbercolor)
+            }
+
+            # make all the current crumb bright
+            if {$_current != ""} {
+                $c itemconfigure $_current \
+                    -fill $itk_option(-crumbcolor)
+                $c itemconfigure $_current-num \
+                    -fill $itk_option(-crumbnumbercolor)
+
+                # scroll the view to see the crumb
+                if {[$c bbox $_current] != ""} {
+                    foreach {x0 y0 x1 y1} [$c bbox $_current] break
+                    foreach {xm0 ym0 xm1 ym1} [$c bbox all] break
+                    set xm [expr {double($x0)/($xm1-$xm0)}]
+                    $c xview moveto $xm
+                }
+            } else {
+                $c xview moveto 0
+            }
+        }
+        active {
+            foreach tag [$c gettags current] {
+                if {[lsearch -exact $_pages $tag] >= 0} {
+                    $c itemconfigure $tag -fill $itk_option(-activecrumbcolor)
+                    $c itemconfigure $tag-num -fill white
+                }
+            }
+        }
+    }
+}

trunk/gui/scripts/scroller.tcl

@@ -9 +9 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -32 +33 @@
     protected method _widget2sbar {which args}
     protected method _fixsbar {which {state ""}}
-    protected method _fixframe {}
+    protected method _fixframe {which}
     protected method _lock {option}
 
@@ -100 +101 @@
     if {$widget == "frame"} {
         if {$_frame == ""} {
-            set _frame [canvas $itk_component(hull).ifr]
-            bind $_frame <Configure> [itcl::code $this _resizeframe]
+            set _frame [canvas $itk_component(hull).ifr -highlightthickness 0]
+            frame $_frame.f
+            $_frame create window 0 0 -anchor nw -window $_frame.f -tags frame
+            bind $_frame.f <Configure> [itcl::code $this _fixframe inner]
+            bind $_frame <Configure> [itcl::code $this _fixframe outer]
         }
         set widget $_frame
@@ -119 +123 @@
     set _contents $widget
 
+    if {$widget == $_frame} {
+        return $_frame.f
+    }
     return $widget
 }
@@ -149 +156 @@
 itcl::body Rappture::Scroller::_fixsbar {which {state ""}} {
     if {$state == ""} {
-        switch -- $itk_option(-${which}scrollmode) {
+        switch -- [string tolower $itk_option(-${which}scrollmode)] {
             on - 1 - true - yes  { set state 1 }
             off - 0 - false - no { set state 0 }
@@ -161 +168 @@
                 }
             }
+            default {
+                set state 0
+            }
         }
     }
@@ -187 +197 @@
 
 # ----------------------------------------------------------------------
-# USAGE: _fixframe
+# USAGE: _fixframe <which>
 #
 # Invoked automatically whenever the canvas representing the "frame"
@@ -193 +203 @@
 # to the new size.
 # ----------------------------------------------------------------------
-itcl::body Rappture::Scroller::_fixframe {} {
-    $_frame configure -scrollregion [$_frame bbox all]
+itcl::body Rappture::Scroller::_fixframe {which} {
+    switch -- $which {
+        inner {
+            $_frame configure -scrollregion [$_frame bbox all]
+        }
+        outer {
+            $_frame itemconfigure frame -width [winfo width $_frame]
+        }
+    }
 }
 
@@ -248 +265 @@
 itcl::configbody Rappture::Scroller::width {
     if {$itk_option(-width) == "0"} {
+        if {$itk_option(-height) == "0"} {
+            grid propagate $itk_component(hull) yes
+        } else {
+            component hull configure -width 1i
+        }
+    } else {
+        grid propagate $itk_component(hull) no
+        component hull configure -width $itk_option(-width)
+    }
+}
+
+# ----------------------------------------------------------------------
+# OPTION: -height
+# ----------------------------------------------------------------------
+itcl::configbody Rappture::Scroller::height {
+    if {$itk_option(-height) == "0"} {
         if {$itk_option(-width) == "0"} {
             grid propagate $itk_component(hull) yes
         } else {
-            component hull configure -width 1i
-        }
-    } else {
-        grid propagate $itk_component(hull) no
-        component hull configure -width $itk_option(-width)
-    }
-}
-
-# ----------------------------------------------------------------------
-# OPTION: -height
-# ----------------------------------------------------------------------
-itcl::configbody Rappture::Scroller::height {
-    if {$itk_option(-height) == "0"} {
-        if {$itk_option(-height) == "0"} {
-            grid propagate $itk_component(hull) yes
-        } else {
             component hull configure -height 1i
         }

trunk/gui/scripts/spectrum.tcl

@@ -14 +14 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -160 +161 @@
         error "wrong # args: should be \"get ?-color|-fraction? ?value?\""
     }
+
     set value [lindex $args 0]
-
-    set value [Rappture::Units::convert $value \
-        -context $units -to $units -units off]
+    if {$units != ""} {
+        set value [Rappture::Units::convert $value \
+            -context $units -to $units -units off]
+    }
 
     switch -- $what {

trunk/gui/scripts/tempgauge.tcl

@@ -6 +6 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk

trunk/gui/scripts/tooltip.tcl

@@ -17 +17 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itk
@@ -25 +26 @@
 option add *Tooltip.borderwidth 1 widgetDefault
 option add *Tooltip.font -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
-option add *Tooltip.wrapLength 3i widgetDefault
+option add *Tooltip.wrapLength 4i widgetDefault
 
 itcl::class Rappture::Tooltip {
@@ -40 +41 @@
 
     public proc for {widget args}
+    public proc text {widget args}
     private common catalog    ;# maps widget => message
 
-    public proc tooltip {option {widget ""}}
+    public proc tooltip {option args}
     private common pending "" ;# after ID for pending "tooltip show"
 
@@ -91 +93 @@
 
 # ----------------------------------------------------------------------
-# USAGE: show @<x>,<y>|<widget>
+# USAGE: show @<x>,<y>|<widget>+<x>,<y>
 #
 # Clients use this to pop up the tooltip on the screen.  The position
-# should be either a <widget> name (tooltip pops up beneath widget)
-# or a specific root window coordinate of the form @x,y.
+# should be either a <widget> name with an optional offset +<x>,<y>
+# (tooltip pops up beneath widget by default), or a specific root
+# window coordinate of the form @x,y.
 #
 # If the -message has the form "@command", then the command is executed
@@ -102 +105 @@
 # ----------------------------------------------------------------------
 itcl::body Rappture::Tooltip::show {where} {
+    set hull $itk_component(hull)
+
     if {[regexp {^@([0-9]+),([0-9]+)$} $where match x y]} {
         set xpos $x
         set ypos $y
+    } elseif {[regexp {^(.*)\+([0-9]+),([0-9]+)$} $where match win x y]} {
+        set xpos [expr {[winfo rootx $win]+$x}]
+        set ypos [expr {[winfo rooty $win]+$y}]
     } elseif {[winfo exists $where]} {
         set xpos [expr {[winfo rootx $where]+10}]
         set ypos [expr {[winfo rooty $where]+[winfo height $where]}]
     } else {
-        error "bad position \"$where\": should be widget name or @x,y"
+        error "bad position \"$where\": should be widget name, +x,y, or @x,y"
     }
 
@@ -122 +130 @@
     }
 
+    # strings can't be too big, or they'll go off screen!
+    if {[string length $mesg] > 1000} {
+        set mesg "[string range $mesg 0 1000]..."
+    }
+    set pos 0
+    ::for {set i 0} {$pos >= 0 && $i < 5} {incr i} {
+        incr pos
+        set pos [string first \n $mesg $pos]
+    }
+    if {$pos > 0} {
+        set mesg "[string range $mesg 0 $pos]..."
+    }
     $itk_component(text) configure -text $mesg
 
-    wm geometry $itk_component(hull) +$xpos+$ypos
+    #
+    # Make sure the tooltip doesn't go off screen.  Then, put it up.
+    #
     update
-
-    wm deiconify $itk_component(hull)
-    raise $itk_component(hull)
+    if {$xpos+[winfo reqwidth $hull] > [winfo screenwidth $hull]} {
+        set xpos [expr {[winfo screenwidth $hull]-[winfo reqwidth $hull]}]
+    }
+    if {$xpos < 0} { set xpos 0 }
+
+    if {$ypos+[winfo reqheight $hull] > [winfo screenheight $hull]} {
+        set ypos [expr {[winfo screenheight $hull]-[winfo reqheight $hull]}]
+    }
+    if {$ypos < 0} { set ypos 0 }
+
+    wm geometry $hull +$xpos+$ypos
+    update
+
+    wm deiconify $hull
+    raise $hull
 }
 
@@ -166 +200 @@
 
 # ----------------------------------------------------------------------
-# USAGE: tooltip pending <widget>
-# USAGE: tooltip show
+# USAGE: text <widget> ?<text>?
+#
+# Used to query or set the text used for the tooltip for a widget.
+# This is done automatically when you call the "for" proc, but it
+# is sometimes handy to query or change the text later.
+# ----------------------------------------------------------------------
+itcl::body Rappture::Tooltip::text {widget args} {
+    if {[llength $args] == 0} {
+        if {[info exists catalog($widget)]} {
+            return $catalog($widget)
+        }
+        return ""
+    } elseif {[llength $args] == 1} {
+        set str [lindex $args 0]
+        set catalog($widget) $str
+    } else {
+        error "wrong # args: should be \"text widget ?str?\""
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: tooltip pending <widget> ?@<x>,<y>|+<x>,<y>?
+# USAGE: tooltip show <widget> ?@<x>,<y>|+<x>,<y>?
 # USAGE: tooltip cancel
 #
@@ -176 +231 @@
 # bindings take over.
 # ----------------------------------------------------------------------
-itcl::body Rappture::Tooltip::tooltip {option {widget ""}} {
+itcl::body Rappture::Tooltip::tooltip {option args} {
     switch -- $option {
         pending {
+            if {[llength $args] < 1 || [llength $args] > 2} {
+                error "wrong # args: should be \"tooltip pending widget ?@x,y?\""
+            }
+            set widget [lindex $args 0]
+            set loc [lindex $args 1]
+
             if {![info exists catalog($widget)]} {
                 error "can't find tooltip for $widget"
@@ -185 +246 @@
                 after cancel $pending
             }
-            set pending [after 1500 [itcl::code tooltip show $widget]]
+            set pending [after 1500 [itcl::code tooltip show $widget $loc]]
         }
         show {
+            if {[llength $args] < 1 || [llength $args] > 2} {
+                error "wrong # args: should be \"tooltip pending widget ?@x,y?\""
+            }
+            set widget [lindex $args 0]
+            set loc [lindex $args 1]
+
             if {[winfo exists $widget]} {
                 .rappturetooltip configure -message $catalog($widget)
-                .rappturetooltip show $widget
+                if {[string index $loc 0] == "@"} {
+                    .rappturetooltip show $loc
+                } elseif {[string index $loc 0] == "+"} {
+                    .rappturetooltip show $widget$loc
+                } else {
+                    .rappturetooltip show $widget
+                }
             }
         }

trunk/gui/scripts/units.tcl

@@ -7 +7 @@
 # ======================================================================
 #  AUTHOR:  Michael McLennan, Purdue University
-#  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
+#  Copyright (c) 2004-2005
+#  Purdue Research Foundation, West Lafayette, IN
 # ======================================================================
 package require Itcl
@@ -474 +475 @@
 Rappture::Units::define F->C {(F-32)/1.8} {(1.8*C)+32}
 
-Rappture::Units::define eV -type potential -metric yes
+Rappture::Units::define eV -type energy -metric yes
+
+Rappture::Units::define V -type voltage -metric yes