Changeset 11 for trunk/tcl


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.

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/tcl/scripts/library.tcl

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