Changeset 11

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

Files:

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

trunk/gui/apps/driver

@@ -4 +4 @@
 #
 #  This driver program loads a tool description from a tool.xml file,
-#  and a UI configuration from a config.xml file, and produces a
-#  user interface automatically to drive an application.  The user
-#  can set up input, click and button to launch a tool, and browse
-#  through output.
+#  and produces a user interface automatically to drive an application.
+#  The user can set up input, click and button to launch a tool, and
+#  browse through output.
 #
 #  RUN AS FOLLOWS:
-#    driver ?-tool <toolfile>? ?-config <configfile>?
+#    driver ?-tool <toolfile>?
 #
-#  If the <toolfile> is not specified, this program looks for a
-#  file called "tool.xml" in the current directory.  If the <configfile>
-#  is not specified, it looks for "config.xml" in the current directory.
+#  If the <toolfile> is not specified, it defaults to "tool.xml" in
+#  the current working directory.
 #
 # ======================================================================
@@ -42 +40 @@
 option add *MainWin.bgColor white startupFile
 option add *Tooltip.background white
-
-image create photo in2out \
-    -file [file join $Rappture::installdir scripts images in2out.gif]
+option add *Editor.background white
+option add *Gauge.textBackground white
+option add *TemperatureGauge.textBackground white
 
 #
 # Process command line args to get the names of files to load...
 #
