Changeset 11 for trunk/gui


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/gui
Files:
24 added
2 deleted
23 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
Note: See TracChangeset for help on using the changeset viewer.