Changeset 11


Ignore:
Timestamp:
May 30, 2005 9:33:49 PM (16 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:
29 added
2 deleted
25 edited

Legend:

Unmodified
Added
Removed
  • trunk/gui/apps/driver

    r9 r11  
    44#
    55#  This driver program loads a tool description from a tool.xml file,
    6 #  and a UI configuration from a config.xml file, and produces a
    7 #  user interface automatically to drive an application.  The user
    8 #  can set up input, click and button to launch a tool, and browse
    9 #  through output.
     6#  and produces a user interface automatically to drive an application.
     7#  The user can set up input, click and button to launch a tool, and
     8#  browse through output.
    109#
    1110#  RUN AS FOLLOWS:
    12 #    driver ?-tool <toolfile>? ?-config <configfile>?
     11#    driver ?-tool <toolfile>?
    1312#
    14 #  If the <toolfile> is not specified, this program looks for a
    15 #  file called "tool.xml" in the current directory.  If the <configfile>
    16 #  is not specified, it looks for "config.xml" in the current directory.
     13#  If the <toolfile> is not specified, it defaults to "tool.xml" in
     14#  the current working directory.
    1715#
    1816# ======================================================================
     
    4240option add *MainWin.bgColor white startupFile
    4341option add *Tooltip.background white
    44 
    45 image create photo in2out \
    46     -file [file join $Rappture::installdir scripts images in2out.gif]
     42option add *Editor.background white
     43option add *Gauge.textBackground white
     44option add *TemperatureGauge.textBackground white
    4745
    4846#
    4947# Process command line args to get the names of files to load...
    5048#
    51 set toolfile "tool.xml"
    52 set configfile "config.xml"
    53 
    54 while {[llength $argv] > 0} {
    55     set first [lindex $argv 0]
    56     set argv [lrange $argv 1 end]
    57 
    58     switch -- $first {
    59         -tool {
    60             if {[llength $argv] > 0} {
    61                 set toolfile [lindex $argv 0]
    62                 set argv [lrange $argv 1 end]
    63             } else {
    64                 puts stderr "$argv0: missing value for -tool"
    65                 exit 1
    66             }
    67         }
    68         -config {
    69             if {[llength $argv] > 0} {
    70                 set configfile [lindex $argv 0]
    71                 set argv [lrange $argv 1 end]
    72             } else {
    73                 puts stderr "$argv0: missing value for -tool"
    74                 exit 1
    75             }
    76         }
    77         default {
    78             puts stderr "usage: $argv0 ?-tool file? ?-config file?"
    79             exit 1
    80         }
    81     }
     49Rappture::getopts argv params {
     50    value -tool tool.xml
    8251}
    8352
    84 # open the XML file containing the material library
    85 set lib [Rappture::library -std library.xml]
    86                                                                                
    8753# open the XML file containing the tool parameters
    88 if {![file exists $toolfile]} {
    89     puts stderr "tool file \"$toolfile\" doesn't exist"
     54if {![file exists $params(-tool)]} {
     55    puts stderr "can't find tool \"$params(-tool)\""
    9056    exit 1
    9157}
    92 set tool [Rappture::library $toolfile]
    93                                                                                
    94 # open the XML file containing the configuration for this application
    95 if {![file exists $configfile]} {
    96     puts stderr "config file \"$configfile\" doesn't exist"
    97     exit 1
     58set xmlobj [Rappture::library $params(-tool)]
     59
     60set installdir [file dirname $params(-tool)]
     61if {"." == $installdir} {
     62    set installdir [pwd]
    9863}
    99 set config [Rappture::library $configfile]
    10064
    101 # ----------------------------------------------------------------------
    102 # From here on, run in the directory containing the tool.xml file,
    103 # so driver.xml files, etc., are created there
    104 # ----------------------------------------------------------------------
    105 cd [file dirname $toolfile]
    106 
    107 # ----------------------------------------------------------------------
    108 # USAGE: main_device_select
    109 #
    110 # Invoked automatically when a user selects a new device from the
    111 # "Devices:" combobox.  Plugs the new device into the device viewer.
    112 # ----------------------------------------------------------------------
    113 proc main_device_select {} {
    114     set win [.main component app]
    115     set val [$win.input.devsel.dev value]
    116     set val [$win.input.devsel.dev translate $val]
    117     $win.input.device configure -device $val
    118     $win.output.analyze configure -device $val
    119 }
     65set tool [Rappture::Tool ::#auto $xmlobj $installdir]
    12066
    12167# ----------------------------------------------------------------------
     
    12470wm withdraw .
    12571Rappture::MainWin .main -borderwidth 0
     72.main configure -title [$tool xml get tool.title]
     73wm withdraw .main
    12674
    127 .main configure -title [$config get title]
     75#
     76# The main window has a pager that acts as a notebook for the
     77# various parts.  This notebook as at least two pages--an input
     78# page and an output (analysis) page.  If there are <phase>'s
     79# for input, then there are more pages in the notebook.
     80#
     81set win [.main component app]
     82Rappture::Pager $win.pager
     83pack $win.pager -expand yes -fill both
    12884
    129 # build everything inside this main window
    130 set win [.main component app]
    131 #$win configure -background #a6a6a6
     85set phases [$tool xml children -type phase input]
     86if {[llength $phases] > 0} {
     87    set plist ""
     88    foreach name $phases {
     89        lappend plist input.$name
     90    }
     91    set phases $plist
     92} else {
     93    set phases input
     94}
    13295
    133 frame $win.input -borderwidth 12 -relief flat
    134 pack $win.input -side left -expand yes -fill both -padx {0 5}
     96foreach comp $phases {
     97    set title [$tool xml get $comp.about.label]
     98    if {$title == ""} {
     99        set title "Input #auto"
     100    }
     101    $win.pager insert end -name $comp -title $title
    135102
    136 frame $win.output -borderwidth 12 -relief flat
    137 pack $win.output -side left -expand yes -fill both -padx {5 0}
    138 
    139 # make an arrow that goes from input to output side
    140 #label $win.arrow -borderwidth 0 -image in2out
    141 #place $win.arrow -y 2 -anchor n
    142 #bind $win.input <Configure> [list align_arrow $win]
    143 #proc align_arrow {win} {
    144 #    place $win.arrow -x [expr {[winfo width $win.input]+5}]
    145 #}
    146 
    147 # ----------------------------------------------------------------------
    148 # INPUT AREA
    149 # ----------------------------------------------------------------------
    150 set w $win.input
    151 set dfirst ""
    152 set dlist [$config children -type structure controls]
    153 if {"" != $dlist} {
    154     foreach dname $dlist {
    155         set obj [$config element -flavor object controls.$dname]
    156         set name [$obj get label]
    157         set devs($name) $obj
    158     }
    159     set devlist [lsort [array names devs]]
    160 
    161     if {[array size devs] > 1} {
    162         frame $w.devsel
    163         pack $w.devsel -side top -fill x
    164         label $w.devsel.l -text "Device:"
    165         pack $w.devsel.l -side left
    166         Rappture::Combobox $w.devsel.dev -width 30 -editable no
    167         pack $w.devsel.dev -side left
    168         bind $w.devsel.dev <<Value>> main_device_select
    169 
    170         foreach name $devlist {
    171             $w.devsel.dev choices insert end $devs($name) $name
    172         }
    173         $w.devsel.dev value [lindex $devlist 0]
    174     }
    175 
    176     set first [lindex $devlist 0]
    177     set dfirst $devs($first)
    178     set tags [$dfirst children components]
    179     set i [lsearch $tags label]
    180     if {$i >= 0} {set tags [lreplace $tags $i $i]}
    181 
    182     if {$tags == "molecule"} {
    183         Rappture::MoleculeViewer $w.device -device $devs($first) \
    184             -library $lib
    185     } else {
    186         Rappture::DeviceViewer1D $w.device -device $devs($first) \
    187             -tool $tool -library $lib
    188     }
    189     pack $w.device -expand yes -fill both
    190 
    191     bind $w.device <<Edit>> [list $win.output.analyze reset]
     103    #
     104    # Build the page of input controls for this phase.
     105    #
     106    set f [$win.pager page $comp]
     107    Rappture::Page $f.cntls $tool $comp
     108    pack $f.cntls -expand yes -fill both
    192109}
    193110
     
    195112# OUTPUT AREA
    196113# ----------------------------------------------------------------------
    197 set w $win.output
    198 Rappture::Analyzer $w.analyze -holdwindow $win.input \
    199     -tool $tool -analysis [$config element -flavor object analysis] \
    200     -device $dfirst
    201 pack $w.analyze -expand yes -fill both
     114$win.pager insert end -name analyzer -title "Results"
     115set f [$win.pager page analyzer]
     116$win.pager page analyzer -command [list $f.analyze simulate -ifneeded]
     117
     118Rappture::Analyzer $f.analyze $tool -simcontrol auto
     119pack $f.analyze -expand yes -fill both
     120
     121$tool configure -analyzer $f.analyze
    202122
    203123# ----------------------------------------------------------------------
    204 # HOOK UP ANY CONTROLS CALLED OUT IN CONFIG.XML
     124# Finalize the arrangement
    205125# ----------------------------------------------------------------------
    206 proc controls_add {container libObj path} {
    207     set presets ""
    208     foreach pre [$libObj children -type preset $path] {
    209         lappend presets \
    210             [$libObj get $path.$pre.value] \
    211             [$libObj get $path.$pre.label]
    212     }
     126if {[llength [$win.pager page]] == 2} {
     127    set style [$xmlobj get tool.layout]
     128    set screenw [winfo screenwidth .]
    213129
    214     set type Rappture::Gauge
    215     set units [$libObj get $path.units]
    216     if {$units != ""} {
    217         set desc [Rappture::Units::description $units]
    218         if {[string match temperature* $desc]} {
    219             set type Rappture::TemperatureGauge
    220         }
    221     }
     130    update idletasks
     131    set w0 [winfo reqwidth [$win.pager page @0]]
     132    set w1 [winfo reqwidth [$win.pager page @1]]
    222133
    223     set counter 0
    224     set w "$container.gauge[incr counter]"
    225     while {[winfo exists $w]} {
    226         set w "$container.gauge[incr counter]"
    227     }
    228 
    229     # create the widget
    230     $type $w -units $units -presets $presets
    231     pack $w -side top -anchor w
    232 #    bind $w <<Value>> [itcl::code $this _controlSet $w $libObj $path]
    233 
    234     set min [$libObj get $path.min]
    235     if {"" != $min} { $w configure -minvalue $min }
    236 
    237     set max [$libObj get $path.max]
    238     if {"" != $max} { $w configure -maxvalue $max }
    239 
    240     set str [$libObj get $path.default]
    241     if {$str != ""} { $w value $str }
    242 
    243     if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
    244         set color [$libObj get $path.color]
    245         if {$color == ""} {
    246             set color blue
    247         }
    248         if {$units != ""} {
    249             set min [Rappture::Units::convert $min -to $units -units off]
    250             set max [Rappture::Units::convert $max -to $units -units off]
    251         }
    252         $w configure -spectrum [Rappture::Spectrum ::#auto [list \
    253             $min white $max $color] -units $units]
    254     }
    255 
    256     set str [$libObj get $path.label]
    257     if {$str != ""} {
    258         set help [$libObj get $path.help]
    259         if {"" != $help} {
    260             append str "\n$help"
    261         }
    262         if {$units != ""} {
    263             set desc [Rappture::Units::description $units]
    264             append str "\n(units of $desc)"
    265         }
    266         Rappture::Tooltip::for $w $str
    267     }
    268 
    269     set str [$libObj get $path.icon]
    270     if {$str != ""} {
    271         $w configure -image [image create photo -data $str]
     134    # if only two windows and they're small enough, put them up side-by-side
     135    if {$w0+$w1 < $screenw && $style != "wizard"} {
     136        $win.pager configure -arrangement side-by-side
     137        $f.analyze configure -holdwindow [$win.pager page @0] -simcontrol on
    272138    }
    273139}
    274 
    275 if {[winfo exists $win.input.device]} {
    276     foreach access [$config children -type access controls] {
    277         set name [$config get controls.$access]
    278         switch -glob -- $name {
    279             input.(ambient)* - structure* {
    280                 $win.input.device controls add $name
    281             }
    282         }
    283     }
    284 } else {
    285     foreach access [$config children -type access controls] {
    286         set name [$config get controls.$access]
    287         controls_add $win.input $tool $name
    288     }
    289     $w.analyze simulate
    290 }
     140wm deiconify .main
  • trunk/gui/scripts/analyzer.tcl

    r9 r11  
    1010# ======================================================================
    1111#  AUTHOR:  Michael McLennan, Purdue University
    12 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     12#  Copyright (c) 2004-2005
     13#  Purdue Research Foundation, West Lafayette, IN
    1314# ======================================================================
    1415package require Itk
    15 package require BLT
    16 
     16
     17option add *Analyzer.width 5i widgetDefault
     18option add *Analyzer.height 5i widgetDefault
     19option add *Analyzer.simControl "auto" widgetDefault
     20option add *Analyzer.simControlBackground "" widgetDefault
     21option add *Analyzer.simControlOutline gray widgetDefault
     22option add *Analyzer.simControlActiveBackground #ffffcc widgetDefault
     23option add *Analyzer.simControlActiveOutline black widgetDefault
     24
     25option add *Analyzer.font \
     26    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
    1727option add *Analyzer.textFont \
    1828    -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
     29option add *Analyzer.boldTextFont \
     30    -*-helvetica-bold-r-normal-*-*-120-* widgetDefault
    1931
    2032itcl::class Rappture::Analyzer {
    2133    inherit itk::Widget
    2234
    23     itk_option define -tool tool Tool ""
    24     itk_option define -device device Device ""
    25     itk_option define -analysis analysis Analysis ""
     35    itk_option define -textfont textFont Font ""
     36    itk_option define -boldtextfont boldTextFont Font ""
     37    itk_option define -simcontrol simControl SimControl ""
     38    itk_option define -simcontroloutline simControlOutline Background ""
     39    itk_option define -simcontrolbackground simControlBackground Background ""
     40    itk_option define -simcontrolactiveoutline simControlActiveOutline Background ""
     41    itk_option define -simcontrolactivebackground simControlActiveBackground Background ""
    2642    itk_option define -holdwindow holdWindow HoldWindow ""
    2743
    28     constructor {args} { # defined below }
     44    constructor {tool args} { # defined below }
    2945    destructor { # defined below }
    3046
    31     public method simulate {}
     47    public method simulate {args}
    3248    public method reset {}
    3349    public method load {file}
    34 
     50    public method clear {}
     51
     52    protected method _plot {args}
     53    protected method _reorder {comps}
     54    protected method _autoLabel {xmlobj path title cntVar}
    3555    protected method _fixResult {}
    36 
    37     private variable _run ""           ;# results from last run
     56    protected method _fixSize {}
     57    protected method _fixSimControl {}
     58    protected method _simState {state args}
     59
     60    private variable _tool ""          ;# belongs to this tool
    3861    private variable _control "manual" ;# start mode
    39     private variable _widgets          ;# maps analyze section => widget
     62    private variable _runs ""          ;# list of XML objects with results
     63    private variable _pages 0          ;# number of pages for result sets
     64    private variable _label2page       ;# maps output label => result set
     65    private variable _plotlist ""      ;# items currently being plotted
    4066
    4167    private common job                 ;# array var used for blt::bgexec jobs
     
    4975# CONSTRUCTOR
    5076# ----------------------------------------------------------------------
    51 itcl::body Rappture::Analyzer::constructor {args} {
     77itcl::body Rappture::Analyzer::constructor {tool args} {
     78    set _tool $tool
     79
     80    itk_option add hull.width hull.height
     81    pack propagate $itk_component(hull) no
     82
     83    frame $itk_interior.simol -borderwidth 1 -relief flat
     84    pack $itk_interior.simol -fill x
     85
     86    frame $itk_interior.simol.simbg -borderwidth 0
     87    pack $itk_interior.simol.simbg -expand yes -fill both
     88
     89    itk_component add simulate {
     90        button $itk_interior.simol.simbg.simulate -text "Simulate" \
     91            -command [itcl::code $this simulate]
     92    }
     93    pack $itk_component(simulate) -side left -padx 4 -pady 4
     94
     95    itk_component add simstatus {
     96        text $itk_interior.simol.simbg.simstatus -borderwidth 0 \
     97            -highlightthickness 0 -height 1 -width 1 -wrap none \
     98            -state disabled
     99    } {
     100        usual
     101        ignore -highlightthickness
     102        rename -font -textfont textFont Font
     103    }
     104    pack $itk_component(simstatus) -side left -expand yes -fill x
     105
     106    $itk_component(simstatus) tag configure popup \
     107        -underline 1 -foreground blue
     108
     109    $itk_component(simstatus) tag bind popup \
     110        <Enter> {%W configure -cursor center_ptr}
     111    $itk_component(simstatus) tag bind popup \
     112        <Leave> {%W configure -cursor ""}
     113    $itk_component(simstatus) tag bind popup \
     114        <ButtonPress> {after idle {Rappture::Tooltip::tooltip show %W}}
     115
     116
    52117    itk_component add notebook {
    53118        Rappture::Notebook $itk_interior.nb
    54119    }
    55120    pack $itk_interior.nb -expand yes -fill both
     121
     122    # ------------------------------------------------------------------
     123    # ABOUT PAGE
     124    # ------------------------------------------------------------------
     125    set w [$itk_component(notebook) insert end about]
     126
     127    Rappture::Scroller $w.info -xscrollmode off -yscrollmode auto
     128    pack $w.info -expand yes -fill both -padx 4 -pady 20
     129    itk_component add toolinfo {
     130        text $w.info.text -width 1 -height 1 -wrap word \
     131            -borderwidth 0 -highlightthickness 0
     132    } {
     133        usual
     134        ignore -borderwidth -relief
     135        rename -font -textfont textFont Font
     136    }
     137    $w.info contents $w.info.text
    56138
    57139    # ------------------------------------------------------------------
     
    60142    set w [$itk_component(notebook) insert end simulate]
    61143    frame $w.cntls
    62     pack $w.cntls -side top -fill x -padx {20 2}
    63 
    64     itk_component add simulate {
    65         button $w.cntls.sim -text "Simulate" \
    66             -command [itcl::code $this simulate]
    67     }
    68     pack $itk_component(simulate) -side left
    69 
    70     itk_component add status {
    71         label $w.cntls.info -width 1 -text "" -anchor w
    72     } {
    73         usual
    74         rename -font -textfont textFont Font
    75     }
    76     pack $itk_component(status) -side left -expand yes -fill both
     144    pack $w.cntls -side bottom -fill x -pady 12
     145    frame $w.cntls.sep -background black -height 1
     146    pack $w.cntls.sep -side top -fill x
     147
     148    itk_component add abort {
     149        button $w.cntls.abort -text "Abort" \
     150            -command [itcl::code $_tool abort]
     151    }
     152    pack $itk_component(abort) -side left -expand yes -padx 4 -pady 4
    77153
    78154    Rappture::Scroller $w.info -xscrollmode off -yscrollmode auto
    79     pack $w.info -expand yes -fill both -padx {20 2} -pady {20 2}
    80     itk_component add info {
     155    pack $w.info -expand yes -fill both -padx 4 -pady 4
     156    itk_component add runinfo {
    81157        text $w.info.text -width 1 -height 1 -wrap word \
    82158            -borderwidth 0 -highlightthickness 0 \
     
    94170    set w [$itk_component(notebook) insert end analyze]
    95171
     172    frame $w.top
     173    pack $w.top -side top -fill x -pady 8
     174    label $w.top.l -text "Result:" -font $itk_option(-font)
     175    pack $w.top.l -side left
     176
    96177    itk_component add resultselector {
    97         Rappture::Combobox $w.sel -width 30 -editable no
     178        Rappture::Combobox $w.top.sel -width 50 -editable no
    98179    } {
    99180        usual
    100181        rename -font -textfont textFont Font
    101182    }
    102     pack $itk_component(resultselector) -side top -fill x -padx {20 2}
     183    pack $itk_component(resultselector) -side left -expand yes -fill x
    103184    bind $itk_component(resultselector) <<Value>> [itcl::code $this _fixResult]
    104185
    105186    itk_component add results {
    106         Rappture::Notebook $w.nb
    107     }
    108     pack $itk_component(results) -expand yes -fill both -pady 4
     187        Rappture::Panes $w.pane
     188    }
     189    pack $itk_component(results) -expand yes -fill both
     190    set f [$itk_component(results) pane 0]
     191
     192    itk_component add resultpages {
     193        Rappture::Notebook $f.nb
     194    }
     195    pack $itk_component(resultpages) -expand yes -fill both
     196
     197    set f [$itk_component(results) insert end -fraction 0.1]
     198    itk_component add resultset {
     199        Rappture::ResultSet $f.rset \
     200            -clearcommand [itcl::code $this clear] \
     201            -settingscommand [itcl::code $this _plot] \
     202            -promptcommand [itcl::code $this _simState]
     203    }
     204    pack $itk_component(resultset) -expand yes -fill both
     205    bind $itk_component(resultset) <<Control>> [itcl::code $this _fixSize]
    109206
    110207    eval itk_initialize $args
     208
     209    #
     210    # Load up tool info on the first page.
     211    #
     212    $itk_component(toolinfo) tag configure title \
     213        -font $itk_option(-boldtextfont)
     214
     215    set mesg [$tool xml get tool.title]
     216    if {"" != $mesg} {
     217        $itk_component(toolinfo) insert end $mesg title
     218        $itk_component(toolinfo) insert end "\n\n"
     219    }
     220
     221    set mesg [$tool xml get tool.about]
     222    if {"" != $mesg} {
     223        $itk_component(toolinfo) insert end $mesg
     224    }
     225    $itk_component(toolinfo) configure -state disabled
     226    $itk_component(notebook) current about
     227
     228    # reset everything to a clean state
    111229    reset
     230
     231    # tool can run on "manual" (default) or "auto"
     232    set cntl [$tool xml get tool.control]
     233    if {"" != $cntl} {
     234        set _control $cntl
     235    }
    112236}
    113237
     
    116240# ----------------------------------------------------------------------
    117241itcl::body Rappture::Analyzer::destructor {} {
    118     if {$_run != ""} {
    119         itcl::delete object $_run
    120     }
    121 }
    122 
    123 # ----------------------------------------------------------------------
    124 # USAGE: simulate
    125 #
    126 # If the simulation page is showing, this kicks off the simulator
    127 # by executing the tool.command associated with the -tool.  While
    128 # the simulation is running, it shows status.  When the simulation is
    129 # finished, it switches automatically to "analyze" mode and shows
    130 # the results.
    131 # ----------------------------------------------------------------------
    132 itcl::body Rappture::Analyzer::simulate {} {
    133     if {[$itk_component(notebook) current] == "simulate"} {
    134         $itk_component(status) configure -text "Running simulation..."
    135         $itk_component(simulate) configure -text "Abort" \
    136             -command {set ::Rappture::Analyzer::job(control) abort}
    137 
    138         set job(control) ""
    139         set job(error) ""
    140 
    141         # if the hold window is set, then put up a busy cursor
    142         if {$itk_option(-holdwindow) != ""} {
    143             blt::busy hold $itk_option(-holdwindow)
    144             raise $itk_component(hull)
    145             update
    146         }
    147 
    148         # write out the driver.xml file for the tool
    149         set status [catch {
    150             set fid [open driver.xml w]
    151             puts $fid "<?xml version=\"1.0\"?>"
    152             set xml [$itk_option(-tool) xml]
    153             if {$itk_option(-device) != ""} {
    154                 set xml2 [$itk_option(-device) xml]
    155                 regsub -all {&} $xml2 {\\\&} xml2
    156                 regsub {</run>} $xml "$xml2</run>" xml
     242    foreach obj $_runs {
     243        itcl::delete object $obj
     244    }
     245    after cancel [itcl::code $this simulate]
     246}
     247
     248# ----------------------------------------------------------------------
     249# USAGE: simulate ?-ifneeded?
     250# USAGE: simulate ?<path1> <value1> <path2> <value2> ...?
     251#
     252# Kicks off the simulator by executing the tool.command associated
     253# with the tool.  If any arguments are specified, they are used to
     254# set parameters for the simulation.  While the simulation is running,
     255# it shows status.  When the simulation is finished, it switches
     256# automatically to "analyze" mode and shows the results.
     257# ----------------------------------------------------------------------
     258itcl::body Rappture::Analyzer::simulate {args} {
     259    if {$args == "-ifneeded"} {
     260        # check to see if simulation is really needed
     261        $_tool sync
     262        if {[$itk_component(resultset) contains [$_tool xml object]]} {
     263            # not needed -- show results and return
     264            $itk_component(notebook) current analyze
     265            return
     266        }
     267        set args ""
     268    }
     269
     270    # simulation is needed -- go to simulation page
     271    $itk_component(notebook) current simulate
     272
     273    _simState off
     274    $itk_component(runinfo) configure -state normal
     275    $itk_component(runinfo) delete 1.0 end
     276    $itk_component(runinfo) insert end "Running simulation..."
     277    $itk_component(runinfo) configure -state disabled
     278
     279    # if the hold window is set, then put up a busy cursor
     280    if {$itk_option(-holdwindow) != ""} {
     281        blt::busy hold $itk_option(-holdwindow)
     282        raise $itk_component(hull)
     283        update
     284    }
     285
     286    # execute the job
     287    foreach {status result} [eval $_tool run $args] break
     288
     289    # if job was aborted, then allow simulation again
     290    if {$result == "ABORT"} {
     291        _simState on "Aborted"
     292    }
     293
     294    # read back the results from run.xml
     295    if {$status == 0 && $result != "ABORT"} {
     296        if {[regexp {=RAPPTURE-RUN=>([^\n]+)} $result match file]} {
     297            set status [catch {load $file} msg]
     298            if {$status != 0} {
     299                set result $msg
    157300            }
    158             puts $fid $xml
    159             close $fid
    160         } result]
    161 
    162         # execute the tool using the path from the tool description
    163         if {$status == 0} {
    164             set cmd [$itk_option(-tool) get tool.command]
    165 
    166             set status [catch {eval blt::bgexec \
    167                 ::Rappture::Analyzer::job(control) \
    168                 -output ::Rappture::Analyzer::job(output) \
    169                 -error ::Rappture::Analyzer::job(error) $cmd} result]
    170         }
    171 
    172         # read back the results from run.xml
    173         if {$status == 0} {
    174             set status [catch {load run.xml} result]
    175         }
    176 
    177         # back to normal
    178         if {$itk_option(-holdwindow) != ""} {
    179             blt::busy release $itk_option(-holdwindow)
    180         }
    181         $itk_component(status) configure -text ""
    182         $itk_component(simulate) configure -text "Simulate" \
    183             -command [itcl::code $this simulate]
    184 
    185         # if anything went wrong, tell the user; otherwise, analyze
    186         if {[regexp {^KILLED} $job(control)]} {
    187             # job aborted -- do nothing
    188         } elseif {$status != 0} {
    189             $itk_component(info) configure -state normal
    190             $itk_component(info) delete 1.0 end
    191             $itk_component(info) insert end "Problem launching job:\n"
    192             if {[string length $job(error)] > 0} {
    193                 $itk_component(info) insert end $job(error)
    194             } else {
    195                 $itk_component(info) insert end $result
    196             }
    197             $itk_component(info) configure -state disabled
    198301        } else {
    199             $itk_component(notebook) current analyze
    200         }
     302            set status 1
     303            set result "Can't find result file in output:\n\n$result"
     304        }
     305    }
     306
     307    # back to normal
     308    if {$itk_option(-holdwindow) != ""} {
     309        blt::busy release $itk_option(-holdwindow)
     310    }
     311    $itk_component(abort) configure -state disabled
     312
     313    if {$status != 0} {
     314        $itk_component(runinfo) configure -state normal
     315        $itk_component(runinfo) delete 1.0 end
     316        $itk_component(runinfo) insert end "Problem launching job:\n\n"
     317        $itk_component(runinfo) insert end $result
     318        $itk_component(runinfo) configure -state disabled
     319    } else {
     320        $itk_component(notebook) current analyze
    201321    }
    202322}
     
    211331# ----------------------------------------------------------------------
    212332itcl::body Rappture::Analyzer::reset {} {
    213     $itk_component(notebook) current simulate
    214 
    215     # if control mode is "auto", then simulate right away
    216     if {[string match auto* $_control]} {
    217         simulate
     333    # check to see if simulation is really needed
     334    $_tool sync
     335    if {![$itk_component(resultset) contains [$_tool xml object]]} {
     336        # if control mode is "auto", then simulate right away
     337        if {[string match auto* $_control]} {
     338            # auto control -- don't need button
     339            pack forget $itk_interior.simol
     340
     341            after cancel [itcl::code $this simulate]
     342            after idle [itcl::code $this simulate]
     343        } else {
     344            _simState on "new input parameters"
     345        }
     346    } else {
     347        _simState off
    218348    }
    219349}
     
    222352# USAGE: load <file>
    223353#
    224 # Used to reset the analyzer whenever the input to a simulation has
    225 # changed.  Sets the mode back to "simulate", so the user has to
    226 # simulate again to see the output.
     354# Loads the data from the given <file> into the appropriate results
     355# sets.  If necessary, new results sets are created to store the data.
    227356# ----------------------------------------------------------------------
    228357itcl::body Rappture::Analyzer::load {file} {
    229     # clear any old results
    230     if {$_run != ""} {
    231         itcl::delete object $_run
    232         set _run ""
    233     }
    234 
    235358    # try to load new results from the given file
    236     set _run [Rappture::library $file]
    237 
    238     # go through the analysis and create widgets to display results
    239     foreach item [array names _widgets] {
    240         $_widgets($item) configure -output $_run
    241     }
     359    set xmlobj [Rappture::library $file]
     360    lappend _runs $xmlobj
     361
     362    # go through the analysis and find all result sets
     363    set haveresults 0
     364    foreach item [_reorder [$xmlobj children output]] {
     365        switch -glob -- $item {
     366            log* {
     367                _autoLabel $xmlobj output.$item "Output Log" counters
     368            }
     369            curve* - field* {
     370                _autoLabel $xmlobj output.$item "Plot" counters
     371            }
     372            table* {
     373                _autoLabel $xmlobj output.$item "Energy Levels" counters
     374            }
     375        }
     376        set label [$xmlobj get output.$item.about.label]
     377
     378        if {"" != $label} {
     379            set haveresults 1
     380        }
     381    }
     382
     383    # if there are any valid results, add them to the resultset
     384    if {$haveresults} {
     385        set size [$itk_component(resultset) size]
     386        set op [$itk_component(resultset) add $xmlobj]
     387
     388        # add each result to a result viewer
     389        foreach item [_reorder [$xmlobj children output]] {
     390            set label [$xmlobj get output.$item.about.label]
     391
     392            if {"" != $label} {
     393                if {![info exists _label2page($label)]} {
     394                    set name "page[incr _pages]"
     395                    set page [$itk_component(resultpages) insert end $name]
     396                    set _label2page($label) $page
     397                    Rappture::ResultViewer $page.rviewer
     398                    pack $page.rviewer -expand yes -fill both -pady 4
     399
     400                    $itk_component(resultselector) choices insert end \
     401                        $name $label
     402
     403                    #
     404                    # NOTE:
     405                    #
     406                    # If this result is showing up late in the game, then
     407                    # we must fill the resultviewer with a series of blank
     408                    # entries, so the latest result will align with (have
     409                    # the same index as) results in all other viewers.
     410                    #
     411                    for {set i 0} {$i < $size} {incr i} {
     412                        $page.rviewer add $xmlobj ""
     413                    }
     414                }
     415
     416                # add/replace the latest result into this viewer
     417                set page $_label2page($label)
     418                eval $page.rviewer $op [list $xmlobj output.$item]
     419            }
     420        }
     421    }
     422
     423    # if there is only one result page, take down the selector
     424    set w [$itk_component(notebook) page analyze]
     425    if {[$itk_component(resultselector) choices size] <= 1} {
     426        pack forget $w.top
     427    } else {
     428        pack $w.top -before $itk_component(results) -side top -fill x
     429    }
     430
     431    # show the first page by default
     432    set first [$itk_component(resultselector) choices get -label 0]
     433    if {$first != ""} {
     434        $itk_component(resultpages) current page1
     435        $itk_component(resultselector) value $first
     436    }
     437}
     438
     439# ----------------------------------------------------------------------
     440# USAGE: clear
     441#
     442# Discards all results previously loaded into the analyzer.
     443# ----------------------------------------------------------------------
     444itcl::body Rappture::Analyzer::clear {} {
     445    foreach obj $_runs {
     446        itcl::delete object $obj
     447    }
     448    set _runs ""
     449
     450    foreach label [array names _label2page] {
     451        set page $_label2page($label)
     452        $page.rviewer clear
     453    }
     454
     455    $itk_component(resultset) clear
     456    $itk_component(results) fraction end 0.1
     457
     458    _simState on
     459    _fixSimControl
     460}
     461
     462# ----------------------------------------------------------------------
     463# USAGE: _plot ?<index> <options> <index> <options>...?
     464#
     465# Used internally to update the plot shown in the current result
     466# viewer whenever the resultset settings have changed.  Causes the
     467# desired results to show up on screen.
     468# ----------------------------------------------------------------------
     469itcl::body Rappture::Analyzer::_plot {args} {
     470    set _plotlist $args
     471
     472    set page [$itk_component(resultselector) value]
     473    set page [$itk_component(resultselector) translate $page]
     474    set f [$itk_component(resultpages) page $page]
     475    $f.rviewer plot clear
     476    foreach {index opts} $_plotlist {
     477        $f.rviewer plot add $index $opts
     478    }
     479}
     480
     481# ----------------------------------------------------------------------
     482# USAGE: _reorder
     483#
     484# Used internally to change the order of a series of output components
     485# found in the <output> section.  Moves the <log> elements to the end
     486# and returns the updated list.
     487# ----------------------------------------------------------------------
     488itcl::body Rappture::Analyzer::_reorder {comps} {
     489    set i 0
     490    set max [llength $comps]
     491    while {$i < $max} {
     492        set c [lindex $comps $i]
     493        if {[string match log* $c]} {
     494            set comps [lreplace $comps $i $i]
     495            lappend comps $c
     496            incr max -1
     497        } else {
     498            incr i
     499        }
     500    }
     501    return $comps
     502}
     503
     504# ----------------------------------------------------------------------
     505# USAGE: _autoLabel <xmlobj> <path> <title> <cntVar>
     506#
     507# Used internally to check for an about.label property at the <path>
     508# in <xmlobj>.  If this object doesn't have a label, then one is
     509# supplied using the given <title>.  The <cntVar> is an array of
     510# counters in the calling scopes for titles that have been used
     511# in the past.  This is used to create titles like "Plot #2" the
     512# second time it is encountered.
     513#
     514# The <xmlobj> is updated so that the label is inserted directly in
     515# the tree.
     516# ----------------------------------------------------------------------
     517itcl::body Rappture::Analyzer::_autoLabel {xmlobj path title cntVar} {
     518    upvar $cntVar counters
     519
     520    set label [$xmlobj get $path.about.label]
     521    if {"" == $label} {
     522        # no label -- make one up using the title specified
     523        if {![info exists counters($title)]} {
     524            set counters($title) 1
     525            set label $title
     526        } else {
     527            set label "$title #[incr counters($title)]"
     528        }
     529        $xmlobj put $path.about.label $label
     530    } else {
     531        # handle the case of two identical labels in <output>
     532        if {![info exists counters($label)]} {
     533            set counters($label) 1
     534        } else {
     535            set label "$label #[incr counters($label)]"
     536            $xmlobj put $path.about.label $label
     537        }
     538    }
     539    return $label
    242540}
    243541
     
    251549    set page [$itk_component(resultselector) value]
    252550    set page [$itk_component(resultselector) translate $page]
    253     $itk_component(results) current $page
    254 }
    255 
    256 # ----------------------------------------------------------------------
    257 # CONFIGURATION OPTION: -tool
    258 #
    259 # Set to the Rappture::library object representing the tool being
    260 # run in this analyzer.
    261 # ----------------------------------------------------------------------
    262 itcl::configbody Rappture::Analyzer::tool {
    263     if {![Rappture::library isvalid $itk_option(-tool)]} {
    264         error "bad value \"$itk_option(-tool)\": should be Rappture::library"
    265     }
    266 
    267     $itk_component(info) configure -state normal
    268     $itk_component(info) delete 1.0 end
    269     $itk_component(info) insert end [$itk_option(-tool) get tool.about]
    270     $itk_component(info) configure -state disabled
    271 }
    272 
    273 # ----------------------------------------------------------------------
    274 # CONFIGURATION OPTION: -device
    275 #
    276 # Set to the Rappture::library object representing the device being
    277 # run in this analyzer.
    278 # ----------------------------------------------------------------------
    279 itcl::configbody Rappture::Analyzer::device {
    280     if {$itk_option(-device) != ""
    281           && ![Rappture::library isvalid $itk_option(-device)]} {
    282         error "bad value \"$itk_option(-device)\": should be Rappture::library"
    283     }
    284     reset
    285 }
    286 
    287 # ----------------------------------------------------------------------
    288 # CONFIGURATION OPTION: -analysis
    289 #
    290 # Set to the Rappture::library object representing the analysis that
    291 # should be shown in this analyzer.
    292 # ----------------------------------------------------------------------
    293 itcl::configbody Rappture::Analyzer::analysis {
    294     if {![Rappture::library isvalid $itk_option(-analysis)]} {
    295         error "bad value \"$itk_option(-analysis)\": should be Rappture::library"
    296     }
    297     set _control [$itk_option(-analysis) get control]
    298 
    299     # go through the analysis and create widgets to display results
    300     $itk_component(results) delete -all
    301     catch {unset _widgets}
    302 
    303     set counter 0
    304     foreach item [$itk_option(-analysis) children] {
    305         switch -glob -- $item {
    306             xyplot* {
    307                 set name "page[incr counter]"
    308                 set label [$itk_option(-analysis) get $item.label]
    309                 if {$label == ""} { set label $name }
    310 
    311                 set page [$itk_component(results) insert end $name]
    312                 $itk_component(resultselector) choices insert end \
    313                     $name $label
    314 
    315                 set _widgets($item) [Rappture::Xyplot $page.#auto \
    316                     -layout [$itk_option(-analysis) element -flavor object $item]]
    317                 pack $_widgets($item) -expand yes -fill both
     551    $itk_component(resultpages) current $page
     552
     553    set f [$itk_component(resultpages) page $page]
     554    $f.rviewer plot clear
     555    eval $f.rviewer plot add $_plotlist
     556}
     557
     558# ----------------------------------------------------------------------
     559# USAGE: _fixSize
     560#
     561# Used internally to change the size of the result set area whenever
     562# a new control appears.  Adjusts the size available for the result
     563# set up to some maximum.
     564# ----------------------------------------------------------------------
     565itcl::body Rappture::Analyzer::_fixSize {} {
     566    set f [$itk_component(results) fraction end]
     567    if {$f < 0.4} {
     568        $itk_component(results) fraction end [expr {$f+0.15}]
     569    }
     570    _fixSimControl
     571}
     572
     573# ----------------------------------------------------------------------
     574# USAGE: _simState <boolean> ?<message>? ?<settings>?
     575#
     576# Used internally to change the "Simulation" button on or off.
     577# If the <boolean> is on, then any <message> and <settings> are
     578# displayed as well.  The <message> is a note to the user about
     579# what will be simulated, and the <settings> are a list of
     580# tool parameter settings of the form {path1 val1 path2 val2 ...}.
     581# When these are in place, the next Simulate operation will use
     582# these settings.  This helps fill in missing data values.
     583# ----------------------------------------------------------------------
     584itcl::body Rappture::Analyzer::_simState {state args} {
     585    if {$state} {
     586        $itk_interior.simol configure \
     587            -background $itk_option(-simcontrolactiveoutline)
     588        $itk_interior.simol.simbg configure \
     589            -background $itk_option(-simcontrolactivebackground)
     590        $itk_component(simulate) configure \
     591            -highlightbackground $itk_option(-simcontrolactivebackground)
     592        $itk_component(simstatus) configure \
     593            -background $itk_option(-simcontrolactivebackground)
     594
     595        $itk_component(abort) configure -state disabled
     596        $itk_component(simulate) configure -state normal \
     597            -command [itcl::code $this simulate]
     598
     599        #
     600        # If there's a special message, then put it up next to the button.
     601        #
     602        set mesg [lindex $args 0]
     603        if {"" != $mesg} {
     604            $itk_component(simstatus) configure -state normal
     605            $itk_component(simstatus) delete 1.0 end
     606            $itk_component(simstatus) insert end $mesg
     607
     608            #
     609            # If there are any settings, then install them in the
     610            # "Simulate" button.  Also, pop them up as a tooltip
     611            # for the message.
     612            #
     613            set settings [lindex $args 1]
     614            if {[llength $settings] > 0} {
     615                $itk_component(simulate) configure \
     616                    -command [eval itcl::code $this simulate $settings]
     617
     618                set details ""
     619                foreach {path val} $settings {
     620                    set str [$_tool xml get $path.about.label]
     621                    if {"" == $str} {
     622                        set str [$_tool xml element -as id $path]
     623                    }
     624                    append details "$str = $val\n"
     625                }
     626                set details [string trim $details]
     627
     628                Rappture::Tooltip::for $itk_component(simstatus) $details
     629                $itk_component(simstatus) insert end " "
     630                $itk_component(simstatus) insert end "(details...)" popup
    318631            }
    319             elevels* {
    320                 set name "page[incr counter]"
    321 
    322                 set page [$itk_component(results) insert end $name]
    323                 $itk_component(resultselector) choices insert end \
    324                     $name "Energy Levels"
    325 
    326                 set _widgets($item) [Rappture::EnergyLevels $page.#auto \
    327                     -layout [$itk_option(-analysis) element -flavor object $item]]
    328                 pack $_widgets($item) -expand yes -fill both
     632            $itk_component(simstatus) configure -state disabled
     633        }
     634    } else {
     635        if {"" != $itk_option(-simcontrolbackground)} {
     636            set simcbg $itk_option(-simcontrolbackground)
     637        } else {
     638            set simcbg $itk_option(-background)
     639        }
     640        $itk_interior.simol configure \
     641            -background $itk_option(-simcontroloutline)
     642        $itk_interior.simol.simbg configure -background $simcbg
     643        $itk_component(simulate) configure -highlightbackground $simcbg
     644        $itk_component(simstatus) configure -background $simcbg
     645
     646        $itk_component(simulate) configure -state disabled
     647        $itk_component(abort) configure -state normal
     648
     649        $itk_component(simstatus) configure -state normal
     650        $itk_component(simstatus) delete 1.0 end
     651        $itk_component(simstatus) configure -state disabled
     652        Rappture::Tooltip::for $itk_component(simstatus) ""
     653    }
     654}
     655
     656# ----------------------------------------------------------------------
     657# USAGE: _fixSimControl
     658#
     659# Used internally to add or remove the simulation control at the
     660# top of the analysis area.  This is controlled by the -simcontrol
     661# option.
     662# ----------------------------------------------------------------------
     663itcl::body Rappture::Analyzer::_fixSimControl {} {
     664    switch -- $itk_option(-simcontrol) {
     665        on {
     666            pack $itk_interior.simol -fill x -before $itk_interior.nb
     667        }
     668        off {
     669            pack forget $itk_interior.simol
     670        }
     671        auto {
     672            #
     673            # If we have two or more radiodials, then there is a
     674            # chance of encountering a combination of parameters
     675            # with no data, requiring simulation.
     676            #
     677            if {[$itk_component(resultset) size -controls] >= 2} {
     678                pack $itk_interior.simol -fill x -before $itk_interior.nb
     679            } else {
     680                pack forget $itk_interior.simol
    329681            }
    330682        }
    331     }
    332 
    333     # if there is only one page, take down the selector
    334     if {[$itk_component(resultselector) choices size] <= 1} {
    335         pack forget $itk_component(resultselector)
    336     } else {
    337         pack $itk_component(resultselector) -before $itk_component(results) \
    338             -side top -fill x -padx {20 2}
    339     }
    340 
    341     # show the first page by default
    342     set first [$itk_component(resultselector) choices get -label 0]
    343     if {$first != ""} {
    344         $itk_component(results) current page1
    345         $itk_component(resultselector) value $first
    346     }
    347 }
     683        default {
     684            error "bad value \"$itk_option(-simcontrol)\": should be on, off, auto"
     685        }
     686    }
     687}
     688
     689# ----------------------------------------------------------------------
     690# CONFIGURATION OPTION: -simcontrol
     691#
     692# Controls whether or not the Simulate button is showing.  In some
     693# cases, it is not needed.
     694# ----------------------------------------------------------------------
     695itcl::configbody Rappture::Analyzer::simcontrol {
     696    _fixSimControl
     697}
  • trunk/gui/scripts/animover.tcl

    r1 r11  
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    9 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     9#  Copyright (c) 2004-2005
     10#  Purdue Research Foundation, West Lafayette, IN
    1011# ======================================================================
    1112package require Itk
  • trunk/gui/scripts/combobox.tcl

    r1 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itk
     
    121122        }
    122123
    123         event generate $itk_component(hull) <<Value>>
     124        after 10 [list event generate $itk_component(hull) <<Value>>]
    124125    } elseif {[llength $args] != 0} {
    125126        error "wrong # args: should be \"value ?newval?\""
  • trunk/gui/scripts/curve.tcl

    r6 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itcl
     
    1718
    1819itcl::class Rappture::Curve {
    19     constructor {libobj path} { # defined below }
     20    constructor {xmlobj path} { # defined below }
    2021    destructor { # defined below }
    2122
    2223    public method components {{pattern *}}
    23     public method vectors {{what -overall}}
    24     public method controls {option args}
     24    public method mesh {{what -overall}}
     25    public method values {{what -overall}}
     26    public method limits {which}
    2527    public method hints {{key ""}}
    2628
    2729    protected method _build {}
    2830
    29     private variable _libobj ""  ;# ref to lib obj with curve data
     31    private variable _xmlobj ""  ;# ref to lib obj with curve data
    3032    private variable _curve ""   ;# lib obj representing this curve
    31     private variable _comp2vecs  ;# maps component name => x,y vectors
     33    private variable _comp2xy    ;# maps component name => x,y vectors
    3234
    3335    private common _counter 0    ;# counter for unique vector names
     
    3739# CONSTRUCTOR
    3840# ----------------------------------------------------------------------
    39 itcl::body Rappture::Curve::constructor {libobj path} {
    40     if {![Rappture::library isvalid $libobj]} {
    41         error "bad value \"$libobj\": should be LibraryObj"
    42     }
    43     set _libobj $libobj
    44     set _curve [$libobj element -flavor object $path]
     41itcl::body Rappture::Curve::constructor {xmlobj path} {
     42    if {![Rappture::library isvalid $xmlobj]} {
     43        error "bad value \"$xmlobj\": should be LibraryObj"
     44    }
     45    set _xmlobj $xmlobj
     46    set _curve [$xmlobj element -as object $path]
    4547
    4648    # build up vectors for various components of the curve
     
    5355itcl::body Rappture::Curve::destructor {} {
    5456    itcl::delete object $_curve
    55     # don't destroy the _libobj! we don't own it!
    56 
    57     foreach name [array names _comp2vecs] {
    58         eval blt::vector destroy $_comp2vecs($name)
     57    # don't destroy the _xmlobj! we don't own it!
     58
     59    foreach name [array names _comp2xy] {
     60        eval blt::vector destroy $_comp2xy($name)
    5961    }
    6062}
     
    6971itcl::body Rappture::Curve::components {{pattern *}} {
    7072    set rlist ""
    71     foreach name [array names _comp2vecs] {
     73    foreach name [array names _comp2xy] {
    7274        if {[string match $pattern $name]} {
    7375            lappend rlist $name
     
    7880
    7981# ----------------------------------------------------------------------
    80 # USAGE: vectors ?<name>?
    81 #
    82 # Returns a list {xvec yvec} for the specified curve component <name>.
     82# USAGE: mesh ?<name>?
     83#
     84# Returns the xvec for the specified curve component <name>.
    8385# If the name is not specified, then it returns the vectors for the
    8486# overall curve (sum of all components).
    8587# ----------------------------------------------------------------------
    86 itcl::body Rappture::Curve::vectors {{what -overall}} {
    87     if {[info exists _comp2vecs($what)]} {
    88         return $_comp2vecs($what)
    89     }
    90     error "bad option \"$what\": should be [join [lsort [array names _comp2vecs]] {, }]"
     88itcl::body Rappture::Curve::mesh {{what -overall}} {
     89    if {[info exists _comp2xy($what)]} {
     90        return [lindex $_comp2xy($what) 0]  ;# return xv
     91    }
     92    error "bad option \"$what\": should be [join [lsort [array names _comp2xy]] {, }]"
     93}
     94
     95# ----------------------------------------------------------------------
     96# USAGE: values ?<name>?
     97#
     98# Returns the xvec for the specified curve component <name>.
     99# If the name is not specified, then it returns the vectors for the
     100# overall curve (sum of all components).
     101# ----------------------------------------------------------------------
     102itcl::body Rappture::Curve::values {{what -overall}} {
     103    if {[info exists _comp2xy($what)]} {
     104        return [lindex $_comp2xy($what) 1]  ;# return yv
     105    }
     106    error "bad option \"$what\": should be [join [lsort [array names _comp2xy]] {, }]"
     107}
     108
     109# ----------------------------------------------------------------------
     110# USAGE: limits x|y
     111#
     112# Returns the {min max} limits for the specified axis.
     113# ----------------------------------------------------------------------
     114itcl::body Rappture::Curve::limits {which} {
     115    set min ""
     116    set max ""
     117    switch -- $which {
     118        x { set pos 0 }
     119        y { set pos 1 }
     120        default {
     121            error "bad option \"$which\": should be x or y"
     122        }
     123    }
     124    foreach comp [array names _comp2xy] {
     125        set vname [lindex $_comp2xy($comp) $pos]
     126        $vname variable vec
     127        if {"" == $min} {
     128            set min $vec(min)
     129        } elseif {$vec(min) < $min} {
     130            set min $vec(min)
     131        }
     132        if {"" == $max} {
     133            set max $vec(max)
     134        } elseif {$vec(max) > $max} {
     135            set max $vec(max)
     136        }
     137    }
     138    return [list $min $max]
    91139}
    92140
     
    116164    }
    117165
     166    if {[info exists hints(xlabel)] && "" != $hints(xlabel)
     167          && [info exists hints(xunits)] && "" != $hints(xunits)} {
     168        set hints(xlabel) "$hints(xlabel) ($hints(xunits))"
     169    }
     170    if {[info exists hints(ylabel)] && "" != $hints(ylabel)
     171          && [info exists hints(yunits)] && "" != $hints(yunits)} {
     172        set hints(ylabel) "$hints(ylabel) ($hints(yunits))"
     173    }
     174
    118175    if {$keyword != ""} {
    119176        if {[info exists hints($keyword)]} {
     
    135192itcl::body Rappture::Curve::_build {} {
    136193    # discard any existing data
    137     foreach name [array names _comp2vecs] {
    138         eval blt::vector destroy $_comp2vecs($name)
    139     }
    140     catch {unset _comp2vecs}
     194    foreach name [array names _comp2xy] {
     195        eval blt::vector destroy $_comp2xy($name)
     196    }
     197    catch {unset _comp2xy}
    141198
    142199    #
     
    162219
    163220        if {$xv != "" && $yv != ""} {
    164             set _comp2vecs($cname) [list $xv $yv]
     221            set _comp2xy($cname) [list $xv $yv]
    165222            incr _counter
    166223        }
  • trunk/gui/scripts/deviceLayout1D.tcl

    r9 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itk
     
    2526
    2627    itk_option define -font font Font ""
    27     itk_option define -library library Library ""
    2828    itk_option define -device device Device ""
    2929    itk_option define -devicesize deviceSize DeviceSize 0
     
    4040    protected method _redraw {}
    4141    protected method _drawLayer {index x0 x1}
    42     protected method _drawMolecule {index x0 x1}
     42    protected method _drawIcon {index x0 x1 imh}
    4343    protected method _drawAnnotation {index x0 x1}
    4444    protected method _mater2color {mater}
     
    4747    private variable _sizes         ;# maps size name => pixels
    4848
    49     private variable _library ""    ;# LibraryObj for library information
    5049    private variable _device ""     ;# LibraryObj for device representation
    5150    private variable _slabs ""      ;# list of node names for slabs in device
    5251    private variable _z0 ""         ;# list parallel to _slabs with z0
    5352                                    ;#   coord for lhs of each slab
    54     private variable _zthick ""     ;# list parallel to _slabs with thickness
    55                                     ;#   for each slab
     53    private variable _z1 ""         ;# list parallel to _slabs with z1
     54                                    ;#   coord for rhs of each slab
    5655    private variable _maters ""     ;# list parallel to _slabs with material
    5756                                    ;#   for each slab
     57    private variable _colors ""     ;# list parallel to _slabs with color
     58                                    ;#   for each slab
    5859
    5960    private variable _controls      ;# maps control path => status on/off
    6061
    61     private common _icons
    62     set _icons(molecule) [image create photo -file \
    63         [file join $Rappture::installdir scripts images molecule.gif]]
     62    private variable _icons         ;# maps icon data => image handle
    6463}
    6564                                                                               
    6665itk::usual DeviceLayout1D {
    6766    keep -background -cursor
    68     keep -library -device
    69     keep -deviceoutline -devicesize
     67    keep -device -deviceoutline -devicesize
    7068    keep -selectbackground -selectforeground -selectborderwidth
    7169    keep -width
     
    112110    }
    113111    set zmin [lindex $_z0 0]
    114     set zmax [lindex $_z0 end]
     112    set zmax [lindex $_z1 end]
    115113    return [list $zmin $zmax]
    116114}
     
    166164itcl::body Rappture::DeviceLayout1D::_layout {} {
    167165    # first, recompute the overall height of this widget
    168     set h [expr {$_sizes(bar)+$_sizes(bar45)+20}]
     166    set h [expr {$_sizes(bar)+$_sizes(bar45)+2}]
    169167
    170168    set fnt $itk_option(-font)
    171     if {[regexp {\.material} [array names _controls]]} {
    172         # one of the slabs has its material displayed
    173         set extra [expr {1.2*[font metrics $fnt -linespace]}]
    174         set h [expr {$h+$extra}]
    175     }
    176     if {[regexp {\.thickness} [array names _controls]]} {
    177         # one of the slabs has its thickness displayed
    178         set extra [expr {1.2*[font metrics $fnt -linespace]}]
    179         set h [expr {$h+$extra}]
     169    # see if any of the slabs has a material
     170    foreach m $_maters {
     171        if {"" != $m} {
     172            set extra [expr {1.5*[font metrics $fnt -linespace]}]
     173            set h [expr {$h+$extra}]
     174            break
     175        }
    180176    }
    181177
     
    191187    }
    192188
    193     # a little extra height for the molecule image
    194     if {"" != [$_device element components.molecule]} {
    195         set h [expr {$h+15}]
    196     }
    197 
    198189    set oldh [component hull cget -height]
    199190    if {$h != $oldh} {
     
    205196    set slabs ""
    206197    set z0 ""
    207     set zthick ""
     198    set z1 ""
    208199    set maters ""
    209 
    210     set z 0
     200    set colors ""
     201
    211202    if {$_device != ""} {
     203        # get the default system of units
     204        set units [set defunits [$_device get units]]
     205        if {$units == "arbitrary"} {
     206            set defunits "m"
     207            set units "um"
     208        }
     209
    212210        foreach nn [$_device children components] {
    213211            switch -glob -- $nn {
    214                 slab* - molecule* {
    215                     set tval [$_device get components.$nn.thickness]
    216                     set tval [Rappture::Units::convert $tval \
    217                         -context um -to um -units off]
     212                box* {
     213                    # get x-coord for each corner
     214                    set c0 [lindex [$_device get components.$nn.corner0] 0]
     215                    set c0 [Rappture::Units::convert $c0 \
     216                        -context $defunits -to $units -units off]
     217
     218                    set c1 [lindex [$_device get components.$nn.corner1] 0]
     219                    set c1 [Rappture::Units::convert $c1 \
     220                        -context $defunits -to $units -units off]
     221
    218222                    lappend slabs components.$nn
    219                     lappend z0 $z
    220                     lappend zthick $tval
    221                     lappend maters [$_device get components.$nn.material]
    222 
    223                     set z [expr {$z+$tval}]
     223                    lappend z0 $c0
     224                    lappend z1 $c1
     225
     226                    set m [$_device get components.$nn.material]
     227                    lappend maters $m
     228
     229                    if {"" != $m} {
     230                        set c [_mater2color $m]
     231                    } else {
     232                        set c [$_device get components.$nn.about.color]
     233                    }
     234                    if {"" == $c} { set c gray }
     235                    lappend colors $c
    224236                }
    225237                default {
     
    229241        }
    230242    }
    231     lappend z0 $z
    232243
    233244    # something change? then store new layout and redraw
    234245    if {![string equal $z0 $_z0]
    235           || ![string equal $zthick $_zthick]
    236           || ![string equal $maters $_maters]} {
     246          || ![string equal $z1 $_z1]
     247          || ![string equal $maters $_maters]
     248          || ![string equal $colors $_colors]} {
    237249        set _slabs $slabs
    238250        set _z0 $z0
    239         set _zthick $zthick
     251        set _z1 $z1
    240252        set _maters $maters
     253        set _colors $colors
    241254
    242255        $_dispatcher event -idle !redraw
     
    254267
    255268    # clean up images and delete all other items
    256     foreach item [$c find withtag image] {
    257         image delete [$c itemcget $item -image]
    258     }
    259269    $c delete all
    260270
     
    264274    set x1 [expr {$x0 + $w}]
    265275
    266     set zmax [lindex $_z0 end]
     276    set zmax [lindex $_z1 end]
    267277    set xx0 $x0
    268278    set xx1 $x1
    269279
    270     set drewslab 0
    271280    for {set i 0} {$i < [llength $_slabs]} {incr i} {
    272281        set name [lindex $_slabs $i]
    273         if {[regexp {slab[0-9]*$} $name]} {
    274             set z0 [lindex $_z0 $i]
    275             set zthick [lindex $_zthick $i]
    276             set xx0 [expr {double($z0)/$zmax * ($x1-$x0) + $x0}]
    277             set xx1 [expr {double($z0+$zthick)/$zmax * ($x1-$x0) + $x0}]
     282        set z0 [lindex $_z0 $i]
     283        set z1 [lindex $_z1 $i]
     284        set xx0 [expr {double($z0)/$zmax * ($x1-$x0) + $x0}]
     285        set xx1 [expr {double($z1)/$zmax * ($x1-$x0) + $x0}]
     286
     287        set icon [$_device get $name.about.icon]
     288        if {"" != $icon} {
     289            if {[info exists _icons($icon)]} {
     290                set imh $_icons($icon)
     291            } else {
     292                set imh [image create photo -data $icon]
     293                set _icons($icon) $imh
     294            }
     295            _drawIcon $i $xx0 $xx1 $imh
     296        } else {
    278297            _drawLayer $i $xx0 $xx1
    279             _drawAnnotation $i $xx0 $xx1
    280             set drewslab 1
    281         } else {
    282             if {$drewslab} {
    283                 _drawLayer cap $xx0 $xx1  ;# draw the end cap
    284                 set drewslab 0
    285             }
    286             if {[regexp {molecule[0-9]*$} $name]} {
    287                 set z0 [lindex $_z0 $i]
    288                 set zthick [lindex $_zthick $i]
    289                 set xx0 [expr {double($z0)/$zmax * ($x1-$x0) + $x0}]
    290                 set xx1 [expr {double($z0+$zthick)/$zmax * ($x1-$x0) + $x0}]
    291                 _drawMolecule $i $xx0 $xx1
    292                 _drawAnnotation $i $xx0 $xx1
    293             }
    294         }
    295     }
    296     if {[llength $_slabs] > 0} {
    297         _drawLayer cap $xx0 $xx1  ;# draw the end cap
     298        }
     299        _drawAnnotation $i $xx0 $xx1
    298300    }
    299301}
     
    309311    set c $itk_component(area)
    310312    set h [expr {[winfo height $c]-1}]
    311     # a little extra height for the molecule image
    312     if {"" != [$_device element components.molecule]} {
    313         set h [expr {$h-15}]
    314     }
    315313
    316314    set y0 $h
     
    324322    set lcolor $itk_option(-deviceoutline)
    325323
    326     if {$index == "cap"} {
    327         #
    328         # Draw the outline around the end cap
    329         #
    330         $c create line $x1 $y0  $x1 $y1p  $x1p $y1 -fill $lcolor
    331 
    332     } elseif {$index < [llength $_slabs]} {
    333         set fcolor [_mater2color [lindex $_maters $index]]
     324    if {$index < [llength $_slabs]} {
     325        set fcolor [lindex $_colors $index]
    334326
    335327        #
     
    347339            -outline $lcolor -fill $fcolor
    348340        $c create line $x0 $y1p  $x1 $y1p -fill $lcolor
    349     }
    350 }
    351 
    352 # ----------------------------------------------------------------------
    353 # USAGE: _drawMolecule <index> <x0> <x1>
    354 #
    355 # Used internally within _redraw to draw one molecule layer at the
    356 # <index> within the slab list into the active area.  The layer is
    357 # drawn between coordinates <x0> and <x1> on the canvas.
    358 # ----------------------------------------------------------------------
    359 itcl::body Rappture::DeviceLayout1D::_drawMolecule {index x0 x1} {
     341
     342        #
     343        # Draw the outline around the end cap
     344        #
     345        $c create line $x1 $y0  $x1 $y1p  $x1p $y1 -fill $lcolor
     346    }
     347}
     348
     349# ----------------------------------------------------------------------
     350# USAGE: _drawIcon <index> <x0> <x1> <imh>
     351#
     352# Used internally within _redraw to draw a material layer that is
     353# represented by an icon.  The layer sits at <index> within the slab
     354# list into the active area.  The layer is drawn between coordinates
     355# <x0> and <x1> on the canvas.
     356# ----------------------------------------------------------------------
     357itcl::body Rappture::DeviceLayout1D::_drawIcon {index x0 x1 imh} {
    360358    set c $itk_component(area)
    361359    set h [expr {[winfo height $c]-1}]
    362     # a little extra height for the molecule image
    363     if {"" != [$_device element components.molecule]} {
    364         set h [expr {$h-15}]
    365     }
    366360
    367361    set y0 $h
     
    370364    set y1 [expr {$y1p-$_sizes(bar45)}]
    371365    set x0p [expr {$x0+$_sizes(bar45)}]
    372 
    373     set x [expr {0.5*($x0+$x0p)}]
     366    set x1p [expr {$x1+$_sizes(bar45)}]
     367
     368    set xx0 [expr {0.5*($x0+$x0p)}]
     369    set xx1 [expr {0.5*($x1+$x1p)}]
    374370    set y [expr {0.5*($y0+$y0p) + 0.5*($y1-$y0p)}]
    375371
    376     set w [image width $_icons(molecule)]
    377     set h [image height $_icons(molecule)]
    378     set dx [expr {round($x1-$x0)}]
    379     set dy [expr {round(double($x1-$x0)/$w*$h)}]
    380     set imh [image create photo -width $dx -height $dy]
    381     blt::winop resample $_icons(molecule) $imh
    382 
    383     $c create image $x $y -anchor w -image $imh -tags image
     372    ##set lcolor $itk_option(-deviceoutline)
     373    ##$c create line $xx0 $y $xx1 $y -width 3
     374
     375    $c create image [expr {0.5*($xx0+$xx1)}] $y -anchor c -image $imh
    384376}
    385377
     
    394386    set c $itk_component(area)
    395387    set h [expr {[winfo height $c]-1}]
    396     # a little extra height for the molecule image
    397     if {"" != [$_device element components.molecule]} {
    398         set h [expr {$h-15}]
    399     }
    400388
    401389    set y0 $h
     
    409397    set lh [font metrics $fnt -linespace]
    410398    set ymid [expr {$y1-2-0.5*$lh}]
    411     set y [expr {$y1-2}]
    412 
    413     #
    414     # If there's a .thickness control for this slab, draw it here.
    415     #
    416     set elem [lindex $_slabs $index]
    417     set path "structure.$elem.thickness"
    418     if {[info exists _controls($path)] && $_controls($path)} {
    419         set zthick [lindex $_zthick $index]
    420         set zthick [Rappture::Units::convert $zthick -context um -to um]
    421 
    422         $c create line $x0p $y $x0p [expr {$y-$lh}]
    423         $c create line $x1p $y $x1p [expr {$y-$lh}]
    424 
    425         $c create line $x0p $ymid $x1p $ymid -arrow both
    426         $c create text $xmid [expr {$ymid-2}] -anchor s -text $zthick
    427         set y [expr {$y-2.0*$lh}]
    428     }
     399    set y [expr {$y1-4}]
    429400
    430401    #
     
    432403    #
    433404    set elem [lindex $_slabs $index]
    434     set path "structure.$elem.material"
    435     if {[info exists _controls($path)] && $_controls($path)} {
    436         set mater [lindex $_maters $index]
    437         set w [expr {12+[font measure $fnt $mater]}]
    438         set x [expr {$x1p - 0.5*($x1p-$x0p-$w)}]
    439         $c create rectangle [expr {$x-10}] [expr {$y-10}] \
    440             $x $y -outline black -fill [_mater2color $mater]
    441         $c create text [expr {$x-12}] [expr {$y-5}] -anchor e \
     405    set mater [lindex $_maters $index]
     406    if {"" != $mater} {
     407        set x $x1p
     408        $c create rectangle [expr {$x-10}] [expr {$y-14}] \
     409            [expr {$x-0}] [expr {$y-4}] \
     410            -outline black -fill [_mater2color $mater]
     411        set x [expr {$x-12}]
     412        $c create text $x [expr {$y-7}] -anchor e \
    442413            -text $mater
    443         set y [expr {$y-1.2*$lh}]
     414        set y [expr {$y-1.5*$lh}]
    444415    }
    445416
     
    450421        set label [$_device get $elem.about.label]
    451422        if {"" != $label} {
    452             set y [expr {$y-0.5*$lh}]
    453423            $c create text [expr {0.5*($x0p+$x1p)}] $y -anchor s \
    454424                -text $label
     
    464434# ----------------------------------------------------------------------
    465435itcl::body Rappture::DeviceLayout1D::_mater2color {mater} {
    466     if {$_library != ""} {
    467         set color [$_library get materials.($mater).color]
    468         if {$color != ""} {
    469             return $color
    470         }
     436    set lib [Rappture::library standard]
     437    set color [$lib get materials.($mater).color]
     438    if {$color != ""} {
     439        return $color
    471440    }
    472441    return gray
     
    481450itcl::configbody Rappture::DeviceLayout1D::font {
    482451    $_dispatcher event -idle !layout
    483 }
    484 
    485 # ----------------------------------------------------------------------
    486 # CONFIGURATION OPTION: -library
    487 #
    488 # Set to the Rappture::Library object representing the library with
    489 # material properties and other info.
    490 # ----------------------------------------------------------------------
    491 itcl::configbody Rappture::DeviceLayout1D::library {
    492     if {$itk_option(-library) != ""} {
    493         if {![Rappture::library isvalid $itk_option(-library)]} {
    494             error "bad value \"$itk_option(-library)\": should be Rappture::Library"
    495         }
    496     }
    497     set _library $itk_option(-library)
    498     $_dispatcher event -idle !redraw
    499452}
    500453
  • trunk/gui/scripts/deviceViewer1D.tcl

    r9 r11  
    1010# ======================================================================
    1111#  AUTHOR:  Michael McLennan, Purdue University
    12 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     12#  Copyright (c) 2004-2005
     13#  Purdue Research Foundation, West Lafayette, IN
    1314# ======================================================================
    1415package require Itk
     
    2526
    2627    itk_option define -device device Device ""
    27     itk_option define -tool tool Tool ""
    28 
    29     constructor {args} { # defined below }
     28
     29    constructor {tool args} { # defined below }
    3030    destructor { # defined below }
    3131
    3232    public method controls {option args}
    3333                                                                               
    34     protected method _fixTabs {}
     34    protected method _loadDevice {}
    3535    protected method _changeTabs {}
    3636    protected method _fixAxes {}
     
    4242    protected method _controlSet {widget libObj path}
    4343
    44     private variable _device ""     ;# LibraryObj for device rep
    45     private variable _tool ""       ;# LibraryObj for tool parameters
     44    private variable _tool ""       ;# tool controlling this viewer
     45    private variable _device ""     ;# XML library with <structure>
    4646    private variable _tab2fields    ;# maps tab name => list of fields
     47    private variable _field2parm    ;# maps field path => parameter name
    4748    private variable _units ""      ;# units for field being edited
    4849    private variable _restrict ""   ;# restriction expr for field being edited
     
    5657# CONSTRUCTOR
    5758# ----------------------------------------------------------------------
    58 itcl::body Rappture::DeviceViewer1D::constructor {args} {
     59itcl::body Rappture::DeviceViewer1D::constructor {tool args} {
     60    set _tool $tool
     61
    5962    itk_option add hull.width hull.height
    6063    pack propagate $itk_component(hull) no
     
    7982    }
    8083
    81     itk_component add ambient {
    82         frame $itk_component(inner).ambient
    83     }
    84     pack $itk_component(ambient) -side top -fill x
     84    itk_component add top {
     85        frame $itk_component(inner).top
     86    }
     87    pack $itk_component(top) -fill x
    8588
    8689    itk_component add layout {
     
    101104    bind $itk_component(graph) <Configure> "
    102105        after cancel [itcl::code $this _fixAxes]
    103         after idle [itcl::code $this _fixAxes]
     106        after 100 [itcl::code $this _fixAxes]
    104107    "
    105108
     
    132135
    133136# ----------------------------------------------------------------------
    134 # USAGE: controls add <parameter>
    135 # USAGE: controls remove <parameter>|all
     137# USAGE: controls insert <pos> <xmlobj> <path>
    136138#
    137139# Clients use this to add a control to the internal panels of this
    138 # widget.  If the <parameter> is ambient*, then the control is added
    139 # to the top, so it goes along with the layout of the device.  If
    140 # it is structure.fields.field*, then it goes in one of the field
    141 # panels.
     140# widget.  Such controls are usually placed at the top of the widget,
     141# but if possible, they are integrated directly onto the device
     142# layout or the field area.
    142143# ----------------------------------------------------------------------
    143144itcl::body Rappture::DeviceViewer1D::controls {option args} {
    144145    switch -- $option {
    145         add {
    146             if {[llength $args] != 1} {
    147                 error "wrong # args: should be \"controls add parameter\""
    148             }
    149             set path [lindex $args 0]
    150             if {[string match structure.fields.field* $path]} {
     146        insert {
     147            if {[llength $args] != 3} {
     148                error "wrong # args: should be \"controls insert pos xmlobj path\""
     149            }
     150            set pos [lindex $args 0]
     151            set xmlobj [lindex $args 1]
     152            set path [lindex $args 2]
     153            if {[string match *structure.parameters* $path]} {
    151154            } elseif {[string match structure.components* $path]} {
    152                 $itk_component(layout) controls add $path
    153             } else {
    154                 _controlCreate $itk_component(ambient) $_tool $path
    155             }
    156         }
    157         remove {
    158             error "not yet implemented"
     155                $itk_component(layout) controls insert $pos $xmlobj $path
     156            }
    159157        }
    160158        default {
    161             error "bad option \"$option\": should be add or remove"
    162         }
    163     }
    164 }
    165 
    166 # ----------------------------------------------------------------------
    167 # USAGE: _fixTabs
     159            error "bad option \"$option\": should be insert"
     160        }
     161    }
     162}
     163
     164# ----------------------------------------------------------------------
     165# USAGE: _loadDevice
    168166#
    169167# Used internally to search for fields and create corresponding
    170168# tabs whenever a device is installed into this viewer.
    171 #
    172 # If there are no tabs, then the widget is packed so that it appears
    173 # directly.  Otherwise, the interior reconfigured and assigned to
    174 # the current tab.
    175 # ----------------------------------------------------------------------
    176 itcl::body Rappture::DeviceViewer1D::_fixTabs {} {
     169# ----------------------------------------------------------------------
     170itcl::body Rappture::DeviceViewer1D::_loadDevice {} {
    177171    #
    178172    # Release any info left over from the last device.
     
    182176    }
    183177    catch {unset _tab2fields}
     178    catch {unset _field2parm}
    184179
    185180    #
     
    189184    if {$_device != ""} {
    190185        foreach nn [$_device children fields] {
    191             if {[string match field* $nn]} {
    192                 set name [$_device get $nn.label]
    193                 if {$name == ""} {
    194                     set name $nn
    195                 }
    196 
    197                 set fobj [Rappture::Field ::#auto $_device $_device $nn]
    198                 lappend _tab2fields($name) $fobj
    199             }
     186            set name [$_device get fields.$nn.about.label]
     187            if {$name == ""} {
     188                set name $nn
     189            }
     190
     191            set fobj [Rappture::Field ::#auto $_device fields.$nn]
     192            lappend _tab2fields($name) $fobj
    200193        }
    201194    }
     
    207200
    208201    if {[llength $tabs] <= 0} {
     202        #
     203        # == DEPRECATED FUNCTIONALITY ==
     204        # (I like the look of the tab, even if there's only one)
    209205        #
    210206        # No fields or one field?  Then we don't need to bother
     
    234230        $itk_component(tabs) select 0
    235231    }
     232
     233    #
     234    # Scan through and look for any parameters in the <structure>.
     235    # Register any parameters associated with fields, so we can
     236    # add them as active controls whenever we install new fields.
     237    # Create controls for any remaining parameters, so the user
     238    # can see that there's something to adjust.
     239    #
     240    if {$_device != ""} {
     241        foreach cname [$_device children parameters] {
     242            set handled 0
     243            if {[$_device element -as type parameters.$cname] == "number"} {
     244                set name [$_device element -as id parameters.$cname]
     245
     246                # look for a field that uses this parameter
     247                set found ""
     248                foreach fname [$_device children fields] {
     249                    foreach comp [$_device children fields.$fname] {
     250                        set v [$_device get fields.$fname.$comp.constant]
     251                        if {[string equal $v $name]} {
     252                            set found "fields.$fname.$comp"
     253                            break
     254                        }
     255                    }
     256                    if {"" != $found} break
     257                }
     258
     259                if {"" != $found} {
     260                    set _field2parm($found) $name
     261                    set handled 1
     262                }
     263            }
     264
     265            #
     266            # Any parameter that was not handled above should be handled
     267            # here, by adding it to a control panel above the device
     268            # layout area.
     269            #
     270            if {!$handled} {
     271                set t $itk_component(top)
     272                if {![winfo exists $t.cntls]} {
     273                    Rappture::Controls $t.cntls $_tool
     274                    pack $t.cntls -expand yes -fill both
     275                }
     276                $t.cntls insert end $_device parameters.$cname
     277            }
     278        }
     279    }
     280
     281    #
     282    # Install the first tab
     283    #
    236284    _changeTabs
    237285
     
    273321
    274322    foreach {zmin zmax} [$itk_component(layout) limits] { break }
    275     if {$zmax > $zmin} {
    276         $graph axis configure x -min $zmin -max $zmax -title "Position (um)"
     323    if {$_device != ""} {
     324        set units [$_device get units]
     325        if {$units != "arbitrary" && $zmax > $zmin} {
     326            $graph axis configure x -hide no -min $zmin -max $zmax \
     327                -title "Position ($units)"
     328        } else {
     329            $graph axis configure x -hide yes
     330        }
     331    } else {
     332        $graph axis configure x -hide no -min $zmin -max $zmax \
     333            -title "Position"
    277334    }
    278335
     
    312369
    313370        foreach comp [$fobj components] {
     371            # can only handle 1D meshes here
     372            if {[$fobj components -dimensions $comp] != "1D"} {
     373                continue
     374            }
     375
    314376            set elem "elem[incr n]"
    315             foreach {xv yv} [$fobj vectors $comp] { break }
    316             $graph element create $elem -x $xv -y $yv -symbol "" -linewidth 2
     377            set xv [$fobj mesh $comp]
     378            set yv [$fobj values $comp]
     379
     380            $graph element create $elem -x $xv -y $yv \
     381                -color black -symbol "" -linewidth 2
    317382
    318383            if {[info exists hints(color)]} {
     
    321386
    322387            foreach {path x y val} [$fobj controls get $comp] {
    323                 $graph marker create text -coords [list $x $y] \
    324                     -text $val -anchor s -name $comp.$x -background ""
    325                 $graph marker bind $comp.$x <Enter> \
    326                     [itcl::code $this _marker enter $comp.$x]
    327                 $graph marker bind $comp.$x <Leave> \
    328                     [itcl::code $this _marker leave $comp.$x]
    329                 $graph marker bind $comp.$x <ButtonPress> \
    330                     [itcl::code $this _marker edit $comp.$x $fobj/$path]
     388                if {$path != ""} {
     389                    set id "control[incr n]"
     390                    $graph marker create text -coords [list $x $y] \
     391                        -text $val -anchor s -name $id -background ""
     392                    $graph marker bind $id <Enter> \
     393                        [itcl::code $this _marker enter $id]
     394                    $graph marker bind $id <Leave> \
     395                        [itcl::code $this _marker leave $id]
     396                    $graph marker bind $id <ButtonPress> \
     397                        [itcl::code $this _marker edit $id $fobj/$path]
     398                }
    331399            }
    332400        }
     
    335403    # let the widget settle, then fix the axes to "nice" values
    336404    after cancel [itcl::code $this _fixAxes]
    337     after 20 [itcl::code $this _fixAxes]
     405    after 100 [itcl::code $this _fixAxes]
    338406}
    339407
     
    347415itcl::body Rappture::DeviceViewer1D::_fixAxes {} {
    348416    set graph $itk_component(graph)
     417    if {![winfo ismapped $graph]} {
     418        after cancel [itcl::code $this _fixAxes]
     419        after 100 [itcl::code $this _fixAxes]
     420        return
     421    }
    349422
    350423    #
     
    356429    #
    357430    set log [$graph axis cget y -logscale]
     431    $graph axis configure y -min "" -max ""
    358432    foreach {min max} [$graph axis limits y] { break }
    359433
     
    503577
    504578            $_marker(fobj) controls put $_marker(path) $value
     579            $_tool changed $_marker(path)
    505580            event generate $itk_component(hull) <<Edit>>
    506581
     
    613688    }
    614689    set _device $itk_option(-device)
    615     _fixTabs
    616 }
    617 
    618 # ----------------------------------------------------------------------
    619 # CONFIGURATION OPTION: -tool
    620 #
    621 # Set to the Rappture::Library object containing tool parameters.
    622 # Needed only if controls are added to the widget, so the controls
    623 # can update the tool parameters.
    624 # ----------------------------------------------------------------------
    625 itcl::configbody Rappture::DeviceViewer1D::tool {
    626     if {$itk_option(-tool) != ""} {
    627         if {![Rappture::library isvalid $itk_option(-tool)]} {
    628             error "bad value \"$itk_option(-tool)\": should be Rappture::Library"
    629         }
    630     }
    631     set _tool $itk_option(-tool)
    632 }
     690    _loadDevice
     691}
  • trunk/gui/scripts/dispatcher.tcl

    r1 r11  
    1313# ======================================================================
    1414#  AUTHOR:  Michael McLennan, Purdue University
    15 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     15#  Copyright (c) 2004-2005
     16#  Purdue Research Foundation, West Lafayette, IN
    1617# ======================================================================
    1718package require Itcl
  • trunk/gui/scripts/dropdown.tcl

    r1 r11  
    88# ======================================================================
    99#  AUTHOR:  Michael McLennan, Purdue University
    10 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     10#  Copyright (c) 2004-2005
     11#  Purdue Research Foundation, West Lafayette, IN
    1112# ======================================================================
    1213package require Itk
  • trunk/gui/scripts/dropdownlist.tcl

    r1 r11  
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    9 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     9#  Copyright (c) 2004-2005
     10#  Purdue Research Foundation, West Lafayette, IN
    1011# ======================================================================
    1112package require Itk
     
    135136    set _values [lreplace $_values $first $last]
    136137    set _labels [lreplace $_labels $first $last]
     138    $itk_component(list) delete $first $last
    137139}
    138140
     
    273275        if {$maxw < [winfo width $widget]} { set maxw [winfo width $widget] }
    274276    }
    275     set avg [font measure $fnt "x"]
     277    set avg [font measure $fnt "n"]
    276278    $itk_component(list) configure -width [expr {round($maxw/double($avg))+1}]
    277279
  • trunk/gui/scripts/editor.tcl

    r1 r11  
    2727# ======================================================================
    2828#  AUTHOR:  Michael McLennan, Purdue University
    29 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     29#  Copyright (c) 2004-2005
     30#  Purdue Research Foundation, West Lafayette, IN
    3031# ======================================================================
    3132package require Itk
  • trunk/gui/scripts/energyLevels.tcl

    r9 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itk
     
    343344# ----------------------------------------------------------------------
    344345itcl::body Rappture::EnergyLevels::_getColumn {name} {
    345     if {$itk_option(-layout) == "" || $itk_option(-output) == ""} {
     346puts "_getColumn $name"
     347    if {$itk_option(-output) == ""} {
    346348        return
    347349    }
     
    352354    # the position of the column from the list of all column names.
    353355    #
    354     set table [$itk_option(-layout) get $name.table]
    355     set col [$itk_option(-layout) get $name.column]
    356 
    357     set clist ""
    358     foreach c [$itk_option(-output) children -type column $table] {
    359         lappend clist [$itk_option(-output) get $table.$c.label]
    360     }
    361     set ipos [lsearch $clist $col]
    362     if {$ipos < 0} {
    363         return  ;# can't find data -- bail out!
    364     }
    365 
    366     set units [$itk_option(-output) get $table.column$ipos.units]
     356    if {$itk_option(-layout) != ""} {
     357        set table [$itk_option(-layout) get $name.table]
     358        set col [$itk_option(-layout) get $name.column]
     359
     360        set clist ""
     361        foreach c [$itk_option(-output) children -type column $table] {
     362            lappend clist [$itk_option(-output) get $table.$c.label]
     363        }
     364        set ipos [lsearch $clist $col]
     365        if {$ipos < 0} {
     366            return  ;# can't find data -- bail out!
     367        }
     368        set units [$itk_option(-output) get $table.column$ipos.units]
     369        set path "$table.data"
     370    } else {
     371        set clist ""
     372        foreach c [$itk_option(-output) children -type column] {
     373            lappend clist [$itk_option(-output) get $c.units]
     374        }
     375        if {$name == "energies"} {
     376            set units "eV"
     377        } else {
     378            set units ""
     379        }
     380        set ipos [lsearch -exact $clist $units]
     381        if {$ipos < 0} {
     382            return  ;# can't find data -- bail out!
     383        }
     384        set path "data"
     385    }
    367386
    368387    set rlist ""
    369     foreach line [split [$itk_option(-output) get $table.data] "\n"] {
     388    foreach line [split [$itk_option(-output) get $path] "\n"] {
    370389        if {"" != [string trim $line]} {
    371390            set val [lindex $line $ipos]
     
    391410# ----------------------------------------------------------------------
    392411itcl::body Rappture::EnergyLevels::_getUnits {name} {
    393     if {$itk_option(-layout) == "" || $itk_option(-output) == ""} {
     412    if {$itk_option(-output) == ""} {
    394413        return
    395414    }
     
    400419    # the position of the column from the list of all column names.
    401420    #
    402     set table [$itk_option(-layout) get $name.table]
    403     set col [$itk_option(-layout) get $name.column]
    404 
    405     set clist ""
    406     foreach c [$itk_option(-output) children -type column $table] {
    407         lappend clist [$itk_option(-output) get $table.$c.label]
    408     }
    409     set ipos [lsearch $clist $col]
    410     if {$ipos < 0} {
    411         return  ;# can't find data -- bail out!
    412     }
    413 
    414     return [$itk_option(-output) get $table.column$ipos.units]
     421    if {$itk_option(-layout) != ""} {
     422        set table [$itk_option(-layout) get $name.table]
     423        set col [$itk_option(-layout) get $name.column]
     424
     425        set clist ""
     426        foreach c [$itk_option(-output) children -type column $table] {
     427            lappend clist [$itk_option(-output) get $table.$c.label]
     428        }
     429        set ipos [lsearch $clist $col]
     430        if {$ipos < 0} {
     431            return  ;# can't find data -- bail out!
     432        }
     433        set units [$itk_option(-output) get $table.column$ipos.units]
     434    } else {
     435        if {$name == "energies"} {
     436            set units "eV"
     437        } else {
     438            set units ""
     439        }
     440    }
     441    return $units
    415442}
    416443
  • trunk/gui/scripts/field.tcl

    r9 r11  
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    9 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     9#  Copyright (c) 2004-2005
     10#  Purdue Research Foundation, West Lafayette, IN
    1011# ======================================================================
    1112package require Itcl
     
    1516
    1617itcl::class Rappture::Field {
    17     constructor {devobj libobj path} { # defined below }
     18    constructor {xmlobj path} { # defined below }
    1819    destructor { # defined below }
    1920
    20     public method components {{pattern *}}
    21     public method vectors {{what -overall}}
     21    public method components {args}
     22    public method mesh {{what -overall}}
     23    public method values {{what -overall}}
     24    public method limits {axis}
    2225    public method controls {option args}
    2326    public method hints {{key ""}}
    2427
    2528    protected method _build {}
    26 
    27     private variable _device ""  ;# ref to lib obj with device data
    28     private variable _libobj ""  ;# ref to lib obj with field data
     29    protected method _getValue {expr}
     30
     31    private variable _xmlobj ""  ;# ref to XML obj with device data
    2932
    3033    private variable _units ""   ;# system of units for this field
    31     private variable _limits     ;# maps slab name => {z0 z1} limits
     34    private variable _limits     ;# maps box name => {z0 z1} limits
    3235    private variable _zmax 0     ;# length of the device
    3336
    3437    private variable _field ""   ;# lib obj representing this field
    35     private variable _comp2vecs  ;# maps component name => x,y vectors
     38    private variable _comp2dims  ;# maps component name => dimensionality
     39    private variable _comp2xy    ;# maps component name => x,y vectors
     40    private variable _comp2vtk   ;# maps component name => vtkFloatArray
    3641    private variable _comp2cntls ;# maps component name => x,y control points
    3742
     
    4247# CONSTRUCTOR
    4348# ----------------------------------------------------------------------
    44 itcl::body Rappture::Field::constructor {devobj libobj path} {
    45     if {![Rappture::library isvalid $devobj]} {
    46         error "bad value \"$devobj\": should be LibraryObj"
    47     }
    48     if {![Rappture::library isvalid $libobj]} {
    49         error "bad value \"$libobj\": should be LibraryObj"
    50     }
    51     set _device $devobj
    52     set _libobj $libobj
    53     set _field [$libobj element -flavor object $path]
     49itcl::body Rappture::Field::constructor {xmlobj path} {
     50    if {![Rappture::library isvalid $xmlobj]} {
     51        error "bad value \"$xmlobj\": should be Rappture::library"
     52    }
     53    set _xmlobj $xmlobj
     54    set _field [$xmlobj element -as object $path]
    5455    set _units [$_field get units]
    5556
    5657    # determine the overall size of the device
    5758    set z0 [set z1 0]
    58     foreach elem [$_device children components] {
     59    foreach elem [$_xmlobj children components] {
    5960        switch -glob -- $elem {
    60             slab* - molecule* {
     61            box* {
    6162                if {![regexp {[0-9]$} $elem]} {
    6263                    set elem "${elem}0"
    6364                }
    64                 set tval [$_device get components.$elem.thickness]
    65                 set tval [Rappture::Units::convert $tval \
     65                set z0 [$_xmlobj get components.$elem.corner0]
     66                set z0 [Rappture::Units::convert $z0 \
    6667                    -context um -to um -units off]
    67                 set z1 [expr {$z0+$tval}]
     68
     69                set z1 [$_xmlobj get components.$elem.corner1]
     70                set z1 [Rappture::Units::convert $z1 \
     71                    -context um -to um -units off]
     72
    6873                set _limits($elem) [list $z0 $z1]
    69 
    70                 set z0 $z1
    7174            }
    7275        }
     
    8386itcl::body Rappture::Field::destructor {} {
    8487    itcl::delete object $_field
    85     # don't destroy the _device! we don't own it!
    86 
    87     foreach name [array names _comp2vecs] {
    88         eval blt::vector destroy $_comp2vecs($name)
    89     }
    90 }
    91 
    92 # ----------------------------------------------------------------------
    93 # USAGE: components ?<pattern>?
    94 #
    95 # Returns a list of names for the various components of this field.
    96 # If the optional glob-style <pattern> is specified, then it returns
    97 # only the component names matching the pattern.
    98 # ----------------------------------------------------------------------
    99 itcl::body Rappture::Field::components {{pattern *}} {
     88    # don't destroy the _xmlobj! we don't own it!
     89
     90    foreach name [array names _comp2xy] {
     91        eval blt::vector destroy $_comp2xy($name)
     92    }
     93    foreach name [array names _comp2vtk] {
     94        set cobj [lindex $_comp2vtk($name) 0]
     95        Rappture::Cloud::release $cobj
     96
     97        set fobj [lindex $_comp2vtk($name) 1]
     98        rename $fobj ""
     99    }
     100}
     101
     102# ----------------------------------------------------------------------
     103# USAGE: components ?-name|-dimensions? ?<pattern>?
     104#
     105# Returns a list of names or types for the various components of
     106# this field.  If the optional glob-style <pattern> is specified,
     107# then it returns only the components with names matching the pattern.
     108# ----------------------------------------------------------------------
     109itcl::body Rappture::Field::components {args} {
     110    Rappture::getopts args params {
     111        flag what -name default
     112        flag what -dimensions
     113    }
     114
     115    set pattern *
     116    if {[llength $args] > 0} {
     117        set pattern [lindex $args 0]
     118        set args [lrange $args 1 end]
     119    }
     120    if {[llength $args] > 0} {
     121        error "wrong # args: should be \"components ?switches? ?pattern?\""
     122    }
     123
    100124    set rlist ""
    101     foreach name [array names _comp2vecs] {
    102         if {[string match $pattern $name]} {
    103             lappend rlist $name
     125    foreach name [array names _comp2dims $pattern] {
     126        switch -- $params(what) {
     127            -name { lappend rlist $name }
     128            -dimensions { lappend rlist $_comp2dims($name) }
    104129        }
    105130    }
     
    108133
    109134# ----------------------------------------------------------------------
    110 # USAGE: vectors ?<name>?
     135# USAGE: mesh ?<name>?
    111136#
    112137# Returns a list {xvec yvec} for the specified field component <name>.
     
    114139# overall field (sum of all components).
    115140# ----------------------------------------------------------------------
    116 itcl::body Rappture::Field::vectors {{what -overall}} {
     141itcl::body Rappture::Field::mesh {{what -overall}} {
    117142    if {$what == "component0"} {
    118143        set what "component"
    119144    }
    120     if {[info exists _comp2vecs($what)]} {
    121         return $_comp2vecs($what)
    122     }
    123     error "bad option \"$what\": should be [join [lsort [array names _comp2vecs]] {, }]"
     145    if {[info exists _comp2xy($what)]} {
     146        return [lindex $_comp2xy($what) 0]  ;# return xv
     147    }
     148    if {[info exists _comp2vtk($what)]} {
     149        set cobj [lindex $_comp2vtk($what) 0]
     150        return [$cobj points]
     151    }
     152    error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
     153}
     154
     155# ----------------------------------------------------------------------
     156# USAGE: values ?<name>?
     157#
     158# Returns a list {xvec yvec} for the specified field component <name>.
     159# If the name is not specified, then it returns the vectors for the
     160# overall field (sum of all components).
     161# ----------------------------------------------------------------------
     162itcl::body Rappture::Field::values {{what -overall}} {
     163    if {$what == "component0"} {
     164        set what "component"
     165    }
     166    if {[info exists _comp2xy($what)]} {
     167        return [lindex $_comp2xy($what) 1]  ;# return yv
     168    }
     169    if {[info exists _comp2vtk($what)]} {
     170        return [lindex $_comp2vtk($what) 1]  ;# return vtkFloatArray
     171    }
     172    error "bad option \"$what\": should be [join [lsort [array names _comp2dims]] {, }]"
     173}
     174
     175# ----------------------------------------------------------------------
     176# USAGE: limits <axis>
     177#
     178# Returns a list {min max} representing the limits for the specified
     179# axis.
     180# ----------------------------------------------------------------------
     181itcl::body Rappture::Field::limits {axis} {
     182    foreach val {xmin xmax ymin ymax zmin zmax} {
     183        set results($val) ""
     184    }
     185    foreach comp [array names _comp2dims] {
     186        switch -- $_comp2dims($comp) {
     187            1D {
     188                foreach {xv yv} $_comp2xy($comp) break
     189
     190                $xv variable x
     191                set lims(xmin) $x(min)
     192                set lims(xmax) $x(max)
     193
     194                $yv variable y
     195                set lims(ymin) $y(min)
     196                set lims(ymax) $y(max)
     197
     198                set lims(zmin) 0
     199                set lims(zmax) 0
     200            }
     201            2D - 3D {
     202                foreach {xv yv} $_comp2vtk($comp) break
     203
     204                foreach {lims(xmin) lims(xmax)} [$xv limits x] break
     205                foreach {lims(ymin) lims(ymax)} [$xv limits y] break
     206                foreach {lims(zmin) lims(zmax)} [$yv GetRange] break
     207            }
     208        }
     209        foreach val {xmin ymin zmin} {
     210            if {"" == $results($val) || $lims($val) < $results($val)} {
     211                set results($val) $lims($val)
     212            }
     213        }
     214        foreach val {xmax ymax zmax} {
     215            if {"" == $results($val) || $lims($val) > $results($val)} {
     216                set results($val) $lims($val)
     217            }
     218        }
     219    }
     220    return [list $results(${axis}min) $results(${axis}max)]
    124221}
    125222
     
    138235                return $_comp2cntls($what)
    139236            }
    140             error "bad option \"$what\": should be [join [lsort [array names _comp2cntls]] {, }]"
     237            return ""
    141238        }
    142239        put {
    143240            set path [lindex $args 0]
    144241            set value [lindex $args 1]
    145             $_field put $path $value
     242            $_xmlobj put $path.current $value
    146243            _build
    147244        }
     
    160257# ----------------------------------------------------------------------
    161258itcl::body Rappture::Field::hints {{keyword ""}} {
    162     foreach key {label scale color units restrict} {
     259    foreach key {label scale color units} {
    163260        set str [$_field get $key]
    164261        if {"" != $str} {
     
    186283itcl::body Rappture::Field::_build {} {
    187284    # discard any existing data
    188     foreach name [array names _comp2vecs] {
    189         eval blt::vector destroy $_comp2vecs($name)
    190     }
    191     catch {unset _comp2vecs}
     285    foreach name [array names _comp2xy] {
     286        eval blt::vector destroy $_comp2xy($name)
     287    }
     288    foreach name [array names _comp2vtk] {
     289        set cobj [lindex $_comp2vtk($name) 0]
     290        Rappture::Cloud::release $cobj
     291
     292        set fobj [lindex $_comp2vtk($name) 1]
     293        rename $fobj ""
     294    }
     295    catch {unset _comp2xy}
     296    catch {unset _comp2vtk}
     297    catch {unset _comp2dims}
    192298
    193299    #
     
    196302    #
    197303    foreach cname [$_field children -type component] {
    198         set xv ""
    199         set yv ""
    200 
    201         set val [$_field get $cname.constant]
    202         if {$val != ""} {
    203             set domain [$_field get $cname.domain]
    204             if {$domain == "" || ![info exists _limits($domain)]} {
    205                 set z0 0
    206                 set z1 $_zmax
     304        set type ""
     305        if {( [$_field element $cname.constant] != ""
     306                && [$_field element $cname.domain] != "" )
     307              || [$_field element $cname.xy] != ""} {
     308            set type "1D"
     309        } elseif {[$_field element $cname.mesh] != ""
     310                    && [$_field element $cname.values] != ""} {
     311            set type "points-on-mesh"
     312        }
     313
     314        if {$type == "1D"} {
     315            #
     316            # 1D data can be represented as 2 BLT vectors,
     317            # one for x and the other for y.
     318            #
     319            set xv ""
     320            set yv ""
     321
     322            set val [$_field get $cname.constant]
     323            if {$val != ""} {
     324                set domain [$_field get $cname.domain]
     325                if {$domain == "" || ![info exists _limits($domain)]} {
     326                    set z0 0
     327                    set z1 $_zmax
     328                } else {
     329                    foreach {z0 z1} $_limits($domain) { break }
     330                }
     331                set xv [blt::vector create x$_counter]
     332                $xv append $z0 $z1
     333
     334                foreach {val pcomp} [_getValue $val] break
     335                set yv [blt::vector create y$_counter]
     336                $yv append $val $val
     337
     338                if {$pcomp != ""} {
     339                    set zm [expr {0.5*($z0+$z1)}]
     340                    set _comp2cntls($cname) \
     341                        [list $pcomp $zm $val "$val$_units"]
     342                }
    207343            } else {
    208                 foreach {z0 z1} $_limits($domain) { break }
    209             }
    210             set xv [blt::vector create x$_counter]
    211             $xv append $z0 $z1
    212 
    213             if {$_units != ""} {
    214                 set val [Rappture::Units::convert $val \
    215                     -context $_units -to $_units -units off]
    216             }
    217             set yv [blt::vector create y$_counter]
    218             $yv append $val $val
    219 
    220             set zm [expr {0.5*($z0+$z1)}]
    221             set _comp2cntls($cname) \
    222                 [list $cname.constant $zm $val "$val$_units"]
    223         } else {
    224             set xydata [$_field get $cname.xy]
    225             if {"" != $xydata} {
    226                 set xv [blt::vector create x$_counter]
    227                 set yv [blt::vector create y$_counter]
    228 
    229                 foreach line [split $xydata \n] {
    230                     if {[scan $line {%g %g} xval yval] == 2} {
    231                         $xv append $xval
    232                         $yv append $yval
     344                set xydata [$_field get $cname.xy]
     345                if {"" != $xydata} {
     346                    set xv [blt::vector create x$_counter]
     347                    set yv [blt::vector create y$_counter]
     348
     349                    foreach line [split $xydata \n] {
     350                        if {[scan $line {%g %g} xval yval] == 2} {
     351                            $xv append $xval
     352                            $yv append $yval
     353                        }
    233354                    }
    234355                }
    235356            }
    236         }
    237 
    238         if {$xv != "" && $yv != ""} {
    239             set _comp2vecs($cname) [list $xv $yv]
    240             incr _counter
    241         }
    242     }
    243 }
     357
     358            if {$xv != "" && $yv != ""} {
     359                set _comp2dims($cname) "1D"
     360                set _comp2xy($cname) [list $xv $yv]
     361                incr _counter
     362            }
     363        } elseif {$type == "points-on-mesh"} {
     364            #
     365            # More complex 2D/3D data is represented by a mesh
     366            # object and an associated vtkFloatArray for field
     367            # values.
     368            #
     369            set path [$_field get $cname.mesh]
     370            if {[$_xmlobj element $path] != ""} {
     371                set cobj [Rappture::Cloud::fetch $_xmlobj $path]
     372                set values [$_field get $cname.values]
     373                set farray [vtkFloatArray ::vals$_counter]
     374
     375                foreach v $values {
     376                    if {"" != $_units} {
     377                        set v [Rappture::Units::convert $v \
     378                            -context $_units -to $_units -units off]
     379                    }
     380                    $farray InsertNextValue $v
     381                }
     382
     383                set _comp2dims($cname) "[$cobj dimensions]D"
     384                set _comp2vtk($cname) [list $cobj $farray]
     385                incr _counter
     386            } else {
     387                puts "WARNING: can't find mesh $path for field component"
     388            }
     389        }
     390    }
     391}
     392
     393# ----------------------------------------------------------------------
     394# USAGE: _getValue <expr>
     395#
     396# Used internally to get the value for an expression <expr>.  Returns
     397# a list of the form {val parameterPath}, where val is the numeric
     398# value of the expression, and parameterPath is the XML path to the
     399# parameter representing the value, or "" if the <expr> does not
     400# depend on any parameters.
     401# ----------------------------------------------------------------------
     402itcl::body Rappture::Field::_getValue {expr} {
     403    #
     404    # First, look for the expression among the <parameter>'s
     405    # associated with the device.
     406    #
     407    set found 0
     408    foreach pcomp [$_xmlobj children parameters] {
     409        set id [$_xmlobj element -as id parameters.$pcomp]
     410        if {[string equal $id $expr]} {
     411            set val [$_xmlobj get parameters.$pcomp.current]
     412            if {"" == $val} {
     413                set val [$_xmlobj get parameters.$pcomp.default]
     414            }
     415            if {"" != $val} {
     416                set expr $val
     417                set found 1
     418                break
     419            }
     420        }
     421    }
     422    if {$found} {
     423        set pcomp "parameters.$pcomp"
     424    } else {
     425        set pcomp ""
     426    }
     427
     428    if {$_units != ""} {
     429        set expr [Rappture::Units::convert $expr \
     430            -context $_units -to $_units -units off]
     431    }
     432
     433    return [list $expr $pcomp]
     434}
  • trunk/gui/scripts/gauge.tcl

    r1 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itk
     
    146147        # the value is bound by any min/max value constraints.
    147148        #
    148         set newval [lindex $args 0]
    149         if {$itk_option(-units) != ""} {
    150             set units $itk_option(-units)
    151             set newval [Rappture::Units::convert $newval -context $units]
    152             set nv [Rappture::Units::convert $newval \
     149        set newval [set nv [lindex $args 0]]
     150        set units $itk_option(-units)
     151        if {$units != ""} {
     152            set newval [Rappture::Units::convert $newval \
     153                -context $units]
     154            set nv [Rappture::Units::convert $nv \
    153155                -context $units -to $units -units off]
    154 
    155             if {"" != $itk_option(-minvalue)} {
    156                 set minv [Rappture::Units::convert $itk_option(-minvalue) \
     156        }
     157
     158        if {"" != $itk_option(-minvalue)} {
     159            set minv $itk_option(-minvalue)
     160            if {$units != ""} {
     161                set minv [Rappture::Units::convert $minv \
    157162                    -context $units -to $units -units off]
    158                 if {$nv < $minv} {
    159                     error "minimum value allowed here is $itk_option(-minvalue)"
    160                 }
    161             }
    162 
    163             if {"" != $itk_option(-maxvalue)} {
    164                 set maxv [Rappture::Units::convert $itk_option(-maxvalue) \
     163            }
     164            if {$nv < $minv} {
     165                error "minimum value allowed here is $itk_option(-minvalue)"
     166            }
     167        }
     168
     169        if {"" != $itk_option(-maxvalue)} {
     170            set maxv $itk_option(-maxvalue)
     171            if {$units != ""} {
     172                set maxv [Rappture::Units::convert $maxv \
    165173                    -context $units -to $units -units off]
    166                 if {$nv > $maxv} {
    167                     error "maximum value allowed here is $itk_option(-maxvalue)"
    168                 }
    169             }
    170         } elseif {![string is double -strict $newval]} {
     174            }
     175            if {$nv > $maxv} {
     176                error "maximum value allowed here is $itk_option(-maxvalue)"
     177            }
     178        }
     179
     180        if {![string is double -strict $nv]} {
    171181            error "Should be a real number"
    172182        }
  • trunk/gui/scripts/mainwin.tcl

    r1 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itk
  • trunk/gui/scripts/moleculeViewer.tcl

    r8 r11  
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    9 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     9#  Copyright (c) 2004-2005
     10#  Purdue Research Foundation, West Lafayette, IN
    1011# ======================================================================
    1112package require Itk
     
    2223    itk_option define -backdrop backdrop Backdrop "black"
    2324    itk_option define -device device Device ""
    24     itk_option define -library library Library ""
    25 
    26     constructor {args} { # defined below }
     25
     26    constructor {tool args} { # defined below }
    2727    destructor { # defined below }
    2828
     
    3030    protected method _color2rgb {color}
    3131
     32    private variable _tool ""    ;# tool containing this viewer
    3233    private variable _actors ""  ;# list of actors in renderer
    3334}
     
    3940# CONSTRUCTOR
    4041# ----------------------------------------------------------------------
    41 itcl::body Rappture::MoleculeViewer::constructor {args} {
     42itcl::body Rappture::MoleculeViewer::constructor {tool args} {
     43    set _tool $tool
     44
    4245    itk_option add hull.width hull.height
    4346    pack propagate $itk_component(hull) no
     
    9396    if {$itk_option(-device) != ""} {
    9497        set dev $itk_option(-device)
     98        set lib [Rappture::library standard]
     99
    95100        set counter 0
    96101        foreach atom [$dev children -type atom components.molecule] {
     
    105110            $this-ren AddActor $aname
    106111
    107             if {$itk_option(-library) != ""} {
    108                 set sfac 0.7
    109                 set scale [$itk_option(-library) get elements.($symbol).scale]
    110                 if {$scale != ""} {
    111                     $aname SetScale [expr {$sfac*$scale}]
    112                 }
    113                 set color [$itk_option(-library) get elements.($symbol).color]
    114                 if {$color != ""} {
    115                     eval [$aname GetProperty] SetColor [_color2rgb $color]
    116                 }
     112            set sfac 0.7
     113            set scale [$lib get elements.($symbol).scale]
     114            if {$scale != ""} {
     115                $aname SetScale [expr {$sfac*$scale}]
     116            }
     117            set color [$lib get elements.($symbol).color]
     118            if {$color != ""} {
     119                eval [$aname GetProperty] SetColor [_color2rgb $color]
    117120            }
    118121
     
    157160}
    158161
    159 # ----------------------------------------------------------------------
    160 # OPTION: -library
    161 # ----------------------------------------------------------------------
    162 itcl::configbody Rappture::MoleculeViewer::library {
    163     _render
    164 }
    165 
    166162#package require Rappture
    167 #Rappture::MoleculeViewer .e -library [Rappture::library -std library.xml]
     163#Rappture::MoleculeViewer .e
    168164#pack .e -expand yes -fill both
    169165#
  • trunk/gui/scripts/notebook.tcl

    r1 r11  
    88# ======================================================================
    99#  AUTHOR:  Michael McLennan, Purdue University
    10 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     10#  Copyright (c) 2004-2005
     11#  Purdue Research Foundation, West Lafayette, IN
    1112# ======================================================================
    1213package require Itk
     
    3334
    3435    private variable _count 0       ;# counter for unique names
     36    private variable _dispatcher "" ;# dispatcher for !events
    3537    private variable _pages ""      ;# list of page frames
    3638    private variable _name2page     ;# maps name => frame for page
     
    4749itcl::body Rappture::Notebook::constructor {args} {
    4850    pack propagate $itk_component(hull) no
     51
     52    Rappture::dispatcher _dispatcher
     53    $_dispatcher register !fixsize
     54    $_dispatcher dispatch $this !fixsize "[itcl::code $this _fixSize]; list"
     55
    4956    eval itk_initialize $args
    50 }
    51 
    52 # ----------------------------------------------------------------------
    53 # DESTRUCTOR
    54 # ----------------------------------------------------------------------
    55 itcl::body Rappture::Notebook::destructor {} {
    56     after cancel [itcl::code $this _fixSize]
    5757}
    5858
     
    7777        set _name2page($name) $itk_component($pname)
    7878
    79         bind $itk_component($pname) <Configure> [itcl::code $this _fixSize]
    80 
    81         after cancel [itcl::code $this _fixSize]
    82         after idle [itcl::code $this _fixSize]
     79        bind $itk_component($pname) <Configure> \
     80            [itcl::code $_dispatcher event -after 100 !fixsize]
    8381
    8482        lappend rlist $itk_component($pname)
     
    139137
    140138# ----------------------------------------------------------------------
    141 # USAGE: current ?<name>|next>>|<<prev?
     139# USAGE: current ?<name>|next>|<back?
    142140#
    143141# Used to query/set the current page in the notebook.  With no args,
    144142# it returns the name of the current page.  Otherwise, it sets the
    145 # current page.  The special token "next>>" is used to set the notebook
    146 # to the next logical page, and "<<prev" sets to the previous.
     143# current page.  The special token "next>" is used to set the notebook
     144# to the next logical page, and "<back" sets to the previous.
    147145# ----------------------------------------------------------------------
    148146itcl::body Rappture::Notebook::current {args} {
     
    154152            set name [lindex $args 0]
    155153            set index 0
    156             if {$name == "next>>"} {
     154            if {$name == "next>"} {
    157155                if {$_current == ""} {
    158156                    set index 0
     
    164162                    }
    165163                }
    166             } elseif {$name == "<<prev"} {
     164            } elseif {$name == "<back"} {
    167165                if {$_current == ""} {
    168166                    set index end
     
    189187        }
    190188        default {
    191             error "wrong # args: should be \"current name|next>>|<<prev\""
     189            error "wrong # args: should be \"current name|next>|<back\""
    192190        }
    193191    }
     
    230228# ----------------------------------------------------------------------
    231229itcl::configbody Rappture::Notebook::width {
    232     after cancel [itcl::code $this _fixSize]
    233     after idle [itcl::code $this _fixSize]
     230    $_dispatcher event -idle !fixsize
    234231}
    235232
     
    238235# ----------------------------------------------------------------------
    239236itcl::configbody Rappture::Notebook::height {
    240     after cancel [itcl::code $this _fixSize]
    241     after idle [itcl::code $this _fixSize]
    242 }
     237    $_dispatcher event -idle !fixsize
     238}
  • trunk/gui/scripts/pager.tcl

    r1 r11  
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    9 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     9#  Copyright (c) 2004-2005
     10#  Purdue Research Foundation, West Lafayette, IN
    1011# ======================================================================
    1112package require Itk
    1213package require BLT
    1314
     15option add *Pager.arrangement "pages" widgetDefault
    1416option add *Pager.width 0 widgetDefault
    1517option add *Pager.height 0 widgetDefault
    16 option add *Pager.arrangement "tabs/top" widgetDefault
    17 option add *Pager.tearoff 0 widgetDefault
     18option add *Pager.padding 8 widgetDefault
     19option add *Pager.crumbColor black widgetDefault
     20option add *Pager.crumbNumberColor white widgetDefault
     21option add *Pager.dimCrumbColor gray70 widgetDefault
     22option add *Pager.activeCrumbColor blue widgetDefault
     23option add *Pager.crumbFont \
     24    -*-helvetica-bold-r-normal-*-*-120-* widgetDefault
     25
     26blt::bitmap define Pager-arrow {
     27#define arrow_width 9
     28#define arrow_height 9
     29static unsigned char arrow_bits[] = {
     30   0x10, 0x00, 0x30, 0x00, 0x70, 0x00, 0xff, 0x00, 0xff, 0x01, 0xff, 0x00,
     31   0x70, 0x00, 0x30, 0x00, 0x10, 0x00};
     32}
    1833
    1934itcl::class Rappture::Pager {
    2035    inherit itk::Widget
    2136
    22     itk_option define -arrangement arrangement Arrangement ""
    2337    itk_option define -width width Width 0
    2438    itk_option define -height height Height 0
     39    itk_option define -padding padding Padding 0
     40    itk_option define -crumbcolor crumbColor Foreground ""
     41    itk_option define -crumbnumbercolor crumbNumberColor Foreground ""
     42    itk_option define -crumbfont crumbFont Font ""
     43    itk_option define -dimcrumbcolor dimCrumbColor DimForeground ""
     44    itk_option define -activecrumbcolor activeCrumbColor ActiveForeground ""
     45    itk_option define -arrangement arrangement Arrangement ""
    2546
    2647    constructor {args} { # defined below }
     
    2950    public method delete {first {last ""}}
    3051    public method index {name}
    31     public method get {{name ""}}
     52    public method page {args}
     53    public method current {args}
    3254
    3355    protected method _layout {}
    34 
     56    protected method _fixSize {}
     57    protected method _drawCrumbs {how}
     58
     59    private variable _counter 0      ;# counter for page names
    3560    private variable _dispatcher ""  ;# dispatcher for !events
    3661    private variable _pages ""       ;# list of known pages
    37     private variable _page2frame     ;# maps page name => frame
    38     private variable _counter 0      ;# counter for frame names
    39     private variable _arrangement "" ;# last value of -arrangment
     62    private variable _page2info      ;# maps page name => -frame,-title,-command
     63    private variable _current ""     ;# page currently shown
    4064}
    4165                                                                               
     
    5074    $_dispatcher register !layout
    5175    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
    52 
    53     itk_component add tabs {
    54         blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
    55             -side bottom -selectcommand [itcl::code $this _layout]
    56     } {
    57         keep -activebackground -activeforeground
    58         keep -background -cursor -font
    59         rename -highlightbackground -background background Background
    60         keep -highlightcolor -highlightthickness
    61         keep -selectbackground -selectforeground
    62         keep -tabbackground -tabforeground
    63         keep -tearoff
    64     }
    65     pack $itk_component(tabs) -expand yes -fill both
     76    $_dispatcher register !fixsize
     77    $_dispatcher dispatch $this !fixsize "[itcl::code $this _fixSize]; list"
     78
     79    itk_component add controls {
     80        frame $itk_interior.cntls
     81    }
     82
     83    itk_component add next {
     84        button $itk_component(controls).next -width 6 -text "Next >" \
     85            -command [itcl::code $this current next>]
     86    }
     87    pack $itk_component(next) -side right
     88
     89    itk_component add back {
     90        button $itk_component(controls).back -width 6 -text "< Back" \
     91            -command [itcl::code $this current <back]
     92    }
     93    pack $itk_component(back) -side left
     94
     95    set font [$itk_component(next) cget -font]
     96    set ht [font metrics $font -linespace]
     97    itk_component add breadcrumbs {
     98        canvas $itk_interior.breadcrumbs -width 10 -height [expr {$ht+2}]
     99    }
     100
     101    itk_component add line {
     102        frame $itk_interior.line -height 2 -borderwidth 1 -relief sunken
     103    }
     104
    66105
    67106    itk_component add inside {
    68         frame $itk_component(tabs).inside
    69     }
     107        frame $itk_interior.inside
     108    }
     109    pack $itk_component(inside) -expand yes -fill both
     110    pack propagate $itk_component(inside) no
     111
     112    eval itk_initialize $args
    70113    $_dispatcher event -idle !layout
    71 
    72     eval itk_initialize $args
    73 }
    74 
    75 # ----------------------------------------------------------------------
    76 # USAGE: insert <pos> <name> ?<name>...?
    77 #
    78 # Clients use this to insert one or more new pages into this pager.
    79 # The pages are inserted into the list at position <pos>, which can
    80 # be an integer starting from 0 or the keyword "end".  Each <name>
    81 # is the name used to identify the page.  Returns the name of a frame
    82 # for each page created.
     114}
     115
     116# ----------------------------------------------------------------------
     117# USAGE: insert <pos> ?-name <name>? ?-title <label>? ?-command <str>?
     118#
     119# Clients use this to insert a new page into this pager.  The page is
     120# inserted into the list at position <pos>, which can be an integer
     121# starting from 0 or the keyword "end".  The optional <name> can be
     122# used to identify the page.  If it is not supplied, a name is created
     123# for the page.  The -title and -command are other values associated
     124# with the page.
     125#
     126# Returns the name used to identify the page.
    83127# ----------------------------------------------------------------------
    84128itcl::body Rappture::Pager::insert {pos args} {
     
    89133    }
    90134
    91     set rlist ""
    92     foreach name $args {
    93         if {[info exists _page2frame($name)]} {
    94             error "page \"$name\" already exists"
    95         }
    96         set win $itk_component(inside).page[incr _counter]
    97         frame $win
    98         set _page2frame($name) $win
    99         set _pages [linsert $_pages $pos $name]
    100         lappend rlist $win
    101 
    102         if {[string match tabs/* $_arrangement]} {
    103             $itk_component(tabs) insert $pos $name
    104         }
    105     }
     135    Rappture::getopts args params {
     136        value -name page#auto
     137        value -title "Page #auto"
     138        value -command ""
     139    }
     140    if {[llength $args] > 0} {
     141        error "wrong # args: should be \"insert pos ?-name n? ?-title t? ?-command c?\""
     142    }
     143
     144    incr _counter
     145    if {$_counter > 1} {
     146        set subst "#$_counter"
     147    } else {
     148        set subst ""
     149    }
     150    if {[regexp {#auto} $params(-name)]} {
     151        regsub -all {#auto} $params(-name) $subst params(-name)
     152    }
     153    if {[regexp {#auto} $params(-title)]} {
     154        regsub -all {#auto} $params(-title) $subst params(-title)
     155    }
     156
     157    # allocate the page
     158    if {[info exists _page2info($params(-name)-frame)]} {
     159        error "page \"$params(-name)\" already exists"
     160    }
     161    set win $itk_component(inside).page$_counter
     162    frame $win
     163    set _page2info($params(-name)-frame) $win
     164    set _page2info($params(-name)-title) $params(-title)
     165    set _page2info($params(-name)-command) $params(-command)
     166    set _pages [linsert $_pages $pos $params(-name)]
     167
     168    #bind $win <Configure> \
     169    #    [itcl::code $_dispatcher event -idle !fixsize]
     170
    106171    $_dispatcher event -idle !layout
    107172
    108     return $rlist
     173    return $params(-name)
    109174}
    110175
     
    131196
    132197    foreach name [lrange $_pages $first $last] {
    133         if {[info exists _page2frame($name)]} {
    134             destroy $_page2frame($name)
    135             unset _page2frame($name)
     198        if {[info exists _page2info($name-frame)]} {
     199            destroy $_page2info($name-frame)
     200            unset _page2info($name-frame)
     201            unset _page2info($name-title)
     202            unset _page2info($name-command)
    136203        }
    137204    }
    138205    set _pages [lreplace $_pages $first $last]
    139206
    140     if {[string match tabs/* $_arrangement]} {
    141         $itk_component(tabs) delete $first $last
    142     }
    143207    $_dispatcher event -idle !layout
    144208}
    145209
    146210# ----------------------------------------------------------------------
    147 # USAGE: index <name>
     211# USAGE: index <name>|@n
    148212#
    149213# Clients use this to convert a page <name> into its corresponding
    150 # integer index.  Returns -1 if the <name> is not recognized.
     214# integer index.  Returns an error if the <name> is not recognized.
    151215# ----------------------------------------------------------------------
    152216itcl::body Rappture::Pager::index {name} {
    153     return [lsearch -exact $_pages $name]
    154 }
    155 
    156 # ----------------------------------------------------------------------
    157 # USAGE: get ?<name>?
     217    set i [lsearch $_pages $name]
     218    if {$i >= 0} {
     219        return $i
     220    }
     221    if {[regexp {^@([0-9]+)$} $name match i]} {
     222        return $i
     223    }
     224    error "bad page name \"$name\": should be @int or one of [join [lsort $_pages] {, }]"
     225}
     226
     227# ----------------------------------------------------------------------
     228# USAGE: page
     229# USAGE: page <name>|@n ?-frame|-title|-command? ?<newvalue>?
    158230#
    159231# Clients use this to get information about pages.  With no args, it
    160 # returns a list of all page names.  Otherwise, it returns the frame
    161 # associated with a page name.
    162 # ----------------------------------------------------------------------
    163 itcl::body Rappture::Pager::get {{name ""}} {
    164     if {$name == ""} {
     232# returns a list of all page names.  Otherwise, it returns the
     233# requested information for a page specified by its <name> or index
     234# @n.  By default, it returns the -frame for the page, but it can
     235# also return the -title and -command.  The -title and -command
     236# can also be set to a <newvalue>.
     237# ----------------------------------------------------------------------
     238itcl::body Rappture::Pager::page {args} {
     239    if {[llength $args] == 0} {
    165240        return $_pages
    166241    }
    167     if {[info exists _page2frame($name)]} {
    168         return $_page2frame($name)
    169     }
    170     return ""
     242    set i [index [lindex $args 0]]
     243    set name [lindex $_pages $i]
     244
     245    set args [lrange $args 1 end]
     246    Rappture::getopts args params {
     247        flag what -frame default
     248        flag what -title
     249        flag what -command
     250    }
     251
     252    if {[llength $args] == 0} {
     253        set opt $params(what)
     254        return $_page2info($name$opt)
     255    } elseif {[llength $args] == 1} {
     256        set val [lindex $args 0]
     257        if {$params(-title)} {
     258            set _page2info($name-title) $val
     259        } elseif {$params(-command)} {
     260            set _page2info($name-command) $val
     261        }
     262    } else {
     263        error "wrong # args: should be \"page ?which? ?-frame|-title|-command? ?newvalue?\""
     264    }
     265}
     266
     267# ----------------------------------------------------------------------
     268# USAGE: current ?<name>|next>|<back?
     269#
     270# Used to query/set the current page in the notebook.  With no args,
     271# it returns the name of the current page.  Otherwise, it sets the
     272# current page.  The special token "next>" is used to set the pager
     273# to the next logical page, and "<back" sets to the previous.
     274# ----------------------------------------------------------------------
     275itcl::body Rappture::Pager::current {args} {
     276    switch -- [llength $args] {
     277        0 {
     278            return $_current
     279        }
     280        1 {
     281            if {$itk_option(-arrangement) != "pages"} {
     282                return ""
     283            }
     284            set name [lindex $args 0]
     285            set index 0
     286            if {$name == "next>"} {
     287                if {$_current == ""} {
     288                    set index 0
     289                } else {
     290                    set i [lsearch -exact $_pages $_current]
     291                    set index [expr {$i+1}]
     292                    if {$index >= [llength $_pages]} {
     293                        set index [expr {[llength $_pages]-1}]
     294                    }
     295                }
     296                set _current [lindex $_pages $index]
     297            } elseif {$name == "<back"} {
     298                if {$_current == ""} {
     299                    set index end
     300                } else {
     301                    set i [lsearch -exact $_pages $_current]
     302                    set index [expr {$i-1}]
     303                    if {$index < 0} {
     304                        set index 0
     305                    }
     306                }
     307                set _current [lindex $_pages $index]
     308            } else {
     309                if {$name == ""} {
     310                    set _current ""
     311                    set index 0
     312                } else {
     313                    set index [lsearch -exact $_pages $name]
     314                    if {$index < 0} {
     315                        error "can't move to page \"$name\""
     316                    }
     317                    set _current [lindex $_pages $index]
     318                }
     319            }
     320
     321            foreach w [pack slaves $itk_component(inside)] {
     322                pack forget $w
     323            }
     324            if {$_current != ""} {
     325                pack $_page2info($_current-frame) -expand yes -fill both \
     326                    -padx $itk_option(-padding) -pady $itk_option(-padding)
     327            }
     328
     329            if {$index == 0} {
     330                pack forget $itk_component(back)
     331            } else {
     332                set prev [expr {$index-1}]
     333                if {$prev >= 0} {
     334                    set label "< [page @$prev -title]"
     335                } else {
     336                    set label "< Back"
     337                }
     338                $itk_component(back) configure -text $label
     339                pack $itk_component(back) -side left
     340            }
     341            if {$index == [expr {[llength $_pages]-1}]} {
     342                pack forget $itk_component(next)
     343            } else {
     344                set next [expr {$index+1}]
     345                if {$next <= [llength $_pages]} {
     346                    set label "[page @$next -title] >"
     347                } else {
     348                    set label "Next >"
     349                }
     350                $itk_component(next) configure -text $label
     351                pack $itk_component(next) -side right
     352            }
     353            _drawCrumbs current
     354
     355            #
     356            # If this new page has a command associated with it, then
     357            # invoke it now.
     358            #
     359            if {"" != $_current
     360                  && [string length $_page2info($_current-command)] > 0} {
     361                uplevel #0 $_page2info($_current-command)
     362            }
     363        }
     364        default {
     365            error "wrong # args: should be \"current name|next>|<back\""
     366        }
     367    }
    171368}
    172369
     
    178375# ----------------------------------------------------------------------
    179376itcl::body Rappture::Pager::_layout {} {
    180     #
    181     # If the new arrangement doesn't match the last one, then
    182     # clear the effects of the old arrangement.
    183     #
    184     regexp {(.*)/?} $_arrangement match oldatype
    185     regexp {(.*)/?} $itk_option(-arrangement) match newatype
    186 
    187     if {$newatype != $oldatype} {
    188         switch -glob -- $_arrangement {
    189             tabs/* {
     377    if {$itk_option(-arrangement) == "pages"} {
     378        if {$_current == ""} {
     379            set _current [lindex $_pages 0]
     380            if {$_current != ""} {
     381                current $_current
     382            }
     383        }
     384        _drawCrumbs all
     385    }
     386}
     387
     388# ----------------------------------------------------------------------
     389# USAGE: _fixSize
     390#
     391# Invoked automatically whenever a page changes size or the -width
     392# or -height options change.  When the -width/-height are zero, this
     393# method computes the minimum size needed to accommodate all pages.
     394# Otherwise, it passes the size request onto the hull.
     395# ----------------------------------------------------------------------
     396itcl::body Rappture::Pager::_fixSize {} {
     397    switch -- $itk_option(-arrangement) {
     398        pages {
     399            if {$itk_option(-width) <= 0} {
     400                update idletasks
     401                set maxw [expr {
     402                    [winfo reqwidth $itk_component(next)]
     403                    + 10
     404                    + [winfo reqwidth $itk_component(back)]}]
     405
    190406                foreach name $_pages {
    191                     pack forget $_page2frame($name)
    192                 }
    193                 pack forget $itk_component(inside)
    194                 catch {$itk_component(tabs) delete 0 end}
    195             }
    196             stack {
     407                    set w [winfo reqwidth $_page2info($name-frame)]
     408                    if {$w > $maxw} { set maxw $w }
     409                }
     410                set maxw [expr {$maxw + 2*$itk_option(-padding)}]
     411                $itk_component(inside) configure -width $maxw
     412            } else {
     413                $itk_component(inside) configure -width $itk_option(-width)
     414            }
     415
     416            if {$itk_option(-height) <= 0} {
     417                update idletasks
     418                set maxh 0
    197419                foreach name $_pages {
    198                     pack forget $_page2frame($name)
    199                 }
    200             }
    201         }
    202         switch -glob -- $itk_option(-arrangement) {
    203             tabs/* {
     420                    set h [winfo reqheight $_page2info($name-frame)]
     421                    if {$h > $maxh} { set maxh $h }
     422                }
     423                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
     424                $itk_component(inside) configure -height $maxh
     425            } else {
     426                $itk_component(inside) configure -height $itk_option(-height)
     427            }
     428        }
     429        side-by-side {
     430            if {$itk_option(-width) <= 0} {
     431                update idletasks
     432                set maxw [expr {
     433                    [winfo reqwidth $itk_component(next)]
     434                    + 10
     435                    + [winfo reqwidth $itk_component(back)]}]
     436
     437                set wtotal 0
    204438                foreach name $_pages {
    205                     $itk_component(tabs) insert end $name
    206                 }
    207                 if {[llength $_pages] > 0} {
    208                     $itk_component(tabs) select 0
    209                 }
    210             }
    211         }
    212     }
    213     set _arrangement $itk_option(-arrangement)
    214 
    215     #
    216     # Apply the new arrangement.
    217     #
    218     switch -glob -- $itk_option(-arrangement) {
    219         tabs/* {
    220             set side [lindex [split $itk_option(-arrangement) /] 1]
    221             if {$side == ""} { set side "top" }
    222             $itk_component(tabs) configure -side $side
    223 
    224             if {[llength $_pages] <= 1} {
    225                 pack $itk_component(inside) -expand yes -fill both
    226                 set first [lindex $_pages 0]
    227                 if {$first != ""} {
    228                     pack $_page2frame($first) -expand yes -fill both
    229                 }
    230             } else {
    231                 pack forget $itk_component(inside)
    232                 set i [$itk_component(tabs) index select]
    233                 if {$i != ""} {
    234                     set name [$itk_component(tabs) get $i]
    235                     $itk_component(tabs) tab configure $name \
    236                         -window $itk_component(inside) -fill both
    237                 }
    238 
     439                    set w [winfo reqwidth $_page2info($name-frame)]
     440                    set wtotal [expr {$wtotal + $w + 2*$itk_option(-padding)}]
     441                }
     442                if {$wtotal > $maxw} { set maxw $wtotal }
     443                $itk_component(inside) configure -width $maxw
     444            } else {
     445                $itk_component(inside) configure -width $itk_option(-width)
     446            }
     447
     448            if {$itk_option(-height) <= 0} {
     449                update idletasks
     450                set maxh 0
    239451                foreach name $_pages {
    240                     pack forget $_page2frame($name)
    241                 }
    242                 if {$i != ""} {
    243                     set name [lindex $_pages $i]
    244                     if {$name != ""} {
    245                         pack $_page2frame($name) -expand yes -fill both
    246                     }
    247                 }
    248             }
    249         }
    250         stack {
     452                    set h [winfo reqheight $_page2info($name-frame)]
     453                    if {$h > $maxh} { set maxh $h }
     454                }
     455                set maxh [expr {$maxh + 2*$itk_option(-padding)}]
     456                $itk_component(inside) configure -height $maxh
     457            } else {
     458                $itk_component(inside) configure -height $itk_option(-height)
     459            }
     460        }
     461    }
     462}
     463
     464# ----------------------------------------------------------------------
     465# OPTION: -arrangement
     466# ----------------------------------------------------------------------
     467itcl::configbody Rappture::Pager::arrangement {
     468    switch -- $itk_option(-arrangement) {
     469        pages {
     470            pack forget $itk_component(inside)
     471            pack $itk_component(controls) -side bottom -fill x -padx 8 -pady 8
     472            if {[llength $_pages] > 2} {
     473                pack $itk_component(breadcrumbs) -side top -fill x \
     474                    -padx 8 -pady 8
     475                pack $itk_component(line) -side top -fill x
     476            }
     477            pack $itk_component(inside) -expand yes -fill both
     478            current [lindex $_pages 0]
     479        }
     480        side-by-side {
     481            pack forget $itk_component(controls)
     482            pack forget $itk_component(line)
     483            pack forget $itk_component(breadcrumbs)
     484
     485            foreach w [pack slaves $itk_component(inside)] {
     486                pack forget $w
     487            }
    251488            foreach name $_pages {
    252                 pack forget $_page2frame($name)
    253             }
     489                pack $_page2info($name-frame) -side left \
     490                    -expand yes -fill both \
     491                    -padx $itk_option(-padding) -pady $itk_option(-padding)
     492            }
     493        }
     494        default {
     495            error "bad value \"$itk_option(-arrangement)\": should be pages or side-by-side"
     496        }
     497    }
     498    $_dispatcher event -now !fixsize
     499}
     500
     501# ----------------------------------------------------------------------
     502# OPTION: -width
     503# ----------------------------------------------------------------------
     504itcl::configbody Rappture::Pager::width {
     505    $_dispatcher event -idle !fixsize
     506}
     507
     508# ----------------------------------------------------------------------
     509# OPTION: -height
     510# ----------------------------------------------------------------------
     511itcl::configbody Rappture::Pager::height {
     512    $_dispatcher event -idle !fixsize
     513}
     514
     515# ----------------------------------------------------------------------
     516# OPTION: -padding
     517# ----------------------------------------------------------------------
     518itcl::configbody Rappture::Pager::padding {
     519    if {$_current != ""} {
     520        pack $_page2info($_current-frame) -expand yes -fill both \
     521            -padx $itk_option(-padding) -pady $itk_option(-padding)
     522    }
     523    $_dispatcher event -idle !fixsize
     524}
     525
     526# ----------------------------------------------------------------------
     527# USAGE: _drawCrumbs all|current
     528#
     529# Invoked automatically whenever the pages change.  The value "all"
     530# signifies that the number of pages has changed, so all should be
     531# redrawn.  The value "current" means that the current page has
     532# changed, so there is just a simple color change.
     533# ----------------------------------------------------------------------
     534itcl::body Rappture::Pager::_drawCrumbs {how} {
     535    set c $itk_component(breadcrumbs)
     536    set fnt $itk_option(-crumbfont)
     537
     538    switch -- $how {
     539        all {
     540            $c delete all
     541
     542            set x 0
     543            set y [expr {[winfo reqheight $c]/2}]
     544            set last [lindex $_pages end]
     545
     546            set num 1
    254547            foreach name $_pages {
    255                 pack $_page2frame($name) -expand yes -fill both
    256             }
    257             pack $itk_component(inside) -expand yes -fill both
    258         }
    259     }
    260 }
    261 
    262 # ----------------------------------------------------------------------
    263 # CONFIGURATION OPTION: -arrangement
    264 # ----------------------------------------------------------------------
    265 itcl::configbody Rappture::Pager::arrangement {
    266     set legal {tabs/top tabs/bottom tabs/left tabs/right stack}
    267     if {[lsearch -exact $legal $itk_option(-arrangement)] < 0} {
    268         error "bad option \"$itk_option(-arrangement)\": should be one of [join [lsort $legal] {, }]"
    269     }
    270     $_dispatcher event -idle !layout
    271 }
    272 
    273 source dispatcher.tcl
    274 
    275 Rappture::Pager .p
    276 pack .p -expand yes -fill both
    277 
    278 set f [.p component inside]
    279 label $f.top -text "top"
    280 pack $f.top -fill x
    281 
    282 set f [.p insert end "Electrical"]
    283 label $f.l -text "Electrical" -background black -foreground white
    284 pack $f.l -expand yes -fill both
    285 
    286 set f [.p insert end "Doping"]
    287 label $f.l -text "Doping" -background black -foreground white
    288 pack $f.l -expand yes -fill both
     548                set ht [expr {[font metrics $fnt -linespace]+2}]
     549                set id [$c create oval $x [expr {$y-$ht/2}] \
     550                    [expr {$x+$ht}] [expr {$y+$ht/2}] \
     551                    -outline "" -fill $itk_option(-dimcrumbcolor) \
     552                    -tags $name]
     553                set id [$c create text [expr {$x+$ht/2}] [expr {$y+1}] \
     554                    -text $num -fill $itk_option(-crumbnumbercolor) \
     555                    -tags [list $name $name-num]]
     556                set x [expr {$x + $ht+2}]
     557
     558                set id [$c create text $x [expr {$y+1}] -anchor w \
     559                    -text [page $name -title] -font $fnt -tags $name]
     560
     561                $c bind $name <Enter> [itcl::code $this _drawCrumbs active]
     562                $c bind $name <Leave> [itcl::code $this _drawCrumbs current]
     563                $c bind $name <ButtonPress> [itcl::code $this current $name]
     564
     565                foreach {x0 y0 x1 y1} [$c bbox $id] break
     566                set x [expr {$x + ($x1-$x0)+6}]
     567
     568                if {$name != $last} {
     569                    set id [$c create bitmap $x $y -anchor w \
     570                        -bitmap Pager-arrow \
     571                        -foreground $itk_option(-dimcrumbcolor)]
     572                    foreach {x0 y0 x1 y1} [$c bbox $id] break
     573                    set x [expr {$x + ($x1-$x0)+6}]
     574                }
     575
     576                incr num
     577            }
     578
     579            # fix the scrollregion in case we go off screen
     580            $c configure -scrollregion [$c bbox all]
     581
     582            _drawCrumbs current
     583        }
     584        current {
     585            # make all crumbs dim
     586            foreach name $_pages {
     587                $c itemconfigure $name \
     588                    -fill $itk_option(-dimcrumbcolor)
     589                $c itemconfigure $name-num \
     590                    -fill $itk_option(-crumbnumbercolor)
     591            }
     592
     593            # make all the current crumb bright
     594            if {$_current != ""} {
     595                $c itemconfigure $_current \
     596                    -fill $itk_option(-crumbcolor)
     597                $c itemconfigure $_current-num \
     598                    -fill $itk_option(-crumbnumbercolor)
     599
     600                # scroll the view to see the crumb
     601                if {[$c bbox $_current] != ""} {
     602                    foreach {x0 y0 x1 y1} [$c bbox $_current] break
     603                    foreach {xm0 ym0 xm1 ym1} [$c bbox all] break
     604                    set xm [expr {double($x0)/($xm1-$xm0)}]
     605                    $c xview moveto $xm
     606                }
     607            } else {
     608                $c xview moveto 0
     609            }
     610        }
     611        active {
     612            foreach tag [$c gettags current] {
     613                if {[lsearch -exact $_pages $tag] >= 0} {
     614                    $c itemconfigure $tag -fill $itk_option(-activecrumbcolor)
     615                    $c itemconfigure $tag-num -fill white
     616                }
     617            }
     618        }
     619    }
     620}
  • trunk/gui/scripts/scroller.tcl

    r1 r11  
    99# ======================================================================
    1010#  AUTHOR:  Michael McLennan, Purdue University
    11 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     11#  Copyright (c) 2004-2005
     12#  Purdue Research Foundation, West Lafayette, IN
    1213# ======================================================================
    1314package require Itk
     
    3233    protected method _widget2sbar {which args}
    3334    protected method _fixsbar {which {state ""}}
    34     protected method _fixframe {}
     35    protected method _fixframe {which}
    3536    protected method _lock {option}
    3637
     
    100101    if {$widget == "frame"} {
    101102        if {$_frame == ""} {
    102             set _frame [canvas $itk_component(hull).ifr]
    103             bind $_frame <Configure> [itcl::code $this _resizeframe]
     103            set _frame [canvas $itk_component(hull).ifr -highlightthickness 0]
     104            frame $_frame.f
     105            $_frame create window 0 0 -anchor nw -window $_frame.f -tags frame
     106            bind $_frame.f <Configure> [itcl::code $this _fixframe inner]
     107            bind $_frame <Configure> [itcl::code $this _fixframe outer]
    104108        }
    105109        set widget $_frame
     
    119123    set _contents $widget
    120124
     125    if {$widget == $_frame} {
     126        return $_frame.f
     127    }
    121128    return $widget
    122129}
     
    149156itcl::body Rappture::Scroller::_fixsbar {which {state ""}} {
    150157    if {$state == ""} {
    151         switch -- $itk_option(-${which}scrollmode) {
     158        switch -- [string tolower $itk_option(-${which}scrollmode)] {
    152159            on - 1 - true - yes  { set state 1 }
    153160            off - 0 - false - no { set state 0 }
     
    161168                }
    162169            }
     170            default {
     171                set state 0
     172            }
    163173        }
    164174    }
     
    187197
    188198# ----------------------------------------------------------------------
    189 # USAGE: _fixframe
     199# USAGE: _fixframe <which>
    190200#
    191201# Invoked automatically whenever the canvas representing the "frame"
     
    193203# to the new size.
    194204# ----------------------------------------------------------------------
    195 itcl::body Rappture::Scroller::_fixframe {} {
    196     $_frame configure -scrollregion [$_frame bbox all]
     205itcl::body Rappture::Scroller::_fixframe {which} {
     206    switch -- $which {
     207        inner {
     208            $_frame configure -scrollregion [$_frame bbox all]
     209        }
     210        outer {
     211            $_frame itemconfigure frame -width [winfo width $_frame]
     212        }
     213    }
    197214}
    198215
     
    248265itcl::configbody Rappture::Scroller::width {
    249266    if {$itk_option(-width) == "0"} {
     267        if {$itk_option(-height) == "0"} {
     268            grid propagate $itk_component(hull) yes
     269        } else {
     270            component hull configure -width 1i
     271        }
     272    } else {
     273        grid propagate $itk_component(hull) no
     274        component hull configure -width $itk_option(-width)
     275    }
     276}
     277
     278# ----------------------------------------------------------------------
     279# OPTION: -height
     280# ----------------------------------------------------------------------
     281itcl::configbody Rappture::Scroller::height {
     282    if {$itk_option(-height) == "0"} {
    250283        if {$itk_option(-width) == "0"} {
    251284            grid propagate $itk_component(hull) yes
    252285        } else {
    253             component hull configure -width 1i
    254         }
    255     } else {
    256         grid propagate $itk_component(hull) no
    257         component hull configure -width $itk_option(-width)
    258     }
    259 }
    260 
    261 # ----------------------------------------------------------------------
    262 # OPTION: -height
    263 # ----------------------------------------------------------------------
    264 itcl::configbody Rappture::Scroller::height {
    265     if {$itk_option(-height) == "0"} {
    266         if {$itk_option(-height) == "0"} {
    267             grid propagate $itk_component(hull) yes
    268         } else {
    269286            component hull configure -height 1i
    270287        }
  • trunk/gui/scripts/spectrum.tcl

    r9 r11  
    1414# ======================================================================
    1515#  AUTHOR:  Michael McLennan, Purdue University
    16 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     16#  Copyright (c) 2004-2005
     17#  Purdue Research Foundation, West Lafayette, IN
    1718# ======================================================================
    1819package require Itk
     
    160161        error "wrong # args: should be \"get ?-color|-fraction? ?value?\""
    161162    }
     163
    162164    set value [lindex $args 0]
    163 
    164     set value [Rappture::Units::convert $value \
    165         -context $units -to $units -units off]
     165    if {$units != ""} {
     166        set value [Rappture::Units::convert $value \
     167            -context $units -to $units -units off]
     168    }
    166169
    167170    switch -- $what {
  • trunk/gui/scripts/tempgauge.tcl

    r1 r11  
    66# ======================================================================
    77#  AUTHOR:  Michael McLennan, Purdue University
    8 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     8#  Copyright (c) 2004-2005
     9#  Purdue Research Foundation, West Lafayette, IN
    910# ======================================================================
    1011package require Itk
  • trunk/gui/scripts/tooltip.tcl

    r1 r11  
    1717# ======================================================================
    1818#  AUTHOR:  Michael McLennan, Purdue University
    19 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     19#  Copyright (c) 2004-2005
     20#  Purdue Research Foundation, West Lafayette, IN
    2021# ======================================================================
    2122package require Itk
     
    2526option add *Tooltip.borderwidth 1 widgetDefault
    2627option add *Tooltip.font -*-helvetica-medium-r-normal-*-*-120-* widgetDefault
    27 option add *Tooltip.wrapLength 3i widgetDefault
     28option add *Tooltip.wrapLength 4i widgetDefault
    2829
    2930itcl::class Rappture::Tooltip {
     
    4041
    4142    public proc for {widget args}
     43    public proc text {widget args}
    4244    private common catalog    ;# maps widget => message
    4345
    44     public proc tooltip {option {widget ""}}
     46    public proc tooltip {option args}
    4547    private common pending "" ;# after ID for pending "tooltip show"
    4648
     
    9193
    9294# ----------------------------------------------------------------------
    93 # USAGE: show @<x>,<y>|<widget>
     95# USAGE: show @<x>,<y>|<widget>+<x>,<y>
    9496#
    9597# Clients use this to pop up the tooltip on the screen.  The position
    96 # should be either a <widget> name (tooltip pops up beneath widget)
    97 # or a specific root window coordinate of the form @x,y.
     98# should be either a <widget> name with an optional offset +<x>,<y>
     99# (tooltip pops up beneath widget by default), or a specific root
     100# window coordinate of the form @x,y.
    98101#
    99102# If the -message has the form "@command", then the command is executed
     
    102105# ----------------------------------------------------------------------
    103106itcl::body Rappture::Tooltip::show {where} {
     107    set hull $itk_component(hull)
     108
    104109    if {[regexp {^@([0-9]+),([0-9]+)$} $where match x y]} {
    105110        set xpos $x
    106111        set ypos $y
     112    } elseif {[regexp {^(.*)\+([0-9]+),([0-9]+)$} $where match win x y]} {
     113        set xpos [expr {[winfo rootx $win]+$x}]
     114        set ypos [expr {[winfo rooty $win]+$y}]
    107115    } elseif {[winfo exists $where]} {
    108116        set xpos [expr {[winfo rootx $where]+10}]
    109117        set ypos [expr {[winfo rooty $where]+[winfo height $where]}]
    110118    } else {
    111         error "bad position \"$where\": should be widget name or @x,y"
     119        error "bad position \"$where\": should be widget name, +x,y, or @x,y"
    112120    }
    113121
     
    122130    }
    123131
     132    # strings can't be too big, or they'll go off screen!
     133    if {[string length $mesg] > 1000} {
     134        set mesg "[string range $mesg 0 1000]..."
     135    }
     136    set pos 0
     137    ::for {set i 0} {$pos >= 0 && $i < 5} {incr i} {
     138        incr pos
     139        set pos [string first \n $mesg $pos]
     140    }
     141    if {$pos > 0} {
     142        set mesg "[string range $mesg 0 $pos]..."
     143    }
    124144    $itk_component(text) configure -text $mesg
    125145
    126     wm geometry $itk_component(hull) +$xpos+$ypos
     146    #
     147    # Make sure the tooltip doesn't go off screen.  Then, put it up.
     148    #
    127149    update
    128 
    129     wm deiconify $itk_component(hull)
    130     raise $itk_component(hull)
     150    if {$xpos+[winfo reqwidth $hull] > [winfo screenwidth $hull]} {
     151        set xpos [expr {[winfo screenwidth $hull]-[winfo reqwidth $hull]}]
     152    }
     153    if {$xpos < 0} { set xpos 0 }
     154
     155    if {$ypos+[winfo reqheight $hull] > [winfo screenheight $hull]} {
     156        set ypos [expr {[winfo screenheight $hull]-[winfo reqheight $hull]}]
     157    }
     158    if {$ypos < 0} { set ypos 0 }
     159
     160    wm geometry $hull +$xpos+$ypos
     161    update
     162
     163    wm deiconify $hull
     164    raise $hull
    131165}
    132166
     
    166200
    167201# ----------------------------------------------------------------------
    168 # USAGE: tooltip pending <widget>
    169 # USAGE: tooltip show
     202# USAGE: text <widget> ?<text>?
     203#
     204# Used to query or set the text used for the tooltip for a widget.
     205# This is done automatically when you call the "for" proc, but it
     206# is sometimes handy to query or change the text later.
     207# ----------------------------------------------------------------------
     208itcl::body Rappture::Tooltip::text {widget args} {
     209    if {[llength $args] == 0} {
     210        if {[info exists catalog($widget)]} {
     211            return $catalog($widget)
     212        }
     213        return ""
     214    } elseif {[llength $args] == 1} {
     215        set str [lindex $args 0]
     216        set catalog($widget) $str
     217    } else {
     218        error "wrong # args: should be \"text widget ?str?\""
     219    }
     220}
     221
     222# ----------------------------------------------------------------------
     223# USAGE: tooltip pending <widget> ?@<x>,<y>|+<x>,<y>?
     224# USAGE: tooltip show <widget> ?@<x>,<y>|+<x>,<y>?
    170225# USAGE: tooltip cancel
    171226#
     
    176231# bindings take over.
    177232# ----------------------------------------------------------------------
    178 itcl::body Rappture::Tooltip::tooltip {option {widget ""}} {
     233itcl::body Rappture::Tooltip::tooltip {option args} {
    179234    switch -- $option {
    180235        pending {
     236            if {[llength $args] < 1 || [llength $args] > 2} {
     237                error "wrong # args: should be \"tooltip pending widget ?@x,y?\""
     238            }
     239            set widget [lindex $args 0]
     240            set loc [lindex $args 1]
     241
    181242            if {![info exists catalog($widget)]} {
    182243                error "can't find tooltip for $widget"
     
    185246                after cancel $pending
    186247            }
    187             set pending [after 1500 [itcl::code tooltip show $widget]]
     248            set pending [after 1500 [itcl::code tooltip show $widget $loc]]
    188249        }
    189250        show {
     251            if {[llength $args] < 1 || [llength $args] > 2} {
     252                error "wrong # args: should be \"tooltip pending widget ?@x,y?\""
     253            }
     254            set widget [lindex $args 0]
     255            set loc [lindex $args 1]
     256
    190257            if {[winfo exists $widget]} {
    191258                .rappturetooltip configure -message $catalog($widget)
    192                 .rappturetooltip show $widget
     259                if {[string index $loc 0] == "@"} {
     260                    .rappturetooltip show $loc
     261                } elseif {[string index $loc 0] == "+"} {
     262                    .rappturetooltip show $widget$loc
     263                } else {
     264                    .rappturetooltip show $widget
     265                }
    193266            }
    194267        }
  • trunk/gui/scripts/units.tcl

    r1 r11  
    77# ======================================================================
    88#  AUTHOR:  Michael McLennan, Purdue University
    9 #  Copyright (c) 2004  Purdue Research Foundation, West Lafayette, IN
     9#  Copyright (c) 2004-2005
     10#  Purdue Research Foundation, West Lafayette, IN
    1011# ======================================================================
    1112package require Itcl
     
    474475Rappture::Units::define F->C {(F-32)/1.8} {(1.8*C)+32}
    475476
    476 Rappture::Units::define eV -type potential -metric yes
     477Rappture::Units::define eV -type energy -metric yes
     478
     479Rappture::Units::define V -type voltage -metric yes
  • trunk/python/Rappture/library.py

    r6 r11  
    4040
    4141    # ------------------------------------------------------------------
    42     def element(self, path="", flavor="object"):
     42    def element(self, path="", as="object"):
    4343        """
    4444        Clients use this to query a particular element within the
     
    5151        By default, this method returns an object representing the
    5252        DOM node referenced by the path.  This is changed by setting
    53         the "flavor" argument to "id" (for name of the tail element),
     53        the "as" argument to "id" (for name of the tail element),
    5454        to "type" (for the type of the tail element), to "component"
    5555        (for the component name "type(id)"), or to "object"
     
    6161            return None
    6262
    63         if flavor == 'object':
     63        if as == 'object':
    6464            return library(node)
    65         elif flavor == 'component':
     65        elif as == 'component':
    6666            return self._node2comp(node)
    67         elif flavor == 'id':
     67        elif as == 'id':
    6868            return self._node2name(node)
    69         elif flavor == 'type':
     69        elif as == 'type':
    7070            return node.tagName
    7171
    72         raise ValueError, "bad flavor '%s': should be object, id, type" % flavor
    73 
    74     # ------------------------------------------------------------------
    75     def children(self, path="", flavor="object", type=None):
     72        raise ValueError, "bad as value '%s': should be component, id, object, type" % as
     73
     74    # ------------------------------------------------------------------
     75    def children(self, path="", as="object", type=None):
    7676        """
    7777        Clients use this to query the children of a particular element
     
    8383
    8484        By default, this method returns a list of objects representing
    85         the children.  This is changed by setting the "flavor" argument
     85        the children.  This is changed by setting the "as" argument
    8686        to "id" (for tail names of all children), to "type" (for the
    8787        types of all children), to "component" (for the path component
     
    9999            nlist = [n for n in nlist if n.nodeName == type]
    100100
    101         if flavor == 'object':
     101        if as == 'object':
    102102            return [library(n) for n in nlist]
    103         elif flavor == 'component':
     103        elif as == 'component':
    104104            return [self._node2comp(n) for n in nlist]
    105         elif flavor == 'id':
     105        elif as == 'id':
    106106            return [self._node2name(n) for n in nlist]
    107         elif flavor == 'type':
     107        elif as == 'type':
    108108            return [n.tagName for n in nlist]
     109
     110        raise ValueError, "bad as value '%s': should be component, id, object, type" % as
    109111
    110112    # ------------------------------------------------------------------
  • trunk/tcl/scripts/library.tcl

    r9 r11  
    1111package require Itcl
    1212
    13 namespace eval Rappture { # forward declaration }
    14 
    15 # ----------------------------------------------------------------------
    16 # USAGE: library ?-std? <file>
     13namespace eval Rappture {
     14    variable stdlib ""
     15}
     16
     17# ----------------------------------------------------------------------
     18# USAGE: library <file>
     19# USAGE: library standard
    1720# USAGE: library isvalid <object>
    1821#
     
    2124# file that represents it.
    2225#
    23 # If the -std flag is included, then the file is treated as the
    24 # name of a standard file, which is part of the Rappture installation.
     26# If you use the word "standard" in place of the file name, this
     27# function returns the standard Rappture library object, which
     28# contains material definitions.
    2529#
    2630# The isvalid operation checks an <object> to see if it is a valid
     
    4044    }
    4145
    42     # handle the open operation...
    43     set stdfile 0
    44     while {[llength $args] > 1} {
    45         set switch [lindex $args 0]
    46         set args [lrange $args 1 end]
    47         if {$switch == "-std"} {
    48             set stdfile 1
    49         } else {
    50             error "bad option \"$switch\": should be -std"
    51         }
     46    if {[llength $args] != 1} {
     47        error "wrong # args: should be \"library file\" or \"library isvalid object\""
    5248    }
    5349    set fname [lindex $args 0]
    5450
    55     if {$stdfile && [file pathtype $fname] != "absolute"} {
    56         set fname [file join $Rappture::installdir lib $fname]
     51    if {$fname == "standard"} {
     52        variable stdlib
     53        if {$stdlib != ""} {
     54            return $stdlib
     55        }
     56        set fname [file join $Rappture::installdir lib library.xml]
     57
     58        set fid [::open $fname r]
     59        set info [read $fid]
     60        close $fid
     61
     62        set stdlib [Rappture::LibraryObj ::#auto $info]
     63        return $stdlib
    5764    }
    5865
     
    7178
    7279# ----------------------------------------------------------------------
     80# USAGE: entities ?-as <fval>? <object> <path>
     81#
     82# Used to sift through an XML <object> for "entities" within the
     83# Rappture description.  Entities are things like strings, numbers,
     84# etc., which show up in the GUI as controls.
     85#
     86# Returns a list of all entities found beneath <path>.
     87#
     88# By default, this method returns the component name "type(id)".
     89# This is changed by setting the -as argument to "id" (for name
     90# of the tail element), to "type" (for the type of the tail element),
     91# to "object" (for an object representing the DOM node referenced by
     92# the path.
     93# ----------------------------------------------------------------------
     94proc Rappture::entities {args} {
     95    array set params {
     96        -as component
     97    }
     98    while {[llength $args] > 1} {
     99        set first [lindex $args 0]
     100        if {[string index $first 0] == "-"} {
     101            set choices [array names params]
     102            if {[lsearch $choices $first] < 0} {
     103                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
     104            }
     105            set params($first) [lindex $args 1]
     106            set args [lrange $args 2 end]
     107        } else {
     108            break
     109        }
     110    }
     111    if {[llength $args] > 2} {
     112        error "wrong # args: should be \"entities ?-as fval? obj ?path?\""
     113    }
     114    set xmlobj [lindex $args 0]
     115    set path [lindex $args 1]
     116
     117    set rlist ""
     118    lappend queue $path
     119    while {[llength $queue] > 0} {
     120        set path [lindex $queue 0]
     121        set queue [lrange $queue 1 end]
     122
     123        foreach cpath [$xmlobj children -as path $path] {
     124            switch -- [$xmlobj element -as type $cpath] {
     125                group {
     126                    lappend queue $cpath
     127                }
     128                structure {
     129                    if {[$xmlobj element $cpath.current.parameters] != ""} {
     130                        lappend queue $cpath.current.parameters
     131                    }
     132                }
     133                default {
     134                    # add this to the return list with the right flavor
     135                    if {$params(-as) == "component"} {
     136                        lappend rlist $cpath
     137                    } else {
     138                        lappend rlist [$xmlobj element -as $params(-as) $cpath]
     139                    }
     140
     141                    # if this element has embedded groups, add them to the queue
     142                    foreach ccpath [$xmlobj children -as path $cpath] {
     143                        if {[$xmlobj element -as type $ccpath] == "group"} {
     144                            lappend queue $ccpath
     145                        }
     146                    }
     147                }
     148            }
     149        }
     150    }
     151    return $rlist
     152}
     153
     154# ----------------------------------------------------------------------
    73155itcl::class Rappture::LibraryObj {
    74156    constructor {info} { # defined below }
     
    76158
    77159    public method element {args}
     160    public method parent {args}
    78161    public method children {args}
    79162    public method get {{path ""}}
     
    82165    public method xml {}
    83166
     167    public method diff {libobj}
     168    public proc value {libobj path}
     169
    84170    protected method find {path}
    85171    protected method path2list {path}
    86172    protected method node2name {node}
    87173    protected method node2comp {node}
     174    protected method node2path {node}
     175    protected method childnodes {node type}
    88176
    89177    private variable _root 0       ;# non-zero => this obj owns document
     
    119207
    120208# ----------------------------------------------------------------------
    121 # USAGE: element ?-flavor <fval>? ?<path>?
     209# USAGE: element ?-as <fval>? ?<path>?
    122210#
    123211# Clients use this to query a particular element within the entire
     
    128216#
    129217# By default, this method returns the component name "type(id)".
    130 # This is changed by setting the -flavor argument to "id" (for name
     218# This is changed by setting the -as argument to "id" (for name
    131219# of the tail element), to "type" (for the type of the tail element),
    132220# to "object" (for an object representing the DOM node referenced by
    133 # the path.
     221# the path).
    134222# ----------------------------------------------------------------------
    135223itcl::body Rappture::LibraryObj::element {args} {
    136224    array set params {
    137         -flavor component
     225        -as component
    138226    }
    139227    while {[llength $args] > 1} {
     
    151239    }
    152240    if {[llength $args] > 1} {
    153         error "wrong # args: should be \"element ?-flavor fval? ?path?\""
     241        error "wrong # args: should be \"element ?-as fval? ?path?\""
    154242    }
    155243    set path [lindex $args 0]
     
    160248    }
    161249
    162     switch -- $params(-flavor) {
     250    switch -- $params(-as) {
    163251      object {
    164252          return [::Rappture::LibraryObj ::#auto $node]
     
    170258          return [node2name $node]
    171259      }
     260      path {
     261          return [node2path $node]
     262      }
    172263      type {
    173264          return [$node nodeName]
    174265      }
    175266      default {
    176           error "bad flavor \"$params(-flavor)\": should be object, id, type, component"
    177       }
    178     }
    179 }
    180 
    181 # ----------------------------------------------------------------------
    182 # USAGE: children ?-flavor <fval>? ?-type <name>? ?<path>?
    183 #
    184 # Clients use this to query the children of a particular element
    185 # within the entire data structure.  This is just like the "element"
    186 # method, but it returns the children of the element instead of the
    187 # element itself.  If the optional -type argument is specified, then
    188 # the return list is restricted to children of the specified type.
     267          error "bad flavor \"$params(-as)\": should be component, id, object, path, type"
     268      }
     269    }
     270}
     271
     272# ----------------------------------------------------------------------
     273# USAGE: parent ?-as <fval>? ?<path>?
     274#
     275# Clients use this to query the parent of a particular element.
     276# This is just like the "element" method, but it returns the parent
     277# of the element instead of the element itself.
    189278#
    190279# By default, this method returns a list of component names "type(id)".
    191 # This is changed by setting the -flavor argument to "id" (for tail
     280# This is changed by setting the -as argument to "id" (for tail
    192281# names of all children), to "type" (for the types of all children),
    193282# to "object" (for a list of objects representing the DOM nodes for
    194283# all children).
    195284# ----------------------------------------------------------------------
    196 itcl::body Rappture::LibraryObj::children {args} {
     285itcl::body Rappture::LibraryObj::parent {args} {
    197286    array set params {
    198         -flavor component
    199         -type ""
     287        -as component
    200288    }
    201289    while {[llength $args] > 1} {
     
    213301    }
    214302    if {[llength $args] > 1} {
    215         error "wrong # args: should be \"children ?-flavor fval? ?-type name? ?path?\""
     303        error "wrong # args: should be \"parent ?-as fval? ?path?\""
     304    }
     305    set path [lindex $args 0]
     306
     307    set node [find $path]
     308    if {$node == ""} {
     309        return ""
     310    }
     311    set node [$node parentNode]
     312
     313    switch -- $params(-as) {
     314      object {
     315          return [::Rappture::LibraryObj ::#auto $node]
     316      }
     317      component {
     318          return [node2comp $node]
     319      }
     320      id {
     321          return [node2name $node]
     322      }
     323      path {
     324          return [node2path $node]
     325      }
     326      type {
     327          return [$node nodeName]
     328      }
     329      default {
     330          error "bad flavor \"$params(-as)\": should be component, id, object, path, type"
     331      }
     332    }
     333}
     334
     335# ----------------------------------------------------------------------
     336# USAGE: children ?-as <fval>? ?-type <name>? ?<path>?
     337#
     338# Clients use this to query the children of a particular element
     339# within the entire data structure.  This is just like the "element"
     340# method, but it returns the children of the element instead of the
     341# element itself.  If the optional -type argument is specified, then
     342# the return list is restricted to children of the specified type.
     343#
     344# By default, this method returns a list of component names "type(id)".
     345# This is changed by setting the -as argument to "id" (for tail
     346# names of all children), to "type" (for the types of all children),
     347# to "object" (for a list of objects representing the DOM nodes for
     348# all children).
     349# ----------------------------------------------------------------------
     350itcl::body Rappture::LibraryObj::children {args} {
     351    array set params {
     352        -as component
     353        -type ""
     354    }
     355    while {[llength $args] > 1} {
     356        set first [lindex $args 0]
     357        if {[string index $first 0] == "-"} {
     358            set choices [array names params]
     359            if {[lsearch $choices $first] < 0} {
     360                error "bad option \"$first\": should be [join [lsort $choices] {, }]"
     361            }
     362            set params($first) [lindex $args 1]
     363            set args [lrange $args 2 end]
     364        } else {
     365            break
     366        }
     367    }
     368    if {[llength $args] > 1} {
     369        error "wrong # args: should be \"children ?-as fval? ?-type name? ?path?\""
    216370    }
    217371    set path [lindex $args 0]
     
    235389
    236390    set rlist ""
    237     switch -- $params(-flavor) {
     391    switch -- $params(-as) {
    238392      object {
    239393          foreach n $nlist {
     
    251405          }
    252406      }
     407      path {
     408          foreach n $nlist {
     409              lappend rlist [node2path $n]
     410          }
     411      }
    253412      type {
    254413          foreach n $nlist {
     
    257416      }
    258417      default {
    259           error "bad flavor \"$params(-flavor)\": should be object, id, type, component"
     418          error "bad flavor \"$params(-as)\": should be component, id, object, type"
    260419      }
    261420    }
     
    344503
    345504    if {[Rappture::library isvalid $str]} {
    346         error "not yet implemented"
     505        foreach n [[$str info variable _node -value] childNodes] {
     506            $node appendXML [$n asXML]
     507        }
    347508    } else {
    348509        set n [$_document createText $str]
     
    376537itcl::body Rappture::LibraryObj::xml {} {
    377538    return [$_node asXML]
     539}
     540
     541# ----------------------------------------------------------------------
     542# USAGE: diff <libobj>
     543#
     544# Compares the entities in this object to those in another and
     545# returns a list of differences.  The result is a list of the form:
     546# {op1 path1 oldval1 newval1 ...} where each "op" is +/-/c for
     547# added/subtracted/changed, "path" is the path within the library
     548# that is different, and "oldval"/"newval" give the values for the
     549# object at the path.
     550# ----------------------------------------------------------------------
     551itcl::body Rappture::LibraryObj::diff {libobj} {
     552    set rlist ""
     553
     554    # query the values for all entities in both objects
     555    set thisv [Rappture::entities $this input]
     556    set otherv [Rappture::entities $libobj input]
     557
     558    # scan through values for this object, and compare against other one
     559    foreach path $thisv {
     560        set i [lsearch -exact $otherv $path]
     561        if {$i < 0} {
     562            foreach {raw norm} [value $this $path] break
     563            lappend rlist - $path $raw ""
     564        } else {
     565            foreach {traw tnorm} [value $this $path] break
     566            foreach {oraw onorm} [value $libobj $path] break
     567            if {![string equal $tnorm $onorm]} {
     568                lappend rlist c $path $traw $oraw
     569            }
     570            set otherv [lreplace $otherv $i $i]
     571        }
     572    }
     573
     574    # add any values left over in the other object
     575    foreach path $otherv {
     576        foreach {oraw onorm} [value $libobj $path] break
     577        lappend rlist + $path "" $oraw
     578    }
     579    return $rlist
     580}
     581
     582# ----------------------------------------------------------------------
     583# USAGE: value <object> <path>
     584#
     585# Used to query the "value" associated with the <path> in an XML
     586# <object>.  This is a little more complicated than the object's
     587# "get" method.  It handles things like structures and values
     588# with normalized units.
     589#
     590# Returns a list of two items:  {raw norm} where "raw" is the raw
     591# value from the "get" method and "norm" is the normalized value
     592# produced by this routine.  Example:  {300K 300}
     593#
     594# Right now, it is a handy little utility used by the "diff" method.
     595# Eventually, it should be moved to a better object-oriented
     596# implementation, where each Rappture type could overload the
     597# various bits of processing below.  So we leave it as a "proc"
     598# now instead of a method, since it should be deprecated soon.
     599# ----------------------------------------------------------------------
     600itcl::body Rappture::LibraryObj::value {libobj path} {
     601    switch -- [$libobj element -as type $path] {
     602        structure {
     603            set raw $path
     604            # try to find a label to represent the structure
     605            set val [$libobj get $path.about.label]
     606            if {"" == $val} {
     607                set val [$libobj get $path.current.about.label]
     608            }
     609            if {"" == $val} {
     610                if {[$libobj element $path.current] != ""} {
     611                    set comps [$libobj children $path.current.components]
     612                    set val "<structure> with [llength $comps] components"
     613                } else {
     614                    set val "<structure>"
     615                }
     616            }
     617            return [list $raw $val]
     618        }
     619        number {
     620            # get the usual value...
     621            set raw ""
     622            if {"" != [$libobj element $path.current]} {
     623                set raw [$libobj get $path.current]
     624            } elseif {"" != [$libobj element $path.default]} {
     625                set raw [$libobj get $path.default]
     626            }
     627            if {"" != $raw} {
     628                set val $raw
     629                # then normalize to default units
     630                set units [$libobj get $path.units]
     631                if {"" != $units} {
     632                    set val [Rappture::Units::convert $val \
     633                        -context $units -to $units -units off]
     634                }
     635            }
     636            return [list $raw $val]
     637        }
     638    }
     639
     640    # for all other types, get the value (current, or maybe default)
     641    set raw ""
     642    if {"" != [$libobj element $path.current]} {
     643        set raw [$libobj get $path.current]
     644    } elseif {"" != [$libobj element $path.default]} {
     645        set raw [$libobj get $path.default]
     646    }
     647    return [list $raw $raw]
    378648}
    379649
     
    440710                set index 0
    441711            }
    442             set nlist [$node getElementsByTagName $type]
     712            set nlist [childnodes $node $type]
    443713            set node [lindex $nlist $index]
    444714        } else {
     
    450720            #
    451721            if {$type != ""} {
    452                 set nlist [$node getElementsByTagName $type]
     722                set nlist [childnodes $node $type]
    453723            } else {
    454724                set nlist [$node childNodes]
     
    554824        }
    555825        set type [$node nodeName]
    556         set siblings [$pnode getElementsByTagName $type]
     826        set siblings [childnodes $pnode $type]
    557827        set index [lsearch $siblings $node]
    558828        if {$index == 0} {
     
    581851            return ""
    582852        }
    583         set siblings [$pnode getElementsByTagName $type]
     853        set siblings [childnodes $pnode $type]
    584854        set index [lsearch $siblings $node]
    585855        if {$index == 0} {
     
    593863    return $name
    594864}
     865
     866# ----------------------------------------------------------------------
     867# USAGE: node2path <node>
     868#
     869# Used internally to create a full path name for the specified node.
     870# The path is relative to the current object, so it stops when the
     871# parent is the root node for this object.
     872# ----------------------------------------------------------------------
     873itcl::body Rappture::LibraryObj::node2path {node} {
     874    set path [node2comp $node]
     875    set node [$node parentNode]
     876    while {$node != "" && $node != $_node} {
     877        set path "[node2comp $node].$path"
     878        set node [$node parentNode]
     879    }
     880    return $path
     881}
     882
     883# ----------------------------------------------------------------------
     884# USAGE: childnodes <node> <type>
     885#
     886# Used internally to return a list of children for the given <node>
     887# that match a specified <type>.  Similar to XML getElementsByTagName,
     888# but returns only direct children of the <node>.
     889# ----------------------------------------------------------------------
     890itcl::body Rappture::LibraryObj::childnodes {node type} {
     891    set rlist ""
     892    foreach cnode [$node childNodes] {
     893        if {[$cnode nodeName] == $type} {
     894            lappend rlist $cnode
     895        }
     896    }
     897    return $rlist
     898}
Note: See TracChangeset for help on using the changeset viewer.