Changeset 22


Ignore:
Timestamp:
Jul 16, 2005 2:31:32 PM (18 years ago)
Author:
mmc
Message:

Lots of changes to support Huckel-IV:

  • Support for embedded <tool> declarations
  • New <integer> entry
  • Support for numbers and structures as output elements
  • Atom numbers/symbols in MoleculeViewer?
Location:
trunk
Files:
8 added
21 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/apps/driver

    r17 r22  
    2525package require Rappture
    2626
    27 option add *MainWin.mode web startupFile
     27option add *MainWin.mode desktop startupFile
    2828option add *MainWin.borderWidth 0 startupFile
    29 option add *MainWin.anchor nw startupFile
     29option add *MainWin.anchor center startupFile
    3030
    3131# "web site" look
    … …  
    129129pack $f.analyze -expand yes -fill both
    130130
    131 $tool configure -analyzer $f.analyze
     131$tool notify add analyzer * [list $f.analyze reset]
    132132
    133133# ----------------------------------------------------------------------
    … …  
    147147        $f.analyze configure -holdwindow [$win.pager page @0]
    148148
    149         if {[$tool xml get tool.control] == "auto"} {
     149        set type [$tool xml get tool.control]
     150        if {$type == ""} {
     151            set type [$tool xml get tool.control.type]
     152        }
     153
     154        if {$type == "auto"} {
    150155            # in "auto" mode, we don't need a simulate button
    151156            $f.analyze configure -simcontrol off

  • trunk/gui/scripts/analyzer.tcl

    r17 r22  
    228228    # tool can run on "manual" (default) or "auto"
    229229    set cntl [$tool xml get tool.control]
     230    if {"" == $cntl} {
     231        set cntl [$tool xml get tool.control.type]
     232    }
    230233    if {"" != $cntl} {
    231234        set _control $cntl
    … …  
    369372            curve* - field* {
    370373                _autoLabel $xmlobj output.$item "Plot" counters
     374            }
     375            structure* {
     376                _autoLabel $xmlobj output.$item "Structure" counters
    371377            }
    372378            table* {

  • trunk/gui/scripts/booleanentry.tcl

    r13 r22  
    1414    inherit itk::Widget
    1515
    16     constructor {xmlobj path args} { # defined below }
     16    constructor {owner path args} { # defined below }
    1717
    1818    public method value {args}
    … …  
    2323    protected method _newValue {}
    2424
    25     private variable _xmlobj ""   ;# XML containing description
     25    private variable _owner ""    ;# thing managing this control
    2626    private variable _path ""     ;# path in XML to this number
    2727}
    … …  
    3737# CONSTRUCTOR
    3838# ----------------------------------------------------------------------
    39 itcl::body Rappture::BooleanEntry::constructor {xmlobj path args} {
    40     if {![Rappture::library isvalid $xmlobj]} {
    41         error "bad value \"$xmlobj\": should be Rappture::library"
     39itcl::body Rappture::BooleanEntry::constructor {owner path args} {
     40    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
     41        error "bad object \"$owner\": should be Rappture::ControlOwner"
    4242    }
    43     set _xmlobj $xmlobj
     43    set _owner $owner
    4444    set _path $path
    4545
    … …  
    5454    bind $itk_component(switch) <<Value>> [itcl::code $this _newValue]
    5555
    56     set color [$xmlobj get $path.about.color]
     56    set color [$_owner xml get $path.about.color]
    5757    if {$color != ""} {
    5858        $itk_component(switch) configure -oncolor $color
    … …  
    6060
    6161    # if the control has an icon, plug it in
    62     set str [$xmlobj get $path.about.icon]
     62    set str [$_owner xml get $path.about.icon]
    6363    if {$str != ""} {
    6464        $itk_component(switch) configure -onimage \
    … …  
    7171    # Assign the default value to this widget, if there is one.
    7272    #
    73     set str [$xmlobj get $path.default]
     73    set str [$_owner xml get $path.default]
    7474    if {"" != $str != ""} { $itk_component(switch) value $str }
    7575}
    … …  
    118118# ----------------------------------------------------------------------
    119119itcl::body Rappture::BooleanEntry::label {} {
    120     set label [$_xmlobj get $_path.about.label]
     120    set label [$_owner xml get $_path.about.label]
    121121    if {"" == $label} {
    122122        set label "Boolean"
    … …  
    134134# ----------------------------------------------------------------------
    135135itcl::body Rappture::BooleanEntry::tooltip {} {
    136     set str [$_xmlobj get $_path.about.description]
     136    set str [$_owner xml get $_path.about.description]
    137137
    138     set units [$_xmlobj get $_path.units]
    139     set min [$_xmlobj get $_path.min]
    140     set max [$_xmlobj get $_path.max]
     138    set units [$_owner xml get $_path.units]
     139    set min [$_owner xml get $_path.min]
     140    set max [$_owner xml get $_path.max]
    141141
    142142    if {$units != "" || $min != "" || $max != ""} {

  • trunk/gui/scripts/choiceentry.tcl

    r11 r22  
    1414    inherit itk::Widget
    1515
    16     constructor {xmlobj path args} { # defined below }
     16    constructor {owner path args} { # defined below }
     17    destructor { # defined below }
    1718
    1819    public method value {args}
    … …  
    2122    public method tooltip {}
    2223
     24    protected method _rebuild {}
    2325    protected method _newValue {}
    2426    protected method _tooltip {}
    2527
    26     private variable _xmlobj ""   ;# XML containing description
     28    private variable _owner ""    ;# thing managing this control
    2729    private variable _path ""     ;# path in XML to this number
    2830}
    … …  
    3840# CONSTRUCTOR
    3941# ----------------------------------------------------------------------
    40 itcl::body Rappture::ChoiceEntry::constructor {xmlobj path args} {
    41     if {![Rappture::library isvalid $xmlobj]} {
    42         error "bad value \"$xmlobj\": should be Rappture::library"
    43     }
    44     set _xmlobj $xmlobj
     42itcl::body Rappture::ChoiceEntry::constructor {owner path args} {
     43    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
     44        error "bad object \"$owner\": should be Rappture::ControlOwner"
     45    }
     46    set _owner $owner
    4547    set _path $path
    4648
    … …  
    5759    eval itk_initialize $args
    5860
    59     #
    60     # Plug in the various choices for this widget.
    61     #
    62     # plug in the various options for the choice
    63     set max 10
    64     foreach cname [$xmlobj children -type option $path] {
    65         set str [string trim [$xmlobj get $path.$cname.label]]
    66         if {"" != $str} {
    67             $itk_component(choice) choices insert end $path.$cname $str
    68             set len [string length $str]
    69             if {$len > $max} { set max $len }
    70         }
    71     }
    72     $itk_component(choice) configure -width $max
    73 
    74     #
    75     # Assign the default value to this widget, if there is one.
    76     #
    77     set str [$xmlobj get $path.default]
    78     if {"" != $str != ""} { $itk_component(choice) value $str }
     61    _rebuild
     62}
     63
     64# ----------------------------------------------------------------------
     65# DESTRUCTOR
     66# ----------------------------------------------------------------------
     67itcl::body Rappture::ChoiceEntry::destructor {} {
     68    $_owner notify remove $this
    7969}
    8070
    … …  
    122112# ----------------------------------------------------------------------
    123113itcl::body Rappture::ChoiceEntry::label {} {
    124     set label [$_xmlobj get $_path.about.label]
     114    set label [$_owner xml get $_path.about.label]
    125115    if {"" == $label} {
    126116        set label "Number"
    … …  
    143133
    144134# ----------------------------------------------------------------------
     135# USAGE: _rebuild
     136#
     137# Used internally to rebuild the contents of this choice widget
     138# whenever something that it depends on changes.  Scans through the
     139# information in the XML spec and builds a list of choices for the
     140# widget.
     141# ----------------------------------------------------------------------
     142itcl::body Rappture::ChoiceEntry::_rebuild {} {
     143    # get rid of any existing choices
     144    $itk_component(choice) choices delete 0 end
     145
     146    #
     147    # Plug in the various options for the choice.
     148    #
     149    set max 10
     150    foreach cname [$_owner xml children -type option $_path] {
     151        set path [string trim [$_owner xml get $_path.$cname.path]]
     152        if {"" != $path} {
     153            # look for the input element controlling this path
     154            set found 0
     155            foreach cntl [Rappture::entities [$_owner xml object] "input"] {
     156                set len [string length $cntl]
     157                if {[string equal -length $len $cntl $path]} {
     158                    set found 1
     159                    break
     160                }
     161            }
     162            if {$found} {
     163                #
     164                # Choice comes from a list of matching entities at
     165                # a particular XML path.  Use the <label> as a template
     166                # for each item on the path.
     167                #
     168                $_owner notify add $this $cntl [itcl::code $this _rebuild]
     169
     170                set label [string trim [$_owner xml get $_path.$cname.about.label]]
     171                if {"" == $label} {
     172                    set label "%type #%n"
     173                }
     174
     175                set ppath [Rappture::LibraryObj::path2list $path]
     176                set leading [join [lrange $ppath 0 end-1] .]
     177                set tail [lindex $ppath end]
     178                set n 1
     179                foreach ccname [$_owner xml children $leading] {
     180                    if {[string match $tail $ccname]} {
     181                        set subst(%n) $n
     182                        set subst(%type) [$_owner xml element -as type $leading.$ccname]
     183                        set subst(%id) [$_owner xml element -as id $leading.$ccname]
     184                        foreach detail [$_owner xml children $leading.$ccname] {
     185                            set subst(%$detail) [$_owner xml get $leading.$ccname.$detail]
     186                        }
     187                        set str [string map [array get subst] $label]
     188                        $itk_component(choice) choices insert end \
     189                            $leading.$ccname $str
     190                        incr n
     191                    }
     192                }
     193                $itk_component(choice) value ""
     194            } else {
     195                puts "can't find controlling entity for path \"$path\""
     196            }
     197        } else {
     198            #
     199            # Choice is an ordinary LABEL.
     200            # Add the label as-is into the list of choices.
     201            #
     202            set str [string trim [$_owner xml get $_path.$cname.about.label]]
     203            if {"" != $str} {
     204                $itk_component(choice) choices insert end $_path.$cname $str
     205                set len [string length $str]
     206                if {$len > $max} { set max $len }
     207            }
     208        }
     209    }
     210    $itk_component(choice) configure -width $max
     211
     212    #
     213    # Assign the default value to this widget, if there is one.
     214    #
     215    set str [$_owner xml get $_path.default]
     216    if {"" != $str} { $itk_component(choice) value $str }
     217}
     218
     219# ----------------------------------------------------------------------
    145220# USAGE: _newValue
    146221#
    … …  
    160235# ----------------------------------------------------------------------
    161236itcl::body Rappture::ChoiceEntry::_tooltip {} {
    162     set tip [string trim [$_xmlobj get $_path.about.description]]
     237    set tip [string trim [$_owner xml get $_path.about.description]]
    163238
    164239    # get the description for the current choice, if there is one
    … …  
    170245
    171246        if {$path != ""} {
    172             set desc [$_xmlobj get $path.description]
     247            set desc [$_owner xml get $path.description]
    173248            if {[string length $desc] > 0} {
    174249                append tip "\n$desc"

  • trunk/gui/scripts/controls.tcl

    r13 r22  
    2323    constructor {owner args} { # defined below }
    2424
    25     public method insert {pos xmlobj path}
     25    public method insert {pos path}
    2626    public method delete {first {last ""}}
    2727    public method index {name}
    … …  
    5656
    5757# ----------------------------------------------------------------------
    58 # USAGE: insert <pos> <xmlobj> <path>
     58# USAGE: insert <pos> <path>
    5959#
    6060# Clients use this to insert a control into this panel.  The control
    6161# is inserted into the list at position <pos>, which can be an integer
    6262# starting from 0 or the keyword "end".  Information about the control
    63 # is taken from the <xmlobj> object at the specified <path>.
     63# is taken from the specified <path>.
    6464#
    6565# Returns a name that can be used to identify the control in other
    6666# methods.
    6767# ----------------------------------------------------------------------
    68 itcl::body Rappture::Controls::insert {pos xmlobj path} {
     68itcl::body Rappture::Controls::insert {pos path} {
    6969    if {"end" == $pos} {
    7070        set pos [llength $_controls]
    … …  
    7676    set name "control$_counter"
    7777
    78     set _name2info($name-xmlobj) $xmlobj
    7978    set _name2info($name-path) $path
    8079    set _name2info($name-label) ""
    8180    set _name2info($name-value) [set w $itk_interior.v$name]
    8281
    83     set type [$xmlobj element -as type $path]
     82    set type [$_owner xml element -as type $path]
    8483    switch -- $type {
    8584        choice {
    86             Rappture::ChoiceEntry $w $xmlobj $path
     85            Rappture::ChoiceEntry $w $_owner $path
    8786            bind $w <<Value>> [itcl::code $this _controlChanged $path]
    8887        }
    8988        group {
    90             Rappture::GroupEntry $w $xmlobj $path
     89            Rappture::GroupEntry $w $_owner $path
    9190        }
    9291        loader {
    93             Rappture::Loader $w $xmlobj $path -tool [$_owner tool]
     92            Rappture::Loader $w $_owner $path -tool [$_owner tool]
    9493            bind $w <<Value>> [itcl::code $this _controlChanged $path]
    9594        }
    9695        number {
    97             Rappture::NumberEntry $w $xmlobj $path
     96            Rappture::NumberEntry $w $_owner $path
     97            bind $w <<Value>> [itcl::code $this _controlChanged $path]
     98        }
     99        integer {
     100            Rappture::IntegerEntry $w $_owner $path
    98101            bind $w <<Value>> [itcl::code $this _controlChanged $path]
    99102        }
    100103        boolean {
    101             Rappture::BooleanEntry $w $xmlobj $path
     104            Rappture::BooleanEntry $w $_owner $path
    102105            bind $w <<Value>> [itcl::code $this _controlChanged $path]
    103106        }
    104107        string {
    105             Rappture::TextEntry $w $xmlobj $path
    106             bind $w <<Value>> [itcl::code $this _controlChanged $path]
     108            Rappture::TextEntry $w $_owner $path
     109            bind $w <<Value>> [itcl::code $this _controlChanged $path]
     110        }
     111        control {
     112            set label [$_owner xml get $path.label]
     113            if {"" == $label} { set label "Simulate" }
     114            set service [$_owner xml get $path.service]
     115            button $w -text $label -command [list $service run]
    107116        }
    108117        default {
    … …  
    110119        }
    111120    }
    112     $_owner widgetfor $path $w
    113 
    114     # make a label for this control
    115     set label [$w label]
    116     if {"" != $label} {
    117         set _name2info($name-label) $itk_interior.l$name
    118         set font [option get $itk_component(hull) labelFont Font]
    119         label $_name2info($name-label) -text [_formatLabel $label] \
    120             -font $font
    121     }
    122 
    123     # register the tooltip for this control
    124     set tip [$w tooltip]
    125     if {"" != $tip} {
    126         Rappture::Tooltip::for $w $tip
    127 
    128         # add the tooltip to the label too, if there is one
    129         if {$_name2info($name-label) != ""} {
    130             Rappture::Tooltip::for $_name2info($name-label) $tip
     121
     122    if {$type != "control"} {
     123        $_owner widgetfor $path $w
     124
     125        # make a label for this control
     126        set label [$w label]
     127        if {"" != $label} {
     128            set _name2info($name-label) $itk_interior.l$name
     129            set font [option get $itk_component(hull) labelFont Font]
     130            label $_name2info($name-label) -text [_formatLabel $label] \
     131                -font $font
     132        }
     133
     134        # register the tooltip for this control
     135        set tip [$w tooltip]
     136        if {"" != $tip} {
     137            Rappture::Tooltip::for $w $tip
     138
     139            # add the tooltip to the label too, if there is one
     140            if {$_name2info($name-label) != ""} {
     141                Rappture::Tooltip::for $_name2info($name-label) $tip
     142            }
    131143        }
    132144    }
    … …  
    169181            destroy $_name2info($name-value)
    170182        }
    171         unset _name2info($name-xmlobj)
    172183        unset _name2info($name-path)
    173184        unset _name2info($name-label)
    … …  
    197208
    198209# ----------------------------------------------------------------------
    199 # USAGE: control ?-label|-value|-xmlobj|-path? ?<name>|@n?
     210# USAGE: control ?-label|-value|-path? ?<name>|@n?
    200211#
    201212# Clients use this to get information about controls.  With no args, it
    202213# returns a list of all control names.  Otherwise, it returns the frame
    203214# associated with a control name.  The -label option requests the label
    204 # widget instead of the value widget.  The -xmlobj option requests the
    205 # XML object associated with the control, and the -path option requests
    206 # the path within the XML that the control affects.
     215# widget instead of the value widget.  The -path option requests the
     216# path within the XML that the control affects.
    207217# ----------------------------------------------------------------------
    208218itcl::body Rappture::Controls::control {args} {
    … …  
    213223        flag switch -value default
    214224        flag switch -label
    215         flag switch -xmlobj
    216225        flag switch -path
    217226    }

  • trunk/gui/scripts/deviceEditor.tcl

    r13 r22  
    1515option add *DeviceEditor.width 5i widgetDefault
    1616option add *DeviceEditor.height 5i widgetDefault
     17option add *DeviceEditor.autoCleanUp yes widgetDefault
    1718
    1819itcl::class Rappture::DeviceEditor {
    19     inherit itk::Widget
     20    inherit itk::Widget Rappture::ControlOwner
    2021
    21     constructor {owner args} { # defined below }
     22    itk_option define -autocleanup autoCleanUp AutoCleanUp 1
     23
     24    constructor {owner args} {
     25        Rappture::ControlOwner::constructor $owner
     26    } { # defined below }
    2227
    2328    public method value {args}
    24 
    25     # used for syncing embedded widgets
    26     public method widgetfor {path {widget ""}}
    27     public method changed {path}
    28     public method sync {}
    29     public method tool {}
    3029
    3130    protected method _redraw {}
    3231    protected method _type {xmlobj}
    3332
    34     private variable _owner ""       ;# owner containing this editor
    35     private variable _xmlobj ""      ;# XML <structure> object
    36     private variable _path2widget    ;# maps path => widget in this editor
     33    private variable _current ""  ;# active device editor
    3734}
    3835                                                                               
    … …  
    4441# ----------------------------------------------------------------------
    4542itcl::body Rappture::DeviceEditor::constructor {owner args} {
    46     set _owner $owner
    47 
    4843    itk_option add hull.width hull.height
    4944    pack propagate $itk_component(hull) no
    … …  
    8176
    8277    if {[llength $args] == 1} {
    83         # delete any existing object
    8478        if {$_xmlobj != ""} {
    85             itcl::delete object $_xmlobj
     79            if {$itk_option(-autocleanup)} {
     80                # delete any existing object
     81                itcl::delete object $_xmlobj
     82            }
    8683            set _xmlobj ""
    8784        }
     85
    8886        set newval [lindex $args 0]
    8987        if {$newval != ""} {
    … …  
    108106
    109107# ----------------------------------------------------------------------
    110 # USAGE: widgetfor <path> ?<widget>?
    111 #
    112 # Used by embedded widgets such as a Controls panel to register the
    113 # various controls associated with this page.  That way, this editor
    114 # knows what widgets to look at when syncing itself to the underlying
    115 # XML data.
    116 # ----------------------------------------------------------------------
    117 itcl::body Rappture::DeviceEditor::widgetfor {path {widget ""}} {
    118     # if this is a query operation, then look for the path
    119     if {"" == $widget} {
    120         if {[info exists _path2widget($path)]} {
    121             return $_path2widget($path)
    122         }
    123         return ""
    124     }
    125 
    126     # otherwise, associate the path with the given widget
    127     if {[info exists _path2widget($path)]} {
    128         error "$path already associated with widget $_path2widget($path)"
    129     }
    130     set _path2widget($path) $widget
    131 }
    132 
    133 # ----------------------------------------------------------------------
    134 # USAGE: changed <path>
    135 #
    136 # Invoked automatically by the various widgets associated with this
    137 # editor whenever their value changes.  If this tool has a -analyzer,
    138 # then it is notified that input has changed, so it can reset itself
    139 # for a new analysis.
    140 # ----------------------------------------------------------------------
    141 itcl::body Rappture::DeviceEditor::changed {path} {
    142     if {"" != $_owner} {
    143         $_owner changed $path
    144     }
    145 }
    146 
    147 # ----------------------------------------------------------------------
    148 # USAGE: sync
    149 #
    150 # Used by descendents such as a Controls panel to register the
    151 # various controls associated with this page.  That way, this Tool
    152 # knows what widgets to look at when syncing itself to the underlying
    153 # XML data.
    154 # ----------------------------------------------------------------------
    155 itcl::body Rappture::DeviceEditor::sync {} {
    156     foreach path [array names _path2widget] {
    157         $_xmlobj put $path.current [$_path2widget($path) value]
    158     }
    159 }
    160 
    161 # ----------------------------------------------------------------------
    162 # USAGE: tool
    163 #
    164 # Clients use this to figure out which tool is associated with
    165 # this object.  Returns the tool containing this editor.
    166 # ----------------------------------------------------------------------
    167 itcl::body Rappture::Tool::tool {} {
    168     return [$_owner tool]
    169 }
    170 
    171 # ----------------------------------------------------------------------
    172108# USAGE: _redraw
    173109#
    … …  
    178114# ----------------------------------------------------------------------
    179115itcl::body Rappture::DeviceEditor::_redraw {} {
     116    if {$_current != ""} {
     117        $_current configure -device ""
     118        set _current ""
     119    }
    180120    switch -- [_type $_xmlobj] {
    181121        molecule {
    … …  
    187127            $p.mol configure -device $_xmlobj
    188128            $itk_component(editors) current molecule
     129
     130            set _current $p.mol
    189131        }
    190132        device1D {
    … …  
    196138            $p.dev configure -device $_xmlobj
    197139            $itk_component(editors) current device1D
     140
     141            set _current $p.dev
    198142        }
    199143    }

  • trunk/gui/scripts/deviceViewer1D.tcl

    r18 r22  
    2727    itk_option define -device device Device ""
    2828
    29     constructor {tool args} { # defined below }
     29    constructor {owner args} { # defined below }
    3030    destructor { # defined below }
    3131
    … …  
    4242    protected method _controlSet {widget libObj path}
    4343
    44     private variable _tool ""       ;# tool controlling this viewer
     44    private variable _owner ""      ;# thing managing this control
    4545    private variable _device ""     ;# XML library with <structure>
    4646    private variable _tab2fields    ;# maps tab name => list of fields
    … …  
    5757# CONSTRUCTOR
    5858# ----------------------------------------------------------------------
    59 itcl::body Rappture::DeviceViewer1D::constructor {tool args} {
    60     set _tool $tool
     59itcl::body Rappture::DeviceViewer1D::constructor {owner args} {
     60    set _owner $owner
    6161
    6262    itk_option add hull.width hull.height
    … …  
    271271                set t $itk_component(top)
    272272                if {![winfo exists $t.cntls]} {
    273                     Rappture::Controls $t.cntls $_tool
     273                    Rappture::Controls $t.cntls $_owner
    274274                    pack $t.cntls -expand yes -fill both
    275275                }
    276                 $t.cntls insert end $_device parameters.$cname
     276                $t.cntls insert end parameters.$cname
    277277            }
    278278        }
    … …  
    591591
    592592            $_marker(fobj) controls put $_marker(path) $value
    593             $_tool changed $_marker(path)
     593            $_owner changed $_marker(path)
    594594            event generate $itk_component(hull) <<Edit>>
    595595

  • trunk/gui/scripts/gauge.tcl

    r17 r22  
    1515package require BLT
    1616
    17 option add *Gauge.width 30 widgetDefault
    18 option add *Gauge.height 20 widgetDefault
     17option add *Gauge.sampleWidth 30 widgetDefault
     18option add *Gauge.sampleHeight 20 widgetDefault
    1919option add *Gauge.valuePosition "right" widgetDefault
    2020option add *Gauge.textBackground #cccccc widgetDefault
    … …  
    2626    itk_option define -editable editable Editable ""
    2727    itk_option define -spectrum spectrum Spectrum ""
     28    itk_option define -type type Type "real"
    2829    itk_option define -units units Units ""
    2930    itk_option define -minvalue minValue MinValue ""
    … …  
    3233    itk_option define -valueposition valuePosition ValuePosition ""
    3334    itk_option define -image image Image ""
    34     itk_option define -width width Width 0
    35     itk_option define -height height Height 0
     35    itk_option define -samplewidth sampleWidth SampleWidth 0
     36    itk_option define -sampleheight sampleHeight SampleHeight 0
    3637
    3738    constructor {args} { # defined below }
    … …  
    3940    public method value {args}
    4041    public method edit {option}
     42    public method bump {delta}
    4143
    4244    protected method _redraw {}
    … …  
    4547    protected method _editor {option args}
    4648    protected method _presets {option}
     49    protected method _layout {}
    4750
    4851    private variable _value 0  ;# value for this widget
     52
     53    blt::bitmap define GaugeArrow-up {
     54        #define up_width 8
     55        #define up_height 4
     56        static unsigned char up_bits[] = {
     57           0x10, 0x38, 0x7c, 0xfe};
     58    }
     59    blt::bitmap define GaugeArrow-down {
     60        #define arrow_width 8
     61        #define arrow_height 4
     62        static unsigned char arrow_bits[] = {
     63           0xfe, 0x7c, 0x38, 0x10};
     64    }
    4965
    5066    blt::bitmap define GaugeArrow {
    … …  
    117133    bind $itk_component(value) <ButtonPress> \
    118134        [itcl::code $this _editor popup]
     135
     136
     137    itk_component add spinner {
     138        frame $itk_component(vframe).spinner
     139    }
     140
     141    itk_component add spinup {
     142        button $itk_component(spinner).up -bitmap GaugeArrow-up \
     143            -borderwidth 1 -relief raised -highlightthickness 0 \
     144            -command [itcl::code $this bump 1]
     145    } {
     146        usual
     147        ignore -borderwidth -highlightthickness
     148    }
     149    pack $itk_component(spinup) -side top -expand yes -fill both
     150
     151    itk_component add spindn {
     152        button $itk_component(spinner).down -bitmap GaugeArrow-down \
     153            -borderwidth 1 -relief raised -highlightthickness 0 \
     154            -command [itcl::code $this bump -1]
     155    } {
     156        usual
     157        ignore -borderwidth -highlightthickness
     158    }
     159    pack $itk_component(spindn) -side bottom -expand yes -fill both
     160
    119161
    120162    itk_component add presets {
    … …  
    199241        }
    200242
    201         if {![string is double -strict $nv]} {
    202             error "Should be a real number"
     243        switch -- $itk_option(-type) {
     244            integer {
     245                if {![string is integer -strict $nv]} {
     246                    error "Should be an integer value"
     247                }
     248            }
     249            real {
     250                if {![string is double -strict $nv]} {
     251                    error "Should be a real number"
     252                }
     253            }
    203254        }
    204255
    … …  
    249300
    250301# ----------------------------------------------------------------------
     302# USAGE: bump <delta>
     303#
     304# Changes the current value up/down by the <delta> value.  Used
     305# internally by the up/down spinner buttons when the value is
     306# -type integer.
     307# ----------------------------------------------------------------------
     308itcl::body Rappture::Gauge::bump {delta} {
     309    set val $_value
     310    if {$val == ""} {
     311        set val 0
     312    }
     313    value [expr {$val+$delta}]
     314}
     315
     316# ----------------------------------------------------------------------
    251317# USAGE: _redraw
    252318#
    … …  
    287353# ----------------------------------------------------------------------
    288354itcl::body Rappture::Gauge::_resize {} {
    289     if {$itk_option(-width) > 0} {
    290         set w $itk_option(-width)
    291     } else {
    292         if {$itk_option(-image) != ""} {
    293             set w [expr {[image width $itk_option(-image)]+4}]
     355    set w 0
     356    set h 0
     357
     358    if {"" != $itk_option(-image) || "" != $itk_option(-spectrum)} {
     359        if {$itk_option(-samplewidth) > 0} {
     360            set w $itk_option(-samplewidth)
    294361        } else {
    295             set w [winfo reqheight $itk_component(value)]
    296         }
    297     }
    298 
    299     if {$itk_option(-height) > 0} {
    300         set h $itk_option(-height)
    301     } else {
    302         if {$itk_option(-image) != ""} {
    303             set h [expr {[image height $itk_option(-image)]+4}]
     362            if {$itk_option(-image) != ""} {
     363                set w [expr {[image width $itk_option(-image)]+4}]
     364            } else {
     365                set w [winfo reqheight $itk_component(value)]
     366            }
     367        }
     368
     369        if {$itk_option(-sampleheight) > 0} {
     370            set h $itk_option(-sampleheight)
    304371        } else {
    305             set h [winfo reqheight $itk_component(value)]
    306         }
    307     }
    308 
    309     $itk_component(icon) configure -width $w -height $h
     372            if {$itk_option(-image) != ""} {
     373                set h [expr {[image height $itk_option(-image)]+4}]
     374            } else {
     375                set h [winfo reqheight $itk_component(value)]
     376            }
     377        }
     378    }
     379
     380    if {$w > 0 && $h > 0} {
     381        $itk_component(icon) configure -width $w -height $h
     382    }
    310383}
    311384
    … …  
    420493
    421494# ----------------------------------------------------------------------
     495# USAGE: _layout
     496#
     497# Used internally to fix the layout of widgets whenever there is a
     498# change in the options that affect layout.  Puts the value in the
     499# proper position according to the -valueposition option.  Also,
     500# adds or removes the icon if it needs to be shown.
     501# ----------------------------------------------------------------------
     502itcl::body Rappture::Gauge::_layout {} {
     503    foreach w [pack slaves $itk_component(hull)] {
     504        pack forget $w
     505    }
     506
     507    array set side2anchor {
     508        left   e
     509        right  w
     510        top    s
     511        bottom n
     512    }
     513    set pos $itk_option(-valueposition)
     514    pack $itk_component(vframe) -side $pos \
     515        -expand yes -fill both -ipadx 2
     516    $itk_component(value) configure -anchor $side2anchor($pos)
     517
     518    if {"" != $itk_option(-image) || "" != $itk_option(-spectrum)} {
     519        pack $itk_component(icon) -side $pos
     520    }
     521}
     522
     523# ----------------------------------------------------------------------
    422524# CONFIGURATION OPTION: -editable
    423525# ----------------------------------------------------------------------
    … …  
    440542        error "bad option \"$itk_option(-spectrum)\": should be Rappture::Spectrum object"
    441543    }
     544    _layout
    442545    _redraw
    443546}
    … …  
    452555    }
    453556    _resize
     557    _layout
    454558    $itk_component(icon) itemconfigure bimage -image $itk_option(-image)
    455559}
    … …  
    469573# ----------------------------------------------------------------------
    470574itcl::configbody Rappture::Gauge::valueposition {
    471     array set side2anchor {
    472         left   e
    473         right  w
    474         top    s
    475         bottom n
    476     }
    477575    set pos $itk_option(-valueposition)
    478     if {![info exists side2anchor($pos)]} {
    479         error "bad value \"$pos\": should be [join [lsort [array names side2anchor]] {, }]"
    480     }
    481     pack $itk_component(vframe) -before $itk_component(icon) \
    482         -side $pos -expand yes -fill both -ipadx 2
    483     $itk_component(value) configure -anchor $side2anchor($pos)
     576    set opts {left right top bottom}
     577    if {[lsearch -exact $opts $pos] < 0} {
     578        error "bad value \"$pos\": should be [join $opts {, }]"
     579    }
     580    _layout
    484581}
    485582
    … …  
    496593            set s "right"
    497594        }
    498         pack $itk_component(presets) -before $itk_component(value) \
    499             -side $s -fill y
     595        set first [lindex [pack slaves $itk_component(vframe)] 0]
     596        pack $itk_component(presets) -before $first -side $s -fill y
    500597
    501598        $itk_component(presetlist) delete 0 end
    … …  
    503600    }
    504601}
     602
     603# ----------------------------------------------------------------------
     604# CONFIGURATION OPTION: -type
     605# ----------------------------------------------------------------------
     606itcl::configbody Rappture::Gauge::type {
     607    switch -- $itk_option(-type) {
     608        integer {
     609            set first [lindex [pack slaves $itk_component(vframe)] 0]
     610            if {$first == $itk_component(presets)} {
     611                pack $itk_component(spinner) -after $first -side left -fill y
     612            } else {
     613                pack $itk_component(spinner) -before $first -side right -fill y
     614            }
     615        }
     616        real {
     617            pack forget $itk_component(spinner)
     618        }
     619        default {
     620            error "bad number type \"$itk_option(-type)\": should be integer or real"
     621        }
     622    }
     623}

  • trunk/gui/scripts/groupentry.tcl

    r11 r22  
    1515    inherit itk::Widget
    1616
    17     constructor {xmlobj path args} { # defined below }
     17    constructor {owner path args} { # defined below }
    1818
    1919    public method value {args}
    … …  
    2222    public method tooltip {}
    2323
    24     private variable _xmlobj ""   ;# XML containing description
     24    private variable _owner ""    ;# thing managing this control
    2525    private variable _path ""     ;# path in XML to this number
    2626}
    … …  
    3636# CONSTRUCTOR
    3737# ----------------------------------------------------------------------
    38 itcl::body Rappture::GroupEntry::constructor {xmlobj path args} {
    39     if {![Rappture::library isvalid $xmlobj]} {
    40         error "bad value \"$xmlobj\": should be Rappture::library"
     38itcl::body Rappture::GroupEntry::constructor {owner path args} {
     39    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
     40        error "bad object \"$owner\": should be Rappture::ControlOwner"
    4141    }
    42     set _xmlobj $xmlobj
     42    set _owner $owner
    4343    set _path $path
    4444
    … …  
    6767# ----------------------------------------------------------------------
    6868itcl::body Rappture::GroupEntry::label {} {
    69     return [$_xmlobj get $_path.about.label]
     69    return [$_owner xml get $_path.about.label]
    7070}
    7171
    … …  
    7979# ----------------------------------------------------------------------
    8080itcl::body Rappture::GroupEntry::tooltip {} {
    81     return [$_xmlobj get $_path.about.description]
     81    return [$_owner xml get $_path.about.description]
    8282}

  • trunk/gui/scripts/loader.tcl

    r17 r22  
    1919    itk_option define -tool tool Tool ""
    2020
    21     constructor {xmlobj path args} { # defined below }
     21    constructor {owner path args} { # defined below }
    2222
    2323    public method value {args}
    … …  
    2929    protected method _tooltip {}
    3030
    31     private variable _xmlobj ""   ;# XML containing description
     31    private variable _owner ""    ;# thing managing this control
    3232    private variable _path ""     ;# path in XML to this loader
    3333}
    … …  
    4343# CONSTRUCTOR
    4444# ----------------------------------------------------------------------
    45 itcl::body Rappture::Loader::constructor {xmlobj path args} {
    46     if {![Rappture::library isvalid $xmlobj]} {
    47         error "bad value \"$xmlobj\": should be Rappture::library"
    48     }
    49     set _xmlobj $xmlobj
     45itcl::body Rappture::Loader::constructor {owner path args} {
     46    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
     47        error "bad object \"$owner\": should be Rappture::ControlOwner"
     48    }
     49    set _owner $owner
    5050    set _path $path
    5151
    … …  
    6565    # the combobox.
    6666    #
    67     set defval [$xmlobj get $path.default]
     67    set defval [$_owner xml get $path.default]
    6868
    6969    set flist ""
    70     foreach comp [$xmlobj children -type example $path] {
    71         lappend flist [$xmlobj get $path.$comp]
     70    foreach comp [$_owner xml children -type example $path] {
     71        lappend flist [$_owner xml get $path.$comp]
    7272    }
    7373
    … …  
    103103
    104104                        if {[string equal $defval [file tail $fname]]} {
    105                             $xmlobj put $path.default $label
     105                            $_owner xml put $path.default $label
    106106                        }
    107107                    }
    … …  
    116116    # Assign the default value to this widget, if there is one.
    117117    #
    118     set str [$xmlobj get $path.default]
     118    set str [$_owner xml get $path.default]
    119119    if {$str != ""} { after 500 [itcl::code $this value $str] }
    120120}
    … …  
    163163# ----------------------------------------------------------------------
    164164itcl::body Rappture::Loader::label {} {
    165     set label [$_xmlobj get $_path.about.label]
     165    set label [$_owner xml get $_path.about.label]
    166166    if {"" == $label} {
    167167        set label "Example"
    … …  
    208208# ----------------------------------------------------------------------
    209209itcl::body Rappture::Loader::_tooltip {} {
    210     set str [string trim [$_xmlobj get $_path.about.description]]
     210    set str [string trim [$_owner xml get $_path.about.description]]
    211211
    212212    # get the description for the current choice, if there is one

  • trunk/gui/scripts/moleculeViewer.tcl

    r11 r22  
    1313package require vtk
    1414package require vtkinteraction
     15package require BLT
    1516
    1617option add *MoleculeViewer.width 4i widgetDefault
    … …  
    1819option add *MoleculeViewer.backdrop black widgetDefault
    1920
     21blt::bitmap define MoleculeViewer-reset {
     22#define reset_width 12
     23#define reset_height 12
     24static unsigned char reset_bits[] = {
     25   0x00, 0x00, 0x00, 0x00, 0xfc, 0x03, 0x04, 0x02, 0x04, 0x02, 0x04, 0x02,
     26   0x04, 0x02, 0x04, 0x02, 0x04, 0x02, 0xfc, 0x03, 0x00, 0x00, 0x00, 0x00};
     27}
     28
     29blt::bitmap define MoleculeViewer-zoomin {
     30#define zoomin_width 12
     31#define zoomin_height 12
     32static unsigned char zoomin_bits[] = {
     33   0x7c, 0x00, 0x82, 0x00, 0x11, 0x01, 0x11, 0x01, 0x7d, 0x01, 0x11, 0x01,
     34   0x11, 0x01, 0x82, 0x03, 0xfc, 0x07, 0x80, 0x0f, 0x00, 0x0f, 0x00, 0x06};
     35}
     36
     37blt::bitmap define MoleculeViewer-zoomout {
     38#define zoomout_width 12
     39#define zoomout_height 12
     40static unsigned char zoomout_bits[] = {
     41   0x7c, 0x00, 0x82, 0x00, 0x01, 0x01, 0x01, 0x01, 0x7d, 0x01, 0x01, 0x01,
     42   0x01, 0x01, 0x82, 0x03, 0xfc, 0x07, 0x80, 0x0f, 0x00, 0x0f, 0x00, 0x06};
     43}
     44
     45blt::bitmap define MoleculeViewer-atoms {
     46#define atoms_width 12
     47#define atoms_height 12
     48static unsigned char atoms_bits[] = {
     49   0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x48, 0x02, 0x4c, 0x02, 0xc8, 0x03,
     50   0x48, 0x02, 0x48, 0x02, 0x5c, 0x02, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
     51}
     52
    2053itcl::class Rappture::MoleculeViewer {
    2154    inherit itk::Widget
    … …  
    2861
    2962    protected method _render {}
     63    protected method _zoom {option}
     64    protected method _move {option x y}
     65    protected method _3dView {theta phi}
     66    protected method _fixLabels {{option position}}
    3067    protected method _color2rgb {color}
    3168
    3269    private variable _tool ""    ;# tool containing this viewer
    3370    private variable _actors ""  ;# list of actors in renderer
     71    private variable _label2atom ;# maps 2D text actor => underlying atom
     72    private variable _view       ;# view params for 3D view
     73    private variable _limits     ;# limits of x/y/z axes
     74    private variable _click      ;# info used for _move operations
    3475}
    3576                                                                               
    … …  
    61102    $this-map SetInput [$this-sphere GetOutput]
    62103
     104    vtkCoordinate $this-xyzconv
     105    $this-xyzconv SetCoordinateSystemToWorld
     106
     107    set _view(theta) 0
     108    set _view(phi) 0
     109
     110    itk_component add controls {
     111        frame $itk_interior.cntls
     112    } {
     113        usual
     114        rename -background -controlbackground controlBackground Background
     115    }
     116    pack $itk_component(controls) -side right -fill y
     117
     118    itk_component add reset {
     119        button $itk_component(controls).reset \
     120            -borderwidth 1 -padx 1 -pady 1 \
     121            -bitmap MoleculeViewer-reset \
     122            -command [itcl::code $this _zoom reset]
     123    } {
     124        usual
     125        ignore -borderwidth
     126        rename -highlightbackground -controlbackground controlBackground Background
     127    }
     128    pack $itk_component(reset) -padx 4 -pady 4
     129    Rappture::Tooltip::for $itk_component(reset) "Reset the view to the default zoom level"
     130
     131    itk_component add zoomin {
     132        button $itk_component(controls).zin \
     133            -borderwidth 1 -padx 1 -pady 1 \
     134            -bitmap MoleculeViewer-zoomin \
     135            -command [itcl::code $this _zoom in]
     136    } {
     137        usual
     138        ignore -borderwidth
     139        rename -highlightbackground -controlbackground controlBackground Background
     140    }
     141    pack $itk_component(zoomin) -padx 4 -pady 4
     142    Rappture::Tooltip::for $itk_component(zoomin) "Zoom in"
     143
     144    itk_component add zoomout {
     145        button $itk_component(controls).zout \
     146            -borderwidth 1 -padx 1 -pady 1 \
     147            -bitmap MoleculeViewer-zoomout \
     148            -command [itcl::code $this _zoom out]
     149    } {
     150        usual
     151        ignore -borderwidth
     152        rename -highlightbackground -controlbackground controlBackground Background
     153    }
     154    pack $itk_component(zoomout) -padx 4 -pady 4
     155    Rappture::Tooltip::for $itk_component(zoomout) "Zoom out"
     156
     157    itk_component add labels {
     158        label $itk_component(controls).labels \
     159            -borderwidth 1 -padx 1 -pady 1 \
     160            -bitmap MoleculeViewer-atoms
     161    } {
     162        usual
     163        ignore -borderwidth
     164        rename -highlightbackground -controlbackground controlBackground Background
     165    }
     166    pack $itk_component(labels) -padx 4 -pady 8 -ipadx 1 -ipady 1
     167    Rappture::Tooltip::for $itk_component(labels) "Show/hide the labels on atoms"
     168    bind $itk_component(labels) <ButtonPress> \
     169        [itcl::code $this _fixLabels toggle]
     170
     171    #
     172    # RENDERING AREA
     173    #
     174    itk_component add area {
     175        frame $itk_interior.area
     176    }
     177    pack $itk_component(area) -expand yes -fill both
     178    bind $itk_component(area) <Configure> \
     179        [itcl::code $this _fixLabels]
     180
    63181    itk_component add renderer {
    64         vtkTkRenderWidget $itk_interior.ren -rw $this-renWin
     182        vtkTkRenderWidget $itk_component(area).ren -rw $this-renWin
    65183    } {
    66184    }
    … …  
    68186
    69187    eval itk_initialize $args
     188
     189    # prevent interactions -- use our own
     190    blt::busy hold $itk_component(area) -cursor left_ptr
     191    bind $itk_component(area)_Busy <ButtonPress> \
     192        [itcl::code $this _move click %x %y]
     193    bind $itk_component(area)_Busy <B1-Motion> \
     194        [itcl::code $this _move drag %x %y]
     195    bind $itk_component(area)_Busy <ButtonRelease> \
     196        [itcl::code $this _move release %x %y]
     197
     198    _fixLabels on
    70199}
    71200
    … …  
    79208    rename $this-sphere ""
    80209    rename $this-map ""
     210    rename $this-xyzconv ""
    81211}
    82212
    … …  
    93223    }
    94224    set _actors ""
     225    catch {unset _label2atom}
     226
     227    foreach lim {xmin xmax ymin ymax zmin zmax} {
     228        set _limits($lim) ""
     229    }
    95230
    96231    if {$itk_option(-device) != ""} {
    … …  
    104239            regsub {,} $xyz {} xyz
    105240
    106             set aname "::actor[incr counter]"
     241            # update overall limits for molecules along all axes
     242            foreach axis {x y z} val $xyz {
     243                if {"" == $_limits(${axis}min)} {
     244                    set _limits(${axis}min) $val
     245                    set _limits(${axis}max) $val
     246                } else {
     247                    if {$val < $_limits(${axis}min)} {
     248                        set _limits(${axis}min) $val
     249                    }
     250                    if {$val > $_limits(${axis}max)} {
     251                        set _limits(${axis}max) $val
     252                    }
     253                }
     254            }
     255
     256            # create an actor for each atom
     257            set aname $this-actor[incr counter]
    107258            vtkActor $aname
    108259            $aname SetMapper $this-map
    … …  
    121272
    122273            lappend _actors $aname
    123         }
     274
     275            # create a label for each atom
     276            set lname $this-label$counter
     277            vtkTextActor $lname
     278            $lname SetInput "$counter $symbol"
     279            $lname ScaledTextOff
     280
     281            set tprop [$lname GetTextProperty]
     282            $tprop SetJustificationToCentered
     283            $tprop SetVerticalJustificationToCentered
     284            $tprop ShadowOn
     285            $tprop SetColor 1 1 1
     286
     287            set _label2atom($lname) $aname
     288            lappend _actors $lname
     289        }
     290        if {[$itk_component(labels) cget -relief] == "sunken"} {
     291            _fixLabels on
     292        }
     293        after cancel [list catch [itcl::code $this _zoom reset]]
     294        after 200 [list catch [itcl::code $this _zoom reset]]
    124295    }
    125296    $this-ren ResetCamera
     297    $this-renWin Render
     298}
     299
     300# ----------------------------------------------------------------------
     301# USAGE: _zoom in
     302# USAGE: _zoom out
     303# USAGE: _zoom reset
     304#
     305# Called automatically when the user clicks on one of the zoom
     306# controls for this widget.  Changes the zoom for the current view.
     307# ----------------------------------------------------------------------
     308itcl::body Rappture::MoleculeViewer::_zoom {option} {
     309    switch -- $option {
     310        in {
     311            [$this-ren GetActiveCamera] Zoom 1.25
     312            _fixLabels
     313            $this-renWin Render
     314        }
     315        out {
     316            [$this-ren GetActiveCamera] Zoom 0.8
     317            _fixLabels
     318            $this-renWin Render
     319        }
     320        reset {
     321            [$this-ren GetActiveCamera] SetViewAngle 30
     322            $this-ren ResetCamera
     323            [$this-ren GetActiveCamera] Zoom 1.25
     324            _3dView 45 45
     325            $this-renWin Render
     326
     327            after cancel [list catch [itcl::code $this _fixLabels]]
     328            after 2000 [list catch [itcl::code $this _fixLabels]]
     329        }
     330    }
     331}
     332
     333# ----------------------------------------------------------------------
     334# USAGE: _move click <x> <y>
     335# USAGE: _move drag <x> <y>
     336# USAGE: _move release <x> <y>
     337#
     338# Called automatically when the user clicks/drags/releases in the
     339# plot area.  Moves the plot according to the user's actions.
     340# ----------------------------------------------------------------------
     341itcl::body Rappture::MoleculeViewer::_move {option x y} {
     342    switch -- $option {
     343        click {
     344            blt::busy configure $itk_component(area) -cursor fleur
     345            set _click(x) $x
     346            set _click(y) $y
     347            set _click(theta) $_view(theta)
     348            set _click(phi) $_view(phi)
     349        }
     350        drag {
     351            if {[array size _click] == 0} {
     352                _move click $x $y
     353            } else {
     354                set w [winfo width $itk_component(renderer)]
     355                set h [winfo height $itk_component(renderer)]
     356                set dx [expr {double($x-$_click(x))/$w}]
     357                set dy [expr {double($y-$_click(y))/$h}]
     358
     359                #
     360                # Rotate the camera in 3D
     361                #
     362                set theta [expr {$_view(theta) - $dy*180}]
     363                if {$theta < 2} { set theta 2 }
     364                if {$theta > 178} { set theta 178 }
     365                set phi [expr {$_view(phi) - $dx*360}]
     366
     367                _3dView $theta $phi
     368                _fixLabels
     369                $this-renWin Render
     370
     371                set _click(x) $x
     372                set _click(y) $y
     373            }
     374        }
     375        release {
     376            _move drag $x $y
     377            blt::busy configure $itk_component(area) -cursor left_ptr
     378            catch {unset _click}
     379        }
     380        default {
     381            error "bad option \"$option\": should be click, drag, release"
     382        }
     383    }
     384}
     385
     386# ----------------------------------------------------------------------
     387# USAGE: _3dView <theta> <phi>
     388#
     389# Used internally to change the position of the camera for 3D data
     390# sets.  Sets the camera according to the angles <theta> (angle from
     391# the z-axis) and <phi> (angle from the x-axis in the x-y plane).
     392# Both angles are in degrees.
     393# ----------------------------------------------------------------------
     394itcl::body Rappture::MoleculeViewer::_3dView {theta phi} {
     395    set deg2rad 0.0174532927778
     396    set xn [expr {sin($theta*$deg2rad)*cos($phi*$deg2rad)}]
     397    set yn [expr {sin($theta*$deg2rad)*sin($phi*$deg2rad)}]
     398    set zn [expr {cos($theta*$deg2rad)}]
     399
     400    set xm [expr {0.5*($_limits(xmax)+$_limits(xmin))}]
     401    set ym [expr {0.5*($_limits(ymax)+$_limits(ymin))}]
     402    set zm [expr {0.5*($_limits(zmax)+$_limits(zmin))}]
     403
     404    set cam [$this-ren GetActiveCamera]
     405    set zoom [$cam GetViewAngle]
     406    $cam SetViewAngle 30
     407
     408    $cam SetFocalPoint $xm $ym $zm
     409    $cam SetPosition [expr {$xm-$xn}] [expr {$ym-$yn}] [expr {$zm+$zn}]
     410    $cam ComputeViewPlaneNormal
     411    $cam SetViewUp 0 0 1  ;# z-dir is up
     412    $cam OrthogonalizeViewUp
     413    $this-ren ResetCamera
     414    $cam SetViewAngle $zoom
     415
     416    # fix up the labels so they sit over the new atom positions
     417    _fixLabels
     418
     419    set _view(theta) $theta
     420    set _view(phi) $phi
     421}
     422
     423# ----------------------------------------------------------------------
     424# USAGE: _fixLabels on
     425# USAGE: _fixLabels off
     426# USAGE: _fixLabels toggle
     427# USAGE: _fixLabels position
     428#
     429# Used internally to turn labels associated with atoms on/off, and to
     430# update the positions of the labels so they sit on top of each atom.
     431# ----------------------------------------------------------------------
     432itcl::body Rappture::MoleculeViewer::_fixLabels {{option position}} {
     433    switch -- $option {
     434        on {
     435            set state 1
     436        }
     437        off {
     438            set state 0
     439        }
     440        toggle {
     441            if {[$itk_component(labels) cget -relief] == "sunken"} {
     442                set state 0
     443            } else {
     444                set state 1
     445            }
     446        }
     447        position {
     448            foreach lname [array names _label2atom] {
     449                set aname $_label2atom($lname)
     450                set xyz [$aname GetPosition]
     451                eval $this-xyzconv SetValue $xyz
     452                set xy [$this-xyzconv GetComputedViewportValue $this-ren]
     453                eval $lname SetDisplayPosition $xy
     454            }
     455            return
     456        }
     457        default {
     458            error "bad option \"$option\": should be on, off, toggle, position"
     459        }
     460    }
     461
     462    if {$state} {
     463        $itk_component(labels) configure -relief sunken
     464        foreach lname [array names _label2atom] {
     465            catch {$this-ren AddActor2D $lname}
     466        }
     467        _fixLabels position
     468    } else {
     469        $itk_component(labels) configure -relief raised
     470        foreach lname [array names _label2atom] {
     471            catch {$this-ren RemoveActor $lname}
     472        }
     473    }
    126474    $this-renWin Render
    127475}
    … …  
    159507    after idle [itcl::code $this _render]
    160508}
    161 
    162 #package require Rappture
    163 #Rappture::MoleculeViewer .e
    164 #pack .e -expand yes -fill both
    165 #
    166 #set dev [Rappture::library {<?xml version="1.0"?>
    167 #<structure>
    168 #<components>
    169 #<molecule id="Aspirin">
    170 #  <formula>???</formula>
    171 #  <info>Aspirin molecule</info>
    172 #  <atom id="1">
    173 #    <symbol>C</symbol>
    174 #    <xyz>-1.892  -0.992  -1.578</xyz>
    175 #  </atom>
    176 #  <atom id="2">
    177 #    <symbol>C</symbol>
    178 #    <xyz>-1.370  -2.149  -0.990</xyz>
    179 #  </atom>
    180 #  <atom id="3">
    181 #    <symbol>C</symbol>
    182 #    <xyz>-0.079  -2.146  -0.464</xyz>
    183 #  </atom>
    184 #  <atom id="4">
    185 #    <symbol>C</symbol>
    186 #    <xyz>0.708  -0.986  -0.521</xyz>
    187 #  </atom>
    188 #  <atom id="5">
    189 #    <symbol>C</symbol>
    190 #    <xyz>0.203   0.156  -1.196</xyz>
    191 #  </atom>
    192 #  <atom id="6">
    193 #    <symbol>C</symbol>
    194 #    <xyz>-1.108   0.161  -1.654</xyz>
    195 #  </atom>
    196 #  <atom id="7">
    197 #    <symbol>C</symbol>
    198 #    <xyz>2.085  -1.030   0.104</xyz>
    199 #  </atom>
    200 #  <atom id="8">
    201 #    <symbol>O</symbol>
    202 #    <xyz>2.533  -2.034   0.636</xyz>
    203 #  </atom>
    204 #  <atom id="9">
    205 #    <symbol>O</symbol>
    206 #    <xyz>2.879   0.025   0.112</xyz>
    207 #  </atom>
    208 #  <atom id="10">
    209 #    <symbol>O</symbol>
    210 #    <xyz>0.753   1.334  -1.084</xyz>
    211 #  </atom>
    212 #  <atom id="11">
    213 #    <symbol>C</symbol>
    214 #    <xyz>0.668   2.025   0.034</xyz>
    215 #  </atom>
    216 #  <atom id="12">
    217 #    <symbol>O</symbol>
    218 #    <xyz>1.300   3.063   0.152</xyz>
    219 #  </atom>
    220 #  <atom id="13">
    221 #    <symbol>C</symbol>
    222 #    <xyz>-0.243   1.577   1.144</xyz>
    223 #  </atom>
    224 #  <atom id="14">
    225 #    <symbol>H</symbol>
    226 #    <xyz>-2.879  -0.962  -1.985</xyz>
    227 #  </atom>
    228 #  <atom id="15">
    229 #    <symbol>H</symbol>
    230 #    <xyz>-1.988  -3.037  -0.955</xyz>
    231 #  </atom>
    232 #  <atom id="16">
    233 #    <symbol>H</symbol>
    234 #    <xyz>0.300  -3.063  -0.005</xyz>
    235 #  </atom>
    236 #  <atom id="17">
    237 #    <symbol>H</symbol>
    238 #    <xyz>-1.489   1.084  -2.059</xyz>
    239 #  </atom>
    240 #  <atom id="18">
    241 #    <symbol>H</symbol>
    242 #    <xyz>2.566   0.782  -0.326</xyz>
    243 #  </atom>
    244 #  <atom id="19">
    245 #    <symbol>H</symbol>
    246 #    <xyz>-0.761   0.636   0.933</xyz>
    247 #  </atom>
    248 #  <atom id="20">
    249 #    <symbol>H</symbol>
    250 #    <xyz>-1.009   2.349   1.290</xyz>
    251 #  </atom>
    252 #  <atom id="21">
    253 #    <symbol>H</symbol>
    254 #    <xyz>0.346   1.435   2.059</xyz>
    255 #  </atom>
    256 #</molecule>
    257 #</components>
    258 #</structure>}]
    259 # add connectivity at some point...
    260 #CONECT    1    2    6   14                   
    261 #CONECT    2    1    3   15                   
    262 #CONECT    3    2    4   16                   
    263 #CONECT    4    3    5    7                   
    264 #CONECT    5    4    6   10                   
    265 #CONECT    6    1    5   17                   
    266 #CONECT    7    4    8    9                   
    267 #CONECT    8    7                             
    268 #CONECT    9    7   18                       
    269 #CONECT   10    5   11                       
    270 #CONECT   11   10   12   13                   
    271 #CONECT   12   11                             
    272 #CONECT   13   11   19   20   21             
    273 #CONECT   14    1                             
    274 #CONECT   15    2                             
    275 #CONECT   16    3                             
    276 #CONECT   17    6                             
    277 #CONECT   18    9                             
    278 #CONECT   19   13                             
    279 #CONECT   20   13                             
    280 #CONECT   21   13               
    281 
    282 #.e configure -device $dev

  • trunk/gui/scripts/numberentry.tcl

    r11 r22  
    1414    inherit itk::Widget
    1515
    16     constructor {xmlobj path args} { # defined below }
     16    constructor {owner path args} { # defined below }
    1717
    1818    public method value {args}
    … …  
    2323    protected method _newValue {}
    2424
    25     private variable _xmlobj ""   ;# XML containing description
     25    private variable _owner ""    ;# thing managing this control
    2626    private variable _path ""     ;# path in XML to this number
    2727}
    … …  
    3737# CONSTRUCTOR
    3838# ----------------------------------------------------------------------
    39 itcl::body Rappture::NumberEntry::constructor {xmlobj path args} {
    40     if {![Rappture::library isvalid $xmlobj]} {
    41         error "bad value \"$xmlobj\": should be Rappture::library"
    42     }
    43     set _xmlobj $xmlobj
     39itcl::body Rappture::NumberEntry::constructor {owner path args} {
     40    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
     41        error "bad object \"$owner\": should be Rappture::ControlOwner"
     42    }
     43    set _owner $owner
    4444    set _path $path
    4545
    … …  
    4848    #
    4949    set presets ""
    50     foreach pre [$xmlobj children -type preset $path] {
     50    foreach pre [$_owner xml children -type preset $path] {
    5151        lappend presets \
    52             [$xmlobj get $path.$pre.value] \
    53             [$xmlobj get $path.$pre.label]
     52            [$_owner xml get $path.$pre.value] \
     53            [$_owner xml get $path.$pre.label]
    5454    }
    5555
    5656    set class Rappture::Gauge
    57     set units [$xmlobj get $path.units]
     57    set units [$_owner xml get $path.units]
    5858    if {$units != ""} {
    5959        set desc [Rappture::Units::description $units]
    … …  
    7373    bind $itk_component(gauge) <<Value>> [itcl::code $this _newValue]
    7474
    75     set min [$xmlobj get $path.min]
     75    set min [$_owner xml get $path.min]
    7676    if {"" != $min} { $itk_component(gauge) configure -minvalue $min }
    7777
    78     set max [$xmlobj get $path.max]
     78    set max [$_owner xml get $path.max]
    7979    if {"" != $max} { $itk_component(gauge) configure -maxvalue $max }
    8080
    8181    if {$class == "Rappture::Gauge" && "" != $min && "" != $max} {
    82         set color [$xmlobj get $path.color]
     82        set color [$_owner xml get $path.color]
    8383        if {$color == ""} {
    8484            set color blue
    … …  
    9494
    9595    # if the control has an icon, plug it in
    96     set str [$xmlobj get $path.about.icon]
     96    set str [$_owner xml get $path.about.icon]
    9797    if {$str != ""} {
    9898        $itk_component(gauge) configure -image [image create photo -data $str]
    … …  
    104104    # Assign the default value to this widget, if there is one.
    105105    #
    106     set str [$xmlobj get $path.default]
     106    set str [$_owner xml get $path.default]
    107107    if {"" != $str != ""} { $itk_component(gauge) value $str }
    108108}
    … …  
    151151# ----------------------------------------------------------------------
    152152itcl::body Rappture::NumberEntry::label {} {
    153     set label [$_xmlobj get $_path.about.label]
     153    set label [$_owner xml get $_path.about.label]
    154154    if {"" == $label} {
    155155        set label "Number"
    … …  
    167167# ----------------------------------------------------------------------
    168168itcl::body Rappture::NumberEntry::tooltip {} {
    169     set str [$_xmlobj get $_path.about.description]
    170 
    171     set units [$_xmlobj get $_path.units]
    172     set min [$_xmlobj get $_path.min]
    173     set max [$_xmlobj get $_path.max]
     169    set str [$_owner xml get $_path.about.description]
     170
     171    set units [$_owner xml get $_path.units]
     172    set min [$_owner xml get $_path.min]
     173    set max [$_owner xml get $_path.max]
    174174
    175175    if {$units != "" || $min != "" || $max != ""} {

  • trunk/gui/scripts/page.tcl

    r11 r22  
    1717    inherit itk::Widget
    1818
    19     constructor {tool path args} { # defined below }
     19    constructor {owner path args} { # defined below }
    2020
    2121    protected method _buildGroup {frame xmlobj path}
    22 
    23     private variable _tool ""        ;# tool controlling this page
     22    protected method _link {xmlobj path widget path2}
     23
     24    private variable _owner ""       ;# thing managing this page
    2425}
    2526                                                                               
    … …  
    3031# CONSTRUCTOR
    3132# ----------------------------------------------------------------------
    32 itcl::body Rappture::Page::constructor {tool path args} {
    33     if {[catch {$tool isa Rappture::Tool} valid] || !$valid} {
    34         error "object \"$tool\" is not a Rappture Tool"
    35     }
    36     set _tool $tool
    37     set xmlobj [$tool xml object]
     33itcl::body Rappture::Page::constructor {owner path args} {
     34    if {[catch {$owner isa Rappture::ControlOwner} valid] || !$valid} {
     35        error "object \"$owner\" is not a Rappture::ControlOwner"
     36    }
     37    set _owner $owner
     38    set xmlobj [$owner xml object]
    3839
    3940    set type [$xmlobj element -as type $path]
    … …  
    5657# ----------------------------------------------------------------------
    5758itcl::body Rappture::Page::_buildGroup {frame xmlobj path} {
     59    frame $frame.results
     60    pack $frame.results -side right -fill y
     61
    5862    set deveditor ""
    5963
    6064    #
    61     # Scan through all input elements in this group and look
    62     # for a <loader>.  Add those first, at the top of the group.
     65    # Scan through all remaining input elements.  If there is an
     66    # ambient group, then add its children to the device editor,
     67    # if there is one.
    6368    #
    6469    set num 0
    65     foreach cname [$xmlobj children $path] {
    66         if {[$xmlobj element -as type $path.$cname] == "loader"} {
     70    set clist [$xmlobj children $path]
     71    while {[llength $clist] > 0} {
     72        set cname [lindex $clist 0]
     73        set clist [lrange $clist 1 end]
     74
     75        set type [$xmlobj element -as type $path.$cname]
     76        if {$type == "about"} {
     77            continue
     78        }
     79
     80        if {$type == "loader"} {
     81            #
     82            # Add <loader>'s at the top of the page.
     83            #
    6784            if {![winfo exists $frame.loaders]} {
    6885                frame $frame.loaders
    … …  
    7491            }
    7592            set w "$frame.loaders.l[incr num]"
    76             Rappture::Controls $w $_tool
     93            Rappture::Controls $w $_owner
    7794            pack $w -fill x
    78             $w insert end $xmlobj $path.$cname
    79         }
    80     }
    81 
    82     #
    83     # Scan through all input elements and look for any top-level
    84     # <structure> elements.  Create these next.
    85     #
    86     set num 0
    87     foreach cname [$xmlobj children $path] {
    88         if {[$xmlobj element -as type $path.$cname] == "structure"} {
     95            $w insert end $path.$cname
     96        } elseif {$type == "structure"} {
     97            #
     98            # Add <structure>'s as the central element of the page.
     99            #
    89100            set w "$frame.device[incr num]"
    90             Rappture::DeviceEditor $w $_tool
     101            Rappture::DeviceEditor $w $_owner
    91102            pack $w -expand yes -fill both
    92             $_tool widgetfor $path.$cname $w
     103            $_owner widgetfor $path.$cname $w
     104            bind $w <<Value>> [list $_owner changed $path.$cname]
    93105
    94106            if {"" == $deveditor} {
    … …  
    101113                if {[string length $val] > 0} {
    102114                    $w value $val
     115                    $xmlobj put $path.$cname.current $val
    103116                } else {
    104117                    set obj [$xmlobj element -as object $path.$cname.default]
    105118                    $w value $obj
    106                 }
    107             }
    108         }
    109     }
    110 
    111     #
    112     # Scan through all remaining input elements.  If there is an
    113     # ambient group, then add its children to the device editor,
    114     # if there is one.
    115     #
    116     foreach cname [$xmlobj children $path] {
    117         if {[string match "about*" $cname]} {
    118             continue
    119         }
    120 
    121         if {[$_tool widgetfor $path.$cname] == ""} {
     119                    $xmlobj put $path.$cname.current $obj
     120                }
     121            }
     122
     123            # if there's a link, then set up a callback to load from it
     124            set link [$xmlobj get $path.$cname.link]
     125            if {"" != $link} {
     126                $_owner notify add $this $link \
     127                    [itcl::code $this _link $xmlobj $link $w $path.$cname]
     128            }
     129        } elseif {$type == "tool"} {
     130            set service [Rappture::Service ::#auto $_owner $path.$cname]
     131            #
     132            # Scan through all extra inputs associated with this subtool
     133            # and create corresponding inputs in the top-level tool.
     134            # Then, add the input names to the list being processed here,
     135            # so that we'll create the controls during subsequent passes
     136            # through the loop.
     137            #
     138            set extra ""
     139            foreach obj [$service input] {
     140                set cname [$obj element]
     141                $xmlobj copy $path.$cname from $obj ""
     142                lappend extra $cname
     143            }
     144
     145            #
     146            # If there's a control for this service, then add it
     147            # to the end of the extra controls added above.
     148            #
     149            foreach obj [$service control] {
     150                set cname [$obj element]
     151                $xmlobj copy $path.$cname from $obj ""
     152                $xmlobj put $path.$cname.service $service
     153                lappend extra $cname
     154            }
     155            if {[llength $extra] > 0} {
     156                set clist [eval linsert [list $clist] 0 $extra]
     157            }
     158
     159            #
     160            # Scan through all outputs associated with this subtool
     161            # and create any corresponding feedback widgets.
     162            #
     163            foreach obj [$service output] {
     164                set cname [$obj element]
     165                $xmlobj copy $cname from $obj ""
     166
     167                # pick a good size based on output type
     168                set w $frame.results.result[incr num]
     169                set type [$obj element -as type]
     170                switch -- $type {
     171                    number - integer - boolean - choice {
     172                        Rappture::ResultViewer $w -width 0 -height 0
     173                        pack $w -fill x -padx 4 -pady 4
     174                    }
     175                    default {
     176                        Rappture::ResultViewer $w -width 4i -height 4i
     177                        pack $w -expand yes -fill both -padx 4 -pady 4
     178                    }
     179                }
     180                $service output for $obj $w
     181            }
     182        } else {
    122183            # create a control panel, if necessary
    123184            if {![winfo exists $frame.cntls]} {
    124                 Rappture::Controls $frame.cntls $_tool
    125                 pack $frame.cntls -fill x
     185                Rappture::Controls $frame.cntls $_owner
     186                pack $frame.cntls -fill x -pady 4
    126187            }
    127188
    … …  
    132193                    set w [$deveditor component top]
    133194                } else {
    134                     set c [$frame.cntls insert end $xmlobj $path.$cname]
    135                     set w [$frame.cntls control $c]
     195                    if {[catch {$frame.cntls insert end $path.$cname} c]} {
     196                        error $c "$c\n    (while building control for $path.$cname)"
     197                    } else {
     198                        set w [$frame.cntls control $c]
     199                    }
    136200                }
    137201                _buildGroup $w $xmlobj $path.$cname
    138202            } else {
    139                 $frame.cntls insert end $xmlobj $path.$cname
     203                if {[catch {$frame.cntls insert end $path.$cname} c]} {
     204                    error $c "$c\n    (while building control for $path.$cname)"
     205                }
    140206            }
    141207        }
    142208    }
    143209}
     210
     211itcl::body Rappture::Page::_link {xmlobj path w path2} {
     212    if {"" != [$xmlobj element -as type $path.current]} {
     213        set val [$xmlobj get $path.current]
     214        if {[string length $val] > 0} {
     215            $w value $val
     216            $xmlobj put $path.current $val
     217        } else {
     218            set obj [$xmlobj element -as object $path.current]
     219            $w value $obj
     220            $xmlobj put $path.current $obj
     221        }
     222    }
     223    $_owner changed $path2
     224}

  • trunk/gui/scripts/pager.tcl

    r11 r22  
    8282
    8383    itk_component add next {
    84         button $itk_component(controls).next -width 6 -text "Next >" \
     84        button $itk_component(controls).next -text "Next >" \
    8585            -command [itcl::code $this current next>]
    8686    }
    … …  
    8888
    8989    itk_component add back {
    90         button $itk_component(controls).back -width 6 -text "< Back" \
     90        button $itk_component(controls).back -text "< Back" \
    9191            -command [itcl::code $this current <back]
    9292    }
    … …  
    169169    #    [itcl::code $_dispatcher event -idle !fixsize]
    170170
     171    # the number of pages affects the arrangment -- force an update
     172    configure -arrangement $itk_option(-arrangement)
     173
    171174    $_dispatcher event -idle !layout
    172175
    … …  
    204207    }
    205208    set _pages [lreplace $_pages $first $last]
     209
     210    # the number of pages affects the arrangment -- force an update
     211    configure -arrangement $itk_option(-arrangement)
    206212
    207213    $_dispatcher event -idle !layout

  • trunk/gui/scripts/resultviewer.tcl

    r16 r22  
    1313package require Itk
    1414
    15 option add *ResultViewer.width 4i widgetDefault
    16 option add *ResultViewer.height 4i widgetDefault
    17 
    1815itcl::class Rappture::ResultViewer {
    1916    inherit itk::Widget
    2017
     18    itk_option define -width width Width 4i
     19    itk_option define -height height Height 4i
    2120    itk_option define -colors colors Colors ""
    2221    itk_option define -clearcommand clearCommand ClearCommand ""
    … …  
    2827    public method add {index xmlobj path}
    2928    public method clear {{index ""}}
     29    public method value {xmlobj}
    3030
    3131    public method plot {option args}
    … …  
    5050# ----------------------------------------------------------------------
    5151itcl::body Rappture::ResultViewer::constructor {args} {
    52     option add hull.width hull.height
    53     pack propagate $itk_component(hull) no
    54 
    5552    # create a dispatcher for events
    5653    Rappture::dispatcher _dispatcher
    … …  
    8077# ----------------------------------------------------------------------
    8178itcl::body Rappture::ResultViewer::add {index xmlobj path} {
    82     if {$path != ""} {
    83         set dobj [_xml2data $xmlobj $path]
    84     } else {
    85         set dobj ""
    86     }
     79    set dobj [_xml2data $xmlobj $path]
    8780
    8881    #
    … …  
    124117        }
    125118        set _dataslots ""
     119    }
     120}
     121
     122# ----------------------------------------------------------------------
     123# USAGE: value <xmlobj>
     124#
     125# Convenience method for showing a single value.  Loads the value
     126# into the widget via add/clear, then immediately plots the value.
     127# This makes the widget consistent with other widgets, such as
     128# the DeviceEditor, etc.
     129# ----------------------------------------------------------------------
     130itcl::body Rappture::ResultViewer::value {xmlobj} {
     131    clear
     132    if {"" != $xmlobj} {
     133        add 0 $xmlobj ""
     134        plot add 0 ""
    126135    }
    127136}
    … …  
    245254                    }
    246255                }
     256                structure {
     257                    set mode "structure"
     258                    if {![info exists _mode2widget($mode)]} {
     259                        set w $itk_interior.struct
     260                        Rappture::DeviceResult $w
     261                        set _mode2widget($mode) $w
     262                    }
     263                }
     264                number - integer - boolean - choice {
     265                    set mode "value"
     266                    if {![info exists _mode2widget($mode)]} {
     267                        set w $itk_interior.value
     268                        Rappture::ValueResult $w
     269                        set _mode2widget($mode) $w
     270                    }
     271                }
    247272            }
    248273        }
    … …  
    317342            return [$xmlobj element -as object $path]
    318343        }
     344        structure {
     345            return [$xmlobj element -as object $path]
     346        }
     347        number - integer - boolean - choice {
     348            return [$xmlobj element -as object $path]
     349        }
    319350        time - status {
    320351            return ""
    … …  
    323354    error "don't know how to plot <$type> data"
    324355}
     356
     357# ----------------------------------------------------------------------
     358# CONFIGURATION OPTION: -width
     359# ----------------------------------------------------------------------
     360itcl::configbody Rappture::ResultViewer::width {
     361    set w [winfo pixels $itk_component(hull) $itk_option(-width)]
     362    set h [winfo pixels $itk_component(hull) $itk_option(-height)]
     363    if {$w == 0 || $h == 0} {
     364        pack propagate $itk_component(hull) yes
     365    } else {
     366        component hull configure -width $w -height $h
     367        pack propagate $itk_component(hull) no
     368    }
     369}
     370
     371# ----------------------------------------------------------------------
     372# CONFIGURATION OPTION: -height
     373# ----------------------------------------------------------------------
     374itcl::configbody Rappture::ResultViewer::height {
     375    set h [winfo pixels $itk_component(hull) $itk_option(-height)]
     376    set w [winfo pixels $itk_component(hull) $itk_option(-width)]
     377    if {$w == 0 || $h == 0} {
     378        pack propagate $itk_component(hull) yes
     379    } else {
     380        component hull configure -width $w -height $h
     381        pack propagate $itk_component(hull) no
     382    }
     383}

  • trunk/gui/scripts/tempgauge.tcl

    r11 r22  
    1111package require Itk
    1212
    13 option add *TemperatureGauge.width 30 widgetDefault
    14 option add *TemperatureGauge.height 0 widgetDefault
     13option add *TemperatureGauge.sampleWidth 30 widgetDefault
     14option add *TemperatureGauge.sampleHeight 20 widgetDefault
    1515option add *TemperatureGauge.textBackground #cccccc widgetDefault
    1616option add *TemperatureGauge.valuePosition "right" widgetDefault
    … …  
    115115# ----------------------------------------------------------------------
    116116itcl::body Rappture::TemperatureGauge::_resize {} {
    117     if {$itk_option(-width) > 0} {
    118         set w $itk_option(-width)
     117    if {$itk_option(-samplewidth) > 0} {
     118        set w $itk_option(-samplewidth)
    119119    } else {
    120120        set w [winfo reqheight $itk_component(value)]
    … …  
    124124    }
    125125
    126     if {$itk_option(-height) > 0} {
    127         set h $itk_option(-height)
     126    if {$itk_option(-sampleheight) > 0} {
     127        set h $itk_option(-sampleheight)
    128128    } else {
    129129        if {$itk_option(-image) != ""} {

  • trunk/gui/scripts/textentry.tcl

    r17 r22  
    2222    -*-helvetica-medium-r-normal-*-*-100-* widgetDefault
    2323
     24#
     25# Tk text widget doesn't honor Ctrl-V by default.  Get rid
     26# of the default binding so that Ctrl-V works for <<Paste>>
     27# as expected.
     28#
     29bind Text <Control-KeyPress-v> {}
     30
    2431itcl::class Rappture::TextEntry {
    2532    inherit itk::Widget
    … …  
    2936    itk_option define -height height Height 0
    3037
    31     constructor {xmlobj path args} { # defined below }
     38    constructor {owner path args} { # defined below }
    3239
    3340    public method value {args}
    … …  
    4047
    4148    private variable _dispatcher "" ;# dispatcher for !events
    42     private variable _xmlobj ""   ;# XML containing description
     49    private variable _owner ""    ;# thing managing this control
    4350    private variable _path ""     ;# path in XML to this number
    4451
    … …  
    5360# CONSTRUCTOR
    5461# ----------------------------------------------------------------------
    55 itcl::body Rappture::TextEntry::constructor {xmlobj path args} {
    56     if {![Rappture::library isvalid $xmlobj]} {
    57         error "bad value \"$xmlobj\": should be Rappture::library"
    58     }
    59     set _xmlobj $xmlobj
     62itcl::body Rappture::TextEntry::constructor {owner path args} {
     63    if {[catch {$owner isa Rappture::ControlOwner} valid] != 0 || !$valid} {
     64        error "bad object \"$owner\": should be Rappture::ControlOwner"
     65    }
     66    set _owner $owner
    6067    set _path $path
    6168
    … …  
    6471    $_dispatcher dispatch $this !layout "[itcl::code $this _layout]; list"
    6572
    66     set _size [$xmlobj get $path.size]
    67 
    68     set hints [$xmlobj get $path.about.hints]
     73    set _size [$_owner xml get $path.size]
     74
     75    set hints [$_owner xml get $path.about.hints]
    6976    if {[string length $hints] > 0} {
    7077        itk_component add hints {
    … …  
    8087    eval itk_initialize $args
    8188
    82     set str [$xmlobj get $path.default]
     89    set str [$_owner xml get $path.default]
    8390    if {"" != $str} { value $str }
    8491}
    … …  
    160167# ----------------------------------------------------------------------
    161168itcl::body Rappture::TextEntry::label {} {
    162     set label [$_xmlobj get $_path.about.label]
     169    set label [$_owner xml get $_path.about.label]
    163170    if {"" == $label} {
    164171        set label "String"
    … …  
    176183# ----------------------------------------------------------------------
    177184itcl::body Rappture::TextEntry::tooltip {} {
    178     set str [$_xmlobj get $_path.about.description]
     185    set str [$_owner xml get $_path.about.description]
    179186    return [string trim $str]
    180187}

  • trunk/gui/scripts/tool.tcl

    r17 r22  
    1616
    1717itcl::class Rappture::Tool {
    18     public variable analyzer ""
     18    inherit Rappture::ControlOwner
    1919
    20     constructor {xmlobj installdir args} { # defined below }
     20    constructor {xmlobj installdir args} {
     21        Rappture::ControlOwner::constructor ""
     22    } { # defined below }
    2123
    2224    public method installdir {} { return $_installdir }
    23     public method xml {args}
    2425
    25     public method load {xmlobj}
    2626    public method run {args}
    2727    public method abort {}
    2828
    29     public method widgetfor {path {widget ""}}
    30     public method changed {path}
    31     public method sync {}
    32     public method tool {}
    33 
    34     private variable _xmlobj ""      ;# XML overall <run> object
    3529    private variable _installdir ""  ;# installation directory for this tool
    36     private variable _path2widget    ;# maps path => widget on this page
    37 
    3830    private common job               ;# array var used for blt::bgexec jobs
    3931}
    … …  
    5446
    5547    eval configure $args
    56 }
    57 
    58 # ----------------------------------------------------------------------
    59 # USAGE: xml <subcommand> ?<arg> <arg> ...?
    60 # USAGE: xml object
    61 #
    62 # Used by clients to manipulate the underlying XML data for this
    63 # tool.  The <subcommand> can be any operation supported by a
    64 # Rappture::library object.  Clients can also request the XML object
    65 # directly by using the "object" subcommand.
    66 # ----------------------------------------------------------------------
    67 itcl::body Rappture::Tool::xml {args} {
    68     if {"object" == $args} {
    69         return $_xmlobj
    70     }
    71     return [eval $_xmlobj $args]
    7248}
    7349
    … …  
    152128    set job(control) "abort"
    153129}
    154 
    155 # ----------------------------------------------------------------------
    156 # USAGE: widgetfor <path> ?<widget>?
    157 #
    158 # Used by embedded widgets such as a Controls panel to register the
    159 # various controls associated with this page.  That way, this Tool
    160 # knows what widgets to look at when syncing itself to the underlying
    161 # XML data.
    162 # ----------------------------------------------------------------------
    163 itcl::body Rappture::Tool::widgetfor {path {widget ""}} {
    164     # if this is a query operation, then look for the path
    165     if {"" == $widget} {
    166         if {[info exists _path2widget($path)]} {
    167             return $_path2widget($path)
    168         }
    169         return ""
    170     }
    171 
    172     # otherwise, associate the path with the given widget
    173     if {[info exists _path2widget($path)]} {
    174         error "$path already associated with widget $_path2widget($path)"
    175     }
    176     set _path2widget($path) $widget
    177 }
    178 
    179 # ----------------------------------------------------------------------
    180 # USAGE: load <xmlobj>
    181 #
    182 # Loads the contents of a Rappture <xmlobj> into the controls
    183 # associated with this tool.
    184 # ----------------------------------------------------------------------
    185 itcl::body Rappture::Tool::load {newobj} {
    186     if {![Rappture::library isvalid $newobj]} {
    187         error "\"$newobj\" is not a Rappture::library"
    188     }
    189 
    190     foreach path [array names _path2widget] {
    191         if {"" != [$newobj element -as type $path.current]} {
    192             set val [$newobj get $path.current]
    193             if {[string length $val] > 0
    194                   || [llength [$newobj children $path.current]] == 0} {
    195                 $_path2widget($path) value $val
    196             } else {
    197                 set obj [$newobj element -as object $path.current]
    198                 $_path2widget($path) value $obj
    199             }
    200         }
    201     }
    202 }
    203 
    204 # ----------------------------------------------------------------------
    205 # USAGE: changed <path>
    206 #
    207 # Invoked automatically by the various widgets associated with this
    208 # tool whenever their value changes.  If this tool has a -analyzer,
    209 # then it is notified that input has changed, so it can reset itself
    210 # for a new analysis.
    211 # ----------------------------------------------------------------------
    212 itcl::body Rappture::Tool::changed {path} {
    213     if {"" != $analyzer} {
    214         $analyzer reset
    215     }
    216 }
    217 
    218 # ----------------------------------------------------------------------
    219 # USAGE: sync
    220 #
    221 # Used by descendents such as a Controls panel to register the
    222 # various controls associated with this page.  That way, this Tool
    223 # knows what widgets to look at when syncing itself to the underlying
    224 # XML data.
    225 # ----------------------------------------------------------------------
    226 itcl::body Rappture::Tool::sync {} {
    227     foreach path [array names _path2widget] {
    228         $_xmlobj put $path.current [$_path2widget($path) value]
    229     }
    230 }
    231 
    232 # ----------------------------------------------------------------------
    233 # USAGE: tool
    234 #
    235 # Clients use this to figure out which tool is associated with
    236 # this object.  Since this is a tool, it returns itself.
    237 # ----------------------------------------------------------------------
    238 itcl::body Rappture::Tool::tool {} {
    239     return $this
    240 }

  • trunk/lib/library.xml

    r9 r22  
    4949    <scale>1.0</scale>
    5050  </atom>
     51  <atom id="Au">
     52    <color>#cccc00</color>
     53    <scale>1.5</scale>
     54  </atom>
     55  <atom id="AU">
     56    <color>#cccc00</color>
     57    <scale>1.5</scale>
     58  </atom>
    5159</elements>
    5260<materials>

  • trunk/python/Rappture/library.py

    r11 r22  
    165165            # if there's a value, then add it to the node
    166166            if isinstance(value, library):
    167                 node.appendChild(value.node)
     167                node.appendChild(value.node.cloneNode(1))
    168168            elif isinstance(value, minidom.Node):
    169169                node.appendChild(value)

  • trunk/tcl/scripts/library.tcl

    r13 r22  
    127127                }
    128128                structure {
     129                    # add this to the return list with the right flavor
     130                    if {$params(-as) == "component"} {
     131                        lappend rlist $cpath
     132                    } else {
     133                        lappend rlist [$xmlobj element -as $params(-as) $cpath]
     134                    }
     135
    129136                    if {[$xmlobj element $cpath.current.parameters] != ""} {
    130137                        lappend queue $cpath.current.parameters
    … …  
    163170    public method get {{path ""}}
    164171    public method put {args}
     172    public method copy {path from args}
    165173    public method remove {{path ""}}
    166174    public method xml {}
    … …  
    169177    public proc value {libobj path}
    170178
     179    public proc path2list {path}
    171180    protected method find {path}
    172     protected method path2list {path}
    173181    protected method node2name {node}
    174182    protected method node2comp {node}
    … …  
    515523    }
    516524    return ""
     525}
     526
     527# ----------------------------------------------------------------------
     528# USAGE: copy <path> from ?<xmlobj>? <path>
     529#
     530# Clients use this to copy the value from one xmlobj/path to another.
     531# If the <xmlobj> is not specified, it is assumed to be the same as
     532# the current object.
     533# ----------------------------------------------------------------------
     534itcl::body Rappture::LibraryObj::copy {path from args} {
     535    if {[llength $args] == 1} {
     536        set xmlobj $this
     537        set fpath [lindex $args 0]
     538    } elseif {[llength $args] == 2} {
     539        set xmlobj [lindex $args 0]
     540        set fpath [lindex $args 1]
     541    } else {
     542        error "wrong # args: should be \"copy path from ?xmlobj? path\""
     543    }
     544    if {$from != "from"} {
     545        error "bad syntax: should be \"copy path from ?xmlobj? path\""
     546    }
     547
     548    if {[llength [$xmlobj children $fpath]] == 0} {
     549        set val [$xmlobj get $fpath]
     550        put $path $val
     551    } else {
     552        set obj [$xmlobj element -as object $fpath]
     553        put $path $obj
     554        itcl::delete object $obj
     555    }
    517556}
    518557
Note: See TracChangeset for help on using the changeset viewer.