Changeset 761


Ignore:
Timestamp:
Jun 8, 2007, 5:16:22 PM (17 years ago)
Author:
mmc
Message:

Added a new <note> object which can be used to add annotations to
the input side. Each <note> has a <contents> area which contains
a url for a web site or a file. All file urls are treated as
relative to the "docs" directory where the tool.xml is located.

Fixed the output for <number>, <integer>, <boolean>, and <choice>
so that it shows multiple values when "All" is pressed, and it
highlights the current value. Also fixed the download option for
this widget so that it works properly.

Fixed the energy level viewer so that its download option works.

Location:
trunk/gui/scripts
Files:
2 added
4 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/controlOwner.tcl

    r438 r761  
    440440        foreach path [array names _path2widget] {
    441441            set type [$_xmlobj element -as type $path]
    442             if {[lsearch {group separator control} $type] >= 0} {
     442            if {[lsearch {group separator control note} $type] >= 0} {
    443443                continue
    444444            }

  • trunk/gui/scripts/controls.tcl

    r676 r761  
    171171            # no widget to create
    172172            set _name2info($name-value) "--"
     173        }
     174        note {
     175            Rappture::Note $w $_owner $path
    173176        }
    174177        default {
    … …  
    237240    $_owner widgetfor $path $w
    238241
    239     if {$type != "control" && $type != "group" && $type != "separator"} {
     242    if {[lsearch {control group separator note} $type] < 0} {
    240243        # make a label for this control
    241244        set label [$w label]
    … …  
    528531
    529532                grid rowconfigure $_frame $row -weight 0
    530                 grid rowconfigure $_frame $row -weight 0
    531533
    532534                switch -- [winfo class $wv] {
    … …  
    541543                    GroupEntry {
    542544                        $wv configure -heading yes
     545                    }
     546                    Note {
     547                        grid $wv -sticky nsew
     548                        grid rowconfigure $_frame $row -weight 1
    543549                    }
    544550                }

  • trunk/gui/scripts/energyLevels.tcl

    r738 r761  
    4444    public method add {table {settings ""}}
    4545    public method delete {args}
     46    public method get {}
    4647    public method scale {args}
    4748    public method download {args} {}
    … …  
    5859    private variable _dobj2color   ;# maps data obj => color option
    5960    private variable _dobj2raise   ;# maps data obj => raise option
     61    private variable _dobj2desc    ;# maps data obj => description
    6062    private variable _dobj2cols    ;# maps data obj => column names
    6163    private variable _emin ""      ;# autoscale min for energy
    … …  
    7072    private variable _llumo ""     ;# label for LUMO level
    7173    private variable _hilite ""    ;# item currently highlighted
     74    common _downloadPopup          ;# download options from popup
    7275}
    7376
    … …  
    8588    $_dispatcher register !zoom
    8689    $_dispatcher dispatch $this !zoom "[itcl::code $this _redraw zoom]; list"
     90
     91    array set _downloadPopup {
     92        format csv
     93    }
    8794
    8895    itk_option add hull.width hull.height
    … …  
    293300        set _dobj2color($dataobj) $params(-color)
    294301        set _dobj2raise($dataobj) $params(-raise)
     302        set _dobj2desc($dataobj) $params(-description)
    295303
    296304        foreach {lcol ecol} $cols break
    … …  
    321329            catch {unset _dobj2color($dataobj)}
    322330            catch {unset _dobj2raise($dataobj)}
     331            catch {unset _dobj2desc($dataobj)}
    323332            catch {unset _dobj2cols($dataobj-label)}
    324333            catch {unset _dobj2cols($dataobj-energy)}
    … …  
    334343
    335344# ----------------------------------------------------------------------
    336 # USAGE: scale ?<dataobj1> <dataobj2> ...?
    337 #
    338 # Sets the default limits for the overall plot according to the
    339 # limits of the data for all of the given <dataobj> objects.  This
    340 # accounts for all dataobjs--even those not showing on the screen.
    341 # Because of this, the limits are appropriate for all data as
    342 # the user scans through data in the ResultSet viewer.
    343 # ----------------------------------------------------------------------
    344 itcl::body Rappture::EnergyLevels::scale {args} {
    345     set _emin ""
    346     set _emax ""
    347     foreach obj $args {
    348         if {![info exists _dobj2cols($obj-energy)]} {
    349             # don't recognize this object? then ignore it
    350             continue
    351         }
    352         foreach {min max} [$obj limits $_dobj2cols($obj-energy)] break
    353 
    354         if {"" != $min && "" != $max} {
    355             if {"" == $_emin} {
    356                 set _emin $min
    357                 set _emax $max
    358             } else {
    359                 if {$min < $_emin} { set _emin $min }
    360                 if {$max > $_emax} { set _emax $max }
    361             }
    362         }
    363     }
    364 
    365     if {"" != $_emin && $_emin == $_emax} {
    366         set _emin [expr {$_emin-0.1}]
    367         set _emax [expr {$_emax+0.1}]
    368     }
    369 
    370     set _eviewmin ""  ;# reset zoom view
    371     set _eviewmax ""
    372 }
    373 
    374 # ----------------------------------------------------------------------
    375 # USAGE: _redraw
    376 #
    377 # Used internally to load a list of energy levels from a <table> within
    378 # the data objects.
    379 # ----------------------------------------------------------------------
    380 itcl::body Rappture::EnergyLevels::_redraw {{what all}} {
    381     # scale data now, if we haven't already
    382     if {"" == $_emin || "" == $_emax} {
    383         eval scale $_dlist
    384     }
    385 
     345# USAGE: get
     346#
     347# Clients use this to query the list of objects being plotted, in
     348# order from bottom to top of this result.
     349# ----------------------------------------------------------------------
     350itcl::body Rappture::EnergyLevels::get {} {
    386351    # put the dataobj list in order according to -raise options
    387352    set dlist $_dlist
    … …  
    395360        }
    396361    }
     362    return $dlist
     363}
     364
     365# ----------------------------------------------------------------------
     366# USAGE: scale ?<dataobj1> <dataobj2> ...?
     367#
     368# Sets the default limits for the overall plot according to the
     369# limits of the data for all of the given <dataobj> objects.  This
     370# accounts for all dataobjs--even those not showing on the screen.
     371# Because of this, the limits are appropriate for all data as
     372# the user scans through data in the ResultSet viewer.
     373# ----------------------------------------------------------------------
     374itcl::body Rappture::EnergyLevels::scale {args} {
     375    set _emin ""
     376    set _emax ""
     377    foreach obj $args {
     378        if {![info exists _dobj2cols($obj-energy)]} {
     379            # don't recognize this object? then ignore it
     380            continue
     381        }
     382        foreach {min max} [$obj limits $_dobj2cols($obj-energy)] break
     383
     384        if {"" != $min && "" != $max} {
     385            if {"" == $_emin} {
     386                set _emin $min
     387                set _emax $max
     388            } else {
     389                if {$min < $_emin} { set _emin $min }
     390                if {$max > $_emax} { set _emax $max }
     391            }
     392        }
     393    }
     394
     395    if {"" != $_emin && $_emin == $_emax} {
     396        set _emin [expr {$_emin-0.1}]
     397        set _emax [expr {$_emax+0.1}]
     398    }
     399
     400    set _eviewmin ""  ;# reset zoom view
     401    set _eviewmax ""
     402}
     403
     404# ----------------------------------------------------------------------
     405# USAGE: download coming
     406# USAGE: download controls <downloadCommand>
     407# USAGE: download now
     408#
     409# Clients use this method to create a downloadable representation
     410# of the plot.  Returns a list of the form {ext string}, where
     411# "ext" is the file extension (indicating the type of data) and
     412# "string" is the data itself.
     413# ----------------------------------------------------------------------
     414itcl::body Rappture::EnergyLevels::download {option args} {
     415    switch $option {
     416        coming {
     417            # nothing to do
     418        }
     419        controls {
     420            set popup .energyresultdownload
     421            if {![winfo exists .energyresultdownload]} {
     422                # if we haven't created the popup yet, do it now
     423                Rappture::Balloon $popup -title "Download as..."
     424                set inner [$popup component inner]
     425                label $inner.summary -text "" -anchor w
     426                pack $inner.summary -side top
     427                radiobutton $inner.csv -text "Data as Comma-Separated Values" \
     428                    -variable Rappture::EnergyLevels::_downloadPopup(format) \
     429                    -value csv
     430                pack $inner.csv -anchor w
     431                radiobutton $inner.pdf -text "Image as PDF/PostScript" \
     432                    -variable Rappture::EnergyLevels::_downloadPopup(format) \
     433                    -value pdf
     434                pack $inner.pdf -anchor w
     435                button $inner.go -text "Download Now" \
     436                    -command [lindex $args 0]
     437                pack $inner.go -pady 4
     438            } else {
     439                set inner [$popup component inner]
     440            }
     441            set num [llength [get]]
     442            set num [expr {($num == 1) ? "1 result" : "$num results"}]
     443            $inner.summary configure -text "Download $num in the following format:"
     444            update idletasks ;# fix initial sizes
     445            return $popup
     446        }
     447        now {
     448            set popup .energyresultdownload
     449            if {[winfo exists .energyresultdownload]} {
     450                $popup deactivate
     451            }
     452            switch -- $_downloadPopup(format) {
     453              csv {
     454                # reverse the objects so the selected data appears on top
     455                set dlist ""
     456                foreach dataobj [get] {
     457                    set dlist [linsert $dlist 0 $dataobj]
     458                }
     459                # generate the comma-separated value data for these objects
     460                set csvdata ""
     461                foreach dataobj $dlist {
     462                    append csvdata "[string repeat - 60]\n"
     463                    append csvdata " [$dataobj hints label]\n"
     464                    if {[info exists _dobj2desc($dataobj)]
     465                          && [llength [split $_dobj2desc($dataobj) \n]] > 1} {
     466                        set indent "for:"
     467                        foreach line [split $_dobj2desc($dataobj) \n] {
     468                            append csvdata " $indent $line\n"
     469                            set indent "    "
     470                        }
     471                    }
     472                    append csvdata "[string repeat - 60]\n"
     473
     474                    set ecol $_dobj2cols($dataobj-energy)
     475                    set units [$dataobj columns -units $ecol]
     476                    foreach eval [$dataobj values -column $ecol] {
     477                        append csvdata [format "%20.15g $units\n" $eval]
     478                    }
     479                    append csvdata "\n"
     480                }
     481                return [list .txt $csvdata]
     482              }
     483              pdf {
     484                set psdata [$itk_component(graph) postscript]
     485
     486                set cmds {
     487                    set fout "energy[pid].pdf"
     488                    exec ps2pdf - $fout << $psdata
     489
     490                    set fid [open $fout r]
     491                    fconfigure $fid -translation binary -encoding binary
     492                    set pdfdata [read $fid]
     493                    close $fid
     494
     495                    file delete -force $fout
     496                }
     497                if {[catch $cmds result] == 0} {
     498                    return [list .pdf $pdfdata]
     499                }
     500                return [list .ps $psdata]
     501              }
     502            }
     503        }
     504        default {
     505            error "bad option \"$option\": should be coming, controls, now"
     506        }
     507    }
     508}
     509
     510# ----------------------------------------------------------------------
     511# USAGE: _redraw
     512#
     513# Used internally to load a list of energy levels from a <table> within
     514# the data objects.
     515# ----------------------------------------------------------------------
     516itcl::body Rappture::EnergyLevels::_redraw {{what all}} {
     517    # scale data now, if we haven't already
     518    if {"" == $_emin || "" == $_emax} {
     519        eval scale $_dlist
     520    }
     521
     522    set dlist [get]
    397523    set topdobj [lindex $dlist end]
    398 
    399524    _getLayout
    400525

  • trunk/gui/scripts/valueresult.tcl

    r676 r761  
    1616option add *ValueResult.font \
    1717    -*-helvetica-medium-r-normal-*-12-* widgetDefault
    18 option add *ValueResult.boldFont \
    19     -*-helvetica-bold-r-normal-*-12-* widgetDefault
    2018
    2119itcl::class Rappture::ValueResult {
    … …  
    3028    public method download {option args}
    3129
    32     set _dataobj ""  ;# data object currently being displayed
     30    protected method _rebuild {}
     31
     32    private variable _dispatcher "" ;# dispatcher for !events
     33
     34    private variable _dlist ""    ;# list of data objects being displayed
     35    private variable _dobj2color  ;# maps data object => color
     36    private variable _dobj2raise  ;# maps data object => raise flag 0/1
     37    private variable _dobj2desc   ;# maps data object => description
    3338}
    3439                                                                               
    … …  
    4146# ----------------------------------------------------------------------
    4247itcl::body Rappture::ValueResult::constructor {args} {
    43     itk_component add label {
    44         label $itk_interior.l
    45     }
    46     pack $itk_component(label) -side left
    47 
    48     itk_component add value {
    49         label $itk_interior.value -anchor w
    50     } {
    51         usual
    52         rename -font -boldfont boldFont Font
    53         ignore -foreground
    54     }
    55     pack $itk_component(value) -side left -expand yes -fill both
     48    Rappture::dispatcher _dispatcher
     49    $_dispatcher register !rebuild
     50    $_dispatcher dispatch $this !rebuild "[itcl::code $this _rebuild]; list"
     51
     52    itk_component add scroller {
     53        Rappture::Scroller $itk_interior.scroller \
     54            -xscrollmode auto -yscrollmode auto
     55    }
     56    pack $itk_component(scroller) -expand yes -fill both
     57
     58    itk_component add html {
     59        Rappture::HTMLviewer $itk_component(scroller).html
     60    }
     61    $itk_component(scroller) contents $itk_component(html)
    5662
    5763    eval itk_initialize $args
    … …  
    6975    array set params {
    7076        -color ""
    71         -brightness ""
     77        -brightness 0
    7278        -width ""
    7379        -linestyle ""
    74         -raise ""
     80        -raise 0
    7581        -description ""
    7682    }
    … …  
    8692    }
    8793
    88     $itk_component(label) configure -text ""
    89     $itk_component(value) configure -text ""
    90 
    9194    if {"" != $dataobj} {
    92         set label [$dataobj get about.label]
    93         if {"" != $label && [string index $label end] != ":"} {
    94             append label ":"
    95         }
    96         $itk_component(label) configure -text $label
    97 
    9895        # find the value and assign it with the proper coloring
    9996        if {"" != $params(-color) && "" != $params(-brightness)
    … …  
    10299                $params(-color) $params(-brightness)]
    103100        }
    104         if {$params(-color) != ""} {
    105             $itk_component(value) configure -foreground $params(-color)
    106         } else {
    107             $itk_component(value) configure -foreground $itk_option(-foreground)
    108         }
    109         $itk_component(value) configure -text [$dataobj get current]
    110     }
    111     set _dataobj $dataobj
     101
     102        set pos [lsearch -exact $dataobj $_dlist]
     103        if {$pos < 0} {
     104            lappend _dlist $dataobj
     105            set _dobj2color($dataobj) $params(-color)
     106            set _dobj2raise($dataobj) $params(-raise)
     107            set _dobj2desc($dataobj) $params(-description)
     108            $_dispatcher event -idle !rebuild
     109        }
     110    }
    112111}
    113112
    … …  
    119118# ----------------------------------------------------------------------
    120119itcl::body Rappture::ValueResult::get {} {
    121     return $_dataobj
     120    # put the dataobj list in order according to -raise options
     121    set dlist $_dlist
     122    foreach obj $dlist {
     123        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
     124            set i [lsearch -exact $dlist $obj]
     125            if {$i >= 0} {
     126                set dlist [lreplace $dlist $i $i]
     127                lappend dlist $obj
     128            }
     129        }
     130    }
     131    return $dlist
    122132}
    123133
    … …  
    129139# ----------------------------------------------------------------------
    130140itcl::body Rappture::ValueResult::delete {args} {
    131     $itk_component(label) configure -text ""
    132     $itk_component(value) configure -text ""
    133     set _dataobj ""
     141    if {[llength $args] == 0} {
     142        set args $_dlist
     143    }
     144
     145    # delete all specified objects
     146    set changed 0
     147    foreach obj $args {
     148        set pos [lsearch -exact $_dlist $obj]
     149        if {$pos >= 0} {
     150            set _dlist [lreplace $_dlist $pos $pos]
     151            catch {unset _dobj2color($obj)}
     152            catch {unset _dobj2raise($obj)}
     153            catch {unset _dobj2desc($obj)}
     154            set changed 1
     155        }
     156    }
     157
     158    # if anything changed, then rebuild the plot
     159    if {$changed} {
     160        $_dispatcher event -idle !rebuild
     161    }
    134162}
    135163
    … …  
    167195        }
    168196        now {
    169             set lstr [$itk_component(label) cget -text]
    170             set vstr [$itk_component(value) cget -text]
    171             return [list .txt "$lstr $vstr"]
     197            if {[llength $_dlist] == 1} {
     198                set lstr [$_dlist get about.label]
     199                set mesg "$lstr [$_dlist get current]"
     200            } else {
     201                set mesg ""
     202                foreach obj $_dlist {
     203                    set lstr [$obj get about.label]
     204                    append mesg "$lstr [$obj get current]\n"
     205                    if {[string length $_dobj2desc($obj)] > 0} {
     206                        foreach line [split $_dobj2desc($obj) \n] {
     207                            append mesg " * $line\n"
     208                        }
     209                        append mesg "\n"
     210                    }
     211                }
     212            }
     213            return [list .txt $mesg]
    172214        }
    173215        default {
    … …  
    176218    }
    177219}
     220
     221# ----------------------------------------------------------------------
     222# USAGE: _rebuild
     223#
     224# Used internally to rebuild the contents of this widget
     225# whenever the data within it changes.  Shows the value
     226# for the topmost data object in its associated color.
     227# ----------------------------------------------------------------------
     228itcl::body Rappture::ValueResult::_rebuild {} {
     229    set html "<html><body>"
     230
     231    set obj [lindex $_dlist 0]
     232    if {"" != $obj} {
     233        set label [$obj get about.label]
     234        if {"" != $label && [string index $label end] != ":"} {
     235            append label ":"
     236        }
     237        append html "<h3>$label</h3>\n"
     238    }
     239
     240    foreach obj $_dlist {
     241        if {$_dobj2raise($obj)} {
     242            set bold0 "<b>"
     243            set bold1 "</b>"
     244            set bg "background:#ffffcc; border:1px solid #cccccc;"
     245        } else {
     246            set bold0 ""
     247            set bold1 ""
     248            set bg ""
     249        }
     250        if {$_dobj2color($obj) != ""} {
     251            set color0 "<font style=\"color: $_dobj2color($obj)\">"
     252            set color1 "</font>"
     253        } else {
     254            set color0 ""
     255            set color1 ""
     256        }
     257
     258        append html "<div style=\"margin:8px; padding:4px; $bg\">${bold0}${color0}[$obj get current]${color1}${bold1}"
     259        if {$_dobj2raise($obj) && [string length $_dobj2desc($obj)] > 0} {
     260            foreach line [split $_dobj2desc($obj) \n] {
     261                append html "<li style=\"margin-left:12px;\">$line</li>\n"
     262            }
     263        }
     264        append html "</div>"
     265    }
     266    append html "</body></html>"
     267    $itk_component(html) load $html
     268}
Note: See TracChangeset for help on using the changeset viewer.