-set toolfile "tool.xml"
-set configfile "config.xml"
-
-while {[llength $argv] > 0} {
-    set first [lindex $argv 0]
-    set argv [lrange $argv 1 end]
-
-    switch -- $first {
-        -tool {
-            if {[llength $argv] > 0} {
-                set toolfile [lindex $argv 0]
-                set argv [lrange $argv 1 end]
-            } else {
-                puts stderr "$argv0: missing value for -tool"
-                exit 1
-            }
-        }
-        -config {
-            if {[llength $argv] > 0} {
-                set configfile [lindex $argv 0]
-                set argv [lrange $argv 1 end]
-            } else {
-                puts stderr "$argv0: missing value for -tool"
-                exit 1
-            }
-        }
-        default {
-            puts stderr "usage: $argv0 ?-tool file? ?-config file?"
-            exit 1
-        }
-    }
+Rappture::getopts argv params {
+    value -tool tool.xml
 }
 
-# open the XML file containing the material library
-set lib [Rappture::library -std library.xml]
-                                                                                
 # open the XML file containing the tool parameters
-if {![file exists $toolfile]} {
-    puts stderr "tool file \"$toolfile\" doesn't exist"
+if {![file exists $params(-tool)]} {
+    puts stderr "can't find tool \"$params(-tool)\""
     exit 1
 }
-set tool [Rappture::library $toolfile]
-                                                                                
-# open the XML file containing the configuration for this application
-if {![file exists $configfile]} {
-    puts stderr "config file \"$configfile\" doesn't exist"
-    exit 1
+set xmlobj [Rappture::library $params(-tool)]
+
+set installdir [file dirname $params(-tool)]
+if {"." == $installdir} {
+    set installdir [pwd]
 }
-set config [Rappture::library $configfile]
 
-# ----------------------------------------------------------------------
-# From here on, run in the directory containing the tool.xml file,
-# so driver.xml files, etc., are created there
-# ----------------------------------------------------------------------
-cd [file dirname $toolfile]
-
-# ----------------------------------------------------------------------
-# USAGE: main_device_select
-#
-# Invoked automatically when a user selects a new device from the
-# "Devices:" combobox.  Plugs the new device into the device viewer.
-# ----------------------------------------------------------------------
-proc main_device_select {} {
-    set win [.main component app]
-    set val [$win.input.devsel.dev value]
-    set val [$win.input.devsel.dev translate $val]
-    $win.input.device configure -device $val
-    $win.output.analyze configure -device $val
-}
+set tool [Rappture::Tool ::#auto $xmlobj $installdir]
 
 # ----------------------------------------------------------------------
@@ -124 +70 @@
 wm withdraw .
 Rappture::MainWin .main -borderwidth 0
+.main configure -title [$tool xml get tool.title]
+wm withdraw .main
 
-.main configure -title [$config get title]
+#
+# The main window has a pager that acts as a notebook for the
+# various parts.  This notebook as at least two pages--an input
+# page and an output (analysis) page.  If there are <phase>'s
+# for input, then there are more pages in the notebook.
+#
+set win [.main component app]
+Rappture::Pager $win.pager
+pack $win.pager -expand yes -fill both
 
-# build everything inside this main window
-set win [.main component app]
-#$win configure -background #a6a6a6
+set phases [$tool xml children -type phase input]
+if {[llength $phases] > 0} {
+    set plist ""
+    foreach name $phases {
+        lappend plist input.$name
+    }
+    set phases $plist
+} else {
+    set phases input
+}
 
-frame $win.input -borderwidth 12 -relief flat
-pack $win.input -side left -expand yes -fill both -padx {0 5}
+foreach comp $phases {
+    set title [$tool xml get $comp.about.label]
+    if {$title == ""} {
+        set title "Input #auto"
+    }
+    $win.pager insert end -name $comp -title $title
 
-frame $win.output -borderwidth 12 -relief flat
-pack $win.output -side left -expand yes -fill both -padx {5 0}
-
-# make an arrow that goes from input to output side
-#label $win.arrow -borderwidth 0 -image in2out
-#place $win.arrow -y 2 -anchor n
-#bind $win.input <Configure> [list align_arrow $win]
-#proc align_arrow {win} {
-#    place $win.arrow -x [expr {[winfo width $win.input]+5}]
-#}
-
-# ----------------------------------------------------------------------
-# INPUT AREA
-# ----------------------------------------------------------------------
-set w $win.input
-set dfirst ""
-set dlist [$config children -type structure controls]
-if {"" != $dlist} {
-    foreach dname $dlist {
-        set obj [$config element -flavor object controls.$dname]
-        set name [$obj get label]
-        set devs($name) $obj
-    }
-    set devlist [lsort [array names devs]]
-
-    if {[array size devs] > 1} {
-        frame $w.devsel
-        pack $w.devsel -side top -fill x
-        label $w.devsel.l -text "Device:"
-        pack $w.devsel.l -side left
-        Rappture::Combobox $w.devsel.dev -width 30 -editable no
-        pack $w.devsel.dev -side left
-        bind $w.devsel.dev <<Value>> main_device_select
-
-        foreach name $devlist {
-            $w.devsel.dev choices insert end $devs($name) $name
-        }
-        $w.devsel.dev value [lindex $devlist 0]
-    }
-
-    set first [lindex $devlist 0]
-    set dfirst $devs($first)
-    set tags [$dfirst children components]
-    set i [lsearch $tags label]
-    if {$i >= 0} {set tags [lreplace $tags $i $i]}
-
-    if {$tags == "molecule"} {
-        Rappture::MoleculeViewer $w.device -device $devs($first) \
-            -library $lib
-    } else {
-        Rappture::DeviceViewer1D $w.device -device $devs($first) \
-            -tool $tool -library $lib
-    }
-    pack $w.device -expand yes -fill both
-
-    bind $w.device <<Edit>> [list $win.output.analyze reset]
+    #
+    # Build the page of input controls for this phase.
+    #
+    set f [$win.pager page $comp]
+    Rappture::Page $f.cntls $tool $comp
+    pack $f.cntls -expand yes -fill both
 }
 
@@ -195 +112 @@
 # OUTPUT AREA
 # ----------------------------------------------------------------------
-set w $win.output
-Rappture::Analyzer $w.analyze -holdwindow $win.input \
-    -tool $tool -analysis [$config element -flavor object analysis] \
-    -device $dfirst
-pack $w.analyze -expand yes -fill both
+$win.pager insert end -name analyzer -title "Results"
+set f [$win.pager page analyzer]
+$win.pager page analyzer -command [list $f.analyze simulate -ifneeded]
+
+Rappture::Analyzer $f.analyze $tool -simcontrol auto
+pack $f.analyze -expand yes -fill both
+
+$tool configure -analyzer $f.analyze
 
 # ----------------------------------------------------------------------
-# HOOK UP ANY CONTROLS CALLED OUT IN CONFIG.XML
+# Finalize the arrangement
 # ----------------------------------------------------------------------
-proc controls_add {container libObj path} {
-    set presets ""
-    foreach pre [$libObj children -type preset $path] {
-        lappend presets \
-            [$libObj get $path.$pre.value] \
-            [$libObj get $path.$pre.label]
-    }
+if {[llength [$win.pager page]] == 2} {
+    set style [$xmlobj get tool.layout]
+    set screenw [winfo screenwidth .]
 
-    set type Rappture::Gauge
-    set units [$libObj get $path.units]
-    if {$units != ""} {
-        set desc [Rappture::Units::description $units]
-        if {[string match temperature* $desc]} {
-            set type Rappture::TemperatureGauge
-        }
-    }
+    update idletasks
+    set w0 [winfo reqwidth [$win.pager page @0]]
+    set w1 [winfo reqwidth [$win.pager page @1]]
 
-    set counter 0
-    set w "$container.gauge[incr counter]"
-    while {[winfo exists $w]} {
-        set w "$container.gauge[incr counter]"
-    }
-
-    # create the widget
-    $type $w -units $units -presets $presets
-    pack $w -side top -anchor w
-#    bind $w <<Value>> [itcl::code $this _controlSet $w $libObj $path]
-
-    set min [$libObj get $path.min]
-    if {"" != $min} { $w configure -minvalue $min }
-
-    set max [$libObj get $path.max]
-    if {"" != $max} { $w configure -maxvalue $max }
-
-    set str [$libObj get $path.default]
-    if {$str != ""} { $w value $str }
-
-    if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
-        set color [$libObj get $path.color]
-        if {$color == ""} {
-            set color blue
-        }
-        if {$units != ""} {
-            set min [Rappture::Units::convert $min -to $units -units off]
-            set max [Rappture::Units::convert $max -to $units -units off]
-        }
-        $w configure -spectrum [Rappture::Spectrum ::#auto [list \
-            $min white $max $color] -units $units]
-    }
-
-    set str [$libObj get $path.label]
-    if {$str != ""} {
-        set help [$libObj get $path.help]
-        if {"" != $help} {
-            append str "\n$help"
-        }
-        if {$units != ""} {
-            set desc [Rappture::Units::description $units]
-            append str "\n(units of $desc)"
-        }
-        Rappture::Tooltip::for $w $str
-    }
-
-    set str [$libObj get $path.icon]
-    if {$str != ""} {
-        $w configure -image [image create photo -data $str]
+    # if only two windows and they're small enough, put them up side-by-side
+    if {$w0+$w1 < $screenw && $style != "wizard"} {
+        $win.pager configure -arrangement side-by-side
+        $f.analyze configure -holdwindow [$win.pager page @0] -simcontrol on
     }
 }
-
-if {[winfo exists $win.input.device]} {
-    foreach access [$config children -type access controls] {
-        set name [$config get controls.$access]
-        switch -glob -- $name {
-            input.(ambient)* - structure* {
-                $win.input.device controls add $name
-            }
-        }
-    }
-} else {
-    foreach access [$config children -type access controls] {
-        set name [$config get controls.$access]
-        controls_add $win.input $tool $name
-    }
-    $w.analyze simulate
-}
+wm deiconify .main

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

trunk/python/Rappture/library.py

@@ -40 +40 @@
 
     # ------------------------------------------------------------------
-    def element(self, path="", flavor="object"):
+    def element(self, path="", as="object"):
         """
         Clients use this to query a particular element within the
@@ -51 +51 @@
         By default, this method returns an object representing the
         DOM node referenced by the path.  This is changed by setting
-        the "flavor" argument to "id" (for name of the tail element),
+        the "as" argument to "id" (for name of the tail element),
         to "type" (for the type of the tail element), to "component"
         (for the component name "type(id)"), or to "object"
@@ -61 +61 @@
             return None
 
-        if flavor == 'object':
+        if as == 'object':
             return library(node)
-        elif flavor == 'component':
+        elif as == 'component':
             return self._node2comp(node)
-        elif flavor == 'id':
+        elif as == 'id':
             return self._node2name(node)
-        elif flavor == 'type':
+        elif as == 'type':
             return node.tagName
 
-        raise ValueError, "bad flavor '%s': should be object, id, type" % flavor
-
-    # ------------------------------------------------------------------
-    def children(self, path="", flavor="object", type=None):
+        raise ValueError, "bad as value '%s': should be component, id, object, type" % as
+
+    # ------------------------------------------------------------------
+    def children(self, path="", as="object", type=None):
         """
         Clients use this to query the children of a particular element
@@ -83 +83 @@
 
         By default, this method returns a list of objects representing
-        the children.  This is changed by setting the "flavor" argument
+        the children.  This is changed by setting the "as" argument
         to "id" (for tail names of all children), to "type" (for the
         types of all children), to "component" (for the path component
@@ -99 +99 @@
             nlist = [n for n in nlist if n.nodeName == type]
 
-        if flavor == 'object':
+        if as == 'object':
             return [library(n) for n in nlist]
-        elif flavor == 'component':
+        elif as == 'component':
             return [self._node2comp(n) for n in nlist]
-        elif flavor == 'id':
+        elif as == 'id':
             return [self._node2name(n) for n in nlist]
-        elif flavor == 'type':
+        elif as == 'type':
             return [n.tagName for n in nlist]
+
+        raise ValueError, "bad as value '%s': should be component, id, object, type" % as
 
     # ------------------------------------------------------------------

trunk/tcl/scripts/library.tcl

@@ -11 +11 @@
 package require Itcl
 
-namespace eval Rappture { # forward declaration }
-
-# ----------------------------------------------------------------------
-# USAGE: library ?-std? <file>
+namespace eval Rappture {
+    variable stdlib ""
+}
+
+# ----------------------------------------------------------------------
+# USAGE: library <file>
+# USAGE: library standard
 # USAGE: library isvalid <object>
 #
@@ -21 +24 @@
 # file that represents it.
 #
-# If the -std flag is included, then the file is treated as the
-# name of a standard file, which is part of the Rappture installation.
+# If you use the word "standard" in place of the file name, this
+# function returns the standard Rappture library object, which
+# contains material definitions.
 #
 # The isvalid operation checks an <object> to see if it is a valid
@@ -40 +44 @@
     }
 
-    # handle the open operation...
-    set stdfile 0
-    while {[llength $args] > 1} {
-        set switch [lindex $args 0]
-        set args [lrange $args 1 end]
-        if {$switch == "-std"} {
-            set stdfile 1
-        } else {
-            error "bad option \"$switch\": should be -std"
-        }
+    if {[llength $args] != 1} {
+        error "wrong # args: should be \"library file\" or \"library isvalid object\""
     }
     set fname [lindex $args 0]
 
-    if {$stdfile && [file pathtype $fname] != "absolute"} {
-        set fname [file join $Rappture::installdir lib $fname]
+    if {$fname == "standard"} {
+        variable stdlib
+        if {$stdlib != ""} {
+            return $stdlib
+        }
+        set fname [file join $Rappture::installdir lib library.xml]
+
+        set fid [::open $fname r]
+        set info [read $fid]
+        close $fid
+
+        set stdlib [Rappture::LibraryObj ::#auto $info]
+        return $stdlib
     }
 
@@ -71 +78 @@
 
 # ----------------------------------------------------------------------
+# USAGE: entities ?-as <fval>? <object> <path>
+#
+# Used to sift through an XML <object> for "entities" within the
+# Rappture description.  Entities are things like strings, numbers,
+# etc., which show up in the GUI as controls.
+#
+# Returns a list of all entities found beneath <path>.
+#
+# By default, this method returns the component name "type(id)".
+# This is changed by setting the -as argument to "id" (for name
+# of the tail element), to "type" (for the type of the tail element),
+# to "object" (for an object representing the DOM node referenced by
+# the path.
+# ----------------------------------------------------------------------
+proc Rappture::entities {args} {
+    array set params {
+        -as component
+    }
+    while {[llength $args] > 1} {
+        set first [lindex $args 0]
+        if {[string index $first 0] == "-"} {
+            set choices [array names params]
+            if {[lsearch $choices $first] < 0} {
+                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
+            }
+            set params($first) [lindex $args 1]
+            set args [lrange $args 2 end]
+        } else {
+            break
+        }
+    }
+    if {[llength $args] > 2} {
+        error "wrong # args: should be \"entities ?-as fval? obj ?path?\""
+    }
+    set xmlobj [lindex $args 0]
+    set path [lindex $args 1]
+
+    set rlist ""
+    lappend queue $path
+    while {[llength $queue] > 0} {
+        set path [lindex $queue 0]
+        set queue [lrange $queue 1 end]
+
+        foreach cpath [$xmlobj children -as path $path] {
+            switch -- [$xmlobj element -as type $cpath] {
+                group {
+                    lappend queue $cpath
+                }
+                structure {
+                    if {[$xmlobj element $cpath.current.parameters] != ""} {
+                        lappend queue $cpath.current.parameters
+                    }
+                }
+                default {
+                    # add this to the return list with the right flavor
+                    if {$params(-as) == "component"} {
+                        lappend rlist $cpath
+                    } else {
+                        lappend rlist [$xmlobj element -as $params(-as) $cpath]
+                    }
+
+                    # if this element has embedded groups, add them to the queue
+                    foreach ccpath [$xmlobj children -as path $cpath] {
+                        if {[$xmlobj element -as type $ccpath] == "group"} {
+                            lappend queue $ccpath
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $rlist
+}
+
+# ----------------------------------------------------------------------
 itcl::class Rappture::LibraryObj {
     constructor {info} { # defined below }
@@ -76 +158 @@
 
     public method element {args}
+    public method parent {args}
     public method children {args}
     public method get {{path ""}}
@@ -82 +165 @@
     public method xml {}
 
+    public method diff {libobj}
+    public proc value {libobj path}
+
     protected method find {path}
     protected method path2list {path}
     protected method node2name {node}
     protected method node2comp {node}
+    protected method node2path {node}
+    protected method childnodes {node type}
 
     private variable _root 0       ;# non-zero => this obj owns document
@@ -119 +207 @@
 
 # ----------------------------------------------------------------------
-# USAGE: element ?-flavor <fval>? ?<path>?
+# USAGE: element ?-as <fval>? ?<path>?
 #
 # Clients use this to query a particular element within the entire
@@ -128 +216 @@
 #
 # By default, this method returns the component name "type(id)".
-# This is changed by setting the -flavor argument to "id" (for name
+# This is changed by setting the -as argument to "id" (for name
 # of the tail element), to "type" (for the type of the tail element),
 # to "object" (for an object representing the DOM node referenced by
-# the path.
+# the path).
 # ----------------------------------------------------------------------
 itcl::body Rappture::LibraryObj::element {args} {
     array set params {
-        -flavor component
+        -as component
     }
     while {[llength $args] > 1} {
@@ -151 +239 @@
     }
     if {[llength $args] > 1} {
-        error "wrong # args: should be \"element ?-flavor fval? ?path?\""
+        error "wrong # args: should be \"element ?-as fval? ?path?\""
     }
     set path [lindex $args 0]
@@ -160 +248 @@
     }
 
-    switch -- $params(-flavor) {
+    switch -- $params(-as) {
       object {
           return [::Rappture::LibraryObj ::#auto $node]
@@ -170 +258 @@
           return [node2name $node]
       }
+      path {
+          return [node2path $node]
+      }
       type {
           return [$node nodeName]
       }
       default {
-          error "bad flavor \"$params(-flavor)\": should be object, id, type, component"
-      }
-    }
-}
-
-# ----------------------------------------------------------------------
-# USAGE: children ?-flavor <fval>? ?-type <name>? ?<path>?
-#
-# Clients use this to query the children of a particular element
-# within the entire data structure.  This is just like the "element"
-# method, but it returns the children of the element instead of the
-# element itself.  If the optional -type argument is specified, then
-# the return list is restricted to children of the specified type.
+          error "bad flavor \"$params(-as)\": should be component, id, object, path, type"
+      }
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: parent ?-as <fval>? ?<path>?
+#
+# Clients use this to query the parent of a particular element.
+# This is just like the "element" method, but it returns the parent
+# of the element instead of the element itself.
 #
 # By default, this method returns a list of component names "type(id)".
-# This is changed by setting the -flavor argument to "id" (for tail
+# This is changed by setting the -as argument to "id" (for tail
 # names of all children), to "type" (for the types of all children),
 # to "object" (for a list of objects representing the DOM nodes for
 # all children).
 # ----------------------------------------------------------------------
-itcl::body Rappture::LibraryObj::children {args} {
+itcl::body Rappture::LibraryObj::parent {args} {
     array set params {
-        -flavor component
-        -type ""
+        -as component
     }
     while {[llength $args] > 1} {
@@ -213 +301 @@
     }
     if {[llength $args] > 1} {
-        error "wrong # args: should be \"children ?-flavor fval? ?-type name? ?path?\""
+        error "wrong # args: should be \"parent ?-as fval? ?path?\""
+    }
+    set path [lindex $args 0]
+
+    set node [find $path]
+    if {$node == ""} {
+        return ""
+    }
+    set node [$node parentNode]
+
+    switch -- $params(-as) {
+      object {
+          return [::Rappture::LibraryObj ::#auto $node]
+      }
+      component {
+          return [node2comp $node]
+      }
+      id {
+          return [node2name $node]
+      }
+      path {
+          return [node2path $node]
+      }
+      type {
+          return [$node nodeName]
+      }
+      default {
+          error "bad flavor \"$params(-as)\": should be component, id, object, path, type"
+      }
+    }
+}
+
+# ----------------------------------------------------------------------
+# USAGE: children ?-as <fval>? ?-type <name>? ?<path>?
+#
+# Clients use this to query the children of a particular element
+# within the entire data structure.  This is just like the "element"
+# method, but it returns the children of the element instead of the
+# element itself.  If the optional -type argument is specified, then
+# the return list is restricted to children of the specified type.
+#
+# By default, this method returns a list of component names "type(id)".
+# This is changed by setting the -as argument to "id" (for tail
+# names of all children), to "type" (for the types of all children),
+# to "object" (for a list of objects representing the DOM nodes for
+# all children).
+# ----------------------------------------------------------------------
+itcl::body Rappture::LibraryObj::children {args} {
+    array set params {
+        -as component
+        -type ""
+    }
+    while {[llength $args] > 1} {
+        set first [lindex $args 0]
+        if {[string index $first 0] == "-"} {
+            set choices [array names params]
+            if {[lsearch $choices $first] < 0} {
+                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
+            }
+            set params($first) [lindex $args 1]
+            set args [lrange $args 2 end]
+        } else {
+            break
+        }
+    }
+    if {[llength $args] > 1} {
+        error "wrong # args: should be \"children ?-as fval? ?-type name? ?path?\""
     }
     set path [lindex $args 0]
@@ -235 +389 @@
 
     set rlist ""
-    switch -- $params(-flavor) {
+    switch -- $params(-as) {
       object {
           foreach n $nlist {
@@ -251 +405 @@
           }
       }
+      path {
+          foreach n $nlist {
+              lappend rlist [node2path $n]
+          }
+      }
       type {
           foreach n $nlist {
@@ -257 +416 @@
       }
       default {
-          error "bad flavor \"$params(-flavor)\": should be object, id, type, component"
+          error "bad flavor \"$params(-as)\": should be component, id, object, type"
       }
     }
@@ -344 +503 @@
 
     if {[Rappture::library isvalid $str]} {
-        error "not yet implemented"
+        foreach n [[$str info variable _node -value] childNodes] {
+            $node appendXML [$n asXML]
+        }
     } else {
         set n [$_document createText $str]
@@ -376 +537 @@
 itcl::body Rappture::LibraryObj::xml {} {
     return [$_node asXML]
+}
+
+# ----------------------------------------------------------------------
+# USAGE: diff <libobj>
+#
+# Compares the entities in this object to those in another and
+# returns a list of differences.  The result is a list of the form:
+# {op1 path1 oldval1 newval1 ...} where each "op" is +/-/c for
+# added/subtracted/changed, "path" is the path within the library
+# that is different, and "oldval"/"newval" give the values for the
+# object at the path.
+# ----------------------------------------------------------------------
+itcl::body Rappture::LibraryObj::diff {libobj} {
+    set rlist ""
+
+    # query the values for all entities in both objects
+    set thisv [Rappture::entities $this input]
+    set otherv [Rappture::entities $libobj input]
+
+    # scan through values for this object, and compare against other one
+    foreach path $thisv {
+        set i [lsearch -exact $otherv $path]
+        if {$i < 0} {
+            foreach {raw norm} [value $this $path] break
+            lappend rlist - $path $raw ""
+        } else {
+            foreach {traw tnorm} [value $this $path] break
+            foreach {oraw onorm} [value $libobj $path] break
+            if {![string equal $tnorm $onorm]} {
+                lappend rlist c $path $traw $oraw
+            }
+            set otherv [lreplace $otherv $i $i]
+        }
+    }
+
+    # add any values left over in the other object
+    foreach path $otherv {
+        foreach {oraw onorm} [value $libobj $path] break
+        lappend rlist + $path "" $oraw
+    }
+    return $rlist
+}
+
+# ----------------------------------------------------------------------
+# USAGE: value <object> <path>
+#
+# Used to query the "value" associated with the <path> in an XML
+# <object>.  This is a little more complicated than the object's
+# "get" method.  It handles things like structures and values
+# with normalized units.
+#
+# Returns a list of two items:  {raw norm} where "raw" is the raw
+# value from the "get" method and "norm" is the normalized value
+# produced by this routine.  Example:  {300K 300}
+#
+# Right now, it is a handy little utility used by the "diff" method.
+# Eventually, it should be moved to a better object-oriented
+# implementation, where each Rappture type could overload the
+# various bits of processing below.  So we leave it as a "proc"
+# now instead of a method, since it should be deprecated soon.
+# ----------------------------------------------------------------------
+itcl::body Rappture::LibraryObj::value {libobj path} {
+    switch -- [$libobj element -as type $path] {
+        structure {
+            set raw $path
+            # try to find a label to represent the structure
+            set val [$libobj get $path.about.label]
+            if {"" == $val} {
+                set val [$libobj get $path.current.about.label]
+            }
+            if {"" == $val} {
+                if {[$libobj element $path.current] != ""} {
+                    set comps [$libobj children $path.current.components]
+                    set val "<structure> with [llength $comps] components"
+                } else {
+                    set val "<structure>"
+                }
+            }
+            return [list $raw $val]
+        }
+        number {
+            # get the usual value...
+            set raw ""
+            if {"" != [$libobj element $path.current]} {
+                set raw [$libobj get $path.current]
+            } elseif {"" != [$libobj element $path.default]} {
+                set raw [$libobj get $path.default]
+            }
+            if {"" != $raw} {
+                set val $raw
+                # then normalize to default units
+                set units [$libobj get $path.units]
+                if {"" != $units} {
+                    set val [Rappture::Units::convert $val \
+                        -context $units -to $units -units off]
+                }
+            }
+            return [list $raw $val]
+        }
+    }
+
+    # for all other types, get the value (current, or maybe default)
+    set raw ""
+    if {"" != [$libobj element $path.current]} {
+        set raw [$libobj get $path.current]
+    } elseif {"" != [$libobj element $path.default]} {
+        set raw [$libobj get $path.default]
+    }
+    return [list $raw $raw]
 }
 
@@ -440 +710 @@
                 set index 0
             }
-            set nlist [$node getElementsByTagName $type]
+            set nlist [childnodes $node $type]
             set node [lindex $nlist $index]
         } else {
@@ -450 +720 @@
             #
             if {$type != ""} {
-                set nlist [$node getElementsByTagName $type]
+                set nlist [childnodes $node $type]
             } else {
                 set nlist [$node childNodes]
@@ -554 +824 @@
         }
         set type [$node nodeName]
-        set siblings [$pnode getElementsByTagName $type]
+        set siblings [childnodes $pnode $type]
         set index [lsearch $siblings $node]
         if {$index == 0} {
@@ -581 +851 @@
             return ""
         }
-        set siblings [$pnode getElementsByTagName $type]
+        set siblings [childnodes $pnode $type]
         set index [lsearch $siblings $node]
         if {$index == 0} {
@@ -593 +863 @@
     return $name
 }
+
+# ----------------------------------------------------------------------
+# USAGE: node2path <node>
+#
+# Used internally to create a full path name for the specified node.
+# The path is relative to the current object, so it stops when the
+# parent is the root node for this object.
+# ----------------------------------------------------------------------
+itcl::body Rappture::LibraryObj::node2path {node} {
+    set path [node2comp $node]
+    set node [$node parentNode]
+    while {$node != "" && $node != $_node} {
+        set path "[node2comp $node].$path"
+        set node [$node parentNode]
+    }
+    return $path
+}
+
+# ----------------------------------------------------------------------
+# USAGE: childnodes <node> <type>
+#
+# Used internally to return a list of children for the given <node>
+# that match a specified <type>.  Similar to XML getElementsByTagName,
+# but returns only direct children of the <node>.
+# ----------------------------------------------------------------------
+itcl::body Rappture::LibraryObj::childnodes {node type} {
+    set rlist ""
+    foreach cnode [$node childNodes] {
+        if {[$cnode nodeName] == $type} {
+            lappend rlist $cnode
+        }
+    }
+    return $rlist
+}