Ignore:
Timestamp:
Mar 18, 2009 2:59:21 PM (15 years ago)
Author:
gah
Message:

preliminary HQ output from molvisviewer; unexpand tabs; all jpeg generation at 100%

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/deviceViewer1D.tcl

    r782 r1342  
    4040    public method controls {option args}
    4141    public method download {option args}
    42                                                                                
     42                                                                               
    4343    protected method _loadDevice {}
    4444    protected method _loadParameters {frame path}
    … …  
    6262    private variable _marker        ;# marker currently being edited
    6363}
    64                                                                                
     64                                                                               
    6565itk::usual DeviceViewer1D {
    6666}
    … …  
    7575
    7676    itk_component add tabs {
    77         blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
    78             -side bottom -tearoff 0 \
    79             -selectcommand [itcl::code $this _changeTabs]
     77        blt::tabset $itk_interior.tabs -borderwidth 0 -relief flat \
     78            -side bottom -tearoff 0 \
     79            -selectcommand [itcl::code $this _changeTabs]
    8080    } {
    81         keep -activebackground -activeforeground
    82         keep -background -cursor -font
    83         rename -highlightbackground -background background Background
    84         keep -highlightcolor -highlightthickness
    85         keep -tabbackground -tabforeground
    86         rename -selectbackground -background background Background
    87         rename -selectforeground -foreground foreground Foreground
     81        keep -activebackground -activeforeground
     82        keep -background -cursor -font
     83        rename -highlightbackground -background background Background
     84        keep -highlightcolor -highlightthickness
     85        keep -tabbackground -tabforeground
     86        rename -selectbackground -background background Background
     87        rename -selectforeground -foreground foreground Foreground
    8888    }
    8989    pack $itk_component(tabs) -expand yes -fill both
    9090
    9191    itk_component add -protected inner {
    92         frame $itk_component(tabs).inner
     92        frame $itk_component(tabs).inner
    9393    }
    9494
    9595    itk_component add top {
    96         frame $itk_component(inner).top
     96        frame $itk_component(inner).top
    9797    }
    9898    pack $itk_component(top) -fill x
    9999
    100100    itk_component add layout {
    101         Rappture::DeviceLayout1D $itk_component(inner).layout
     101        Rappture::DeviceLayout1D $itk_component(inner).layout
    102102    }
    103103    pack $itk_component(layout) -side top -fill x -pady 4
    104104
    105105    itk_component add graph {
    106         blt::graph $itk_component(inner).graph \
    107             -highlightthickness 0 -plotpadx 0 -plotpady 0
     106        blt::graph $itk_component(inner).graph \
     107            -highlightthickness 0 -plotpadx 0 -plotpady 0
    108108    } {
    109         keep -background -foreground -cursor -font
     109        keep -background -foreground -cursor -font
    110110    }
    111111    pack $itk_component(graph) -expand yes -fill both
    … …  
    113113
    114114    bind $itk_component(graph) <Configure> "
    115         [list after cancel [list catch [itcl::code $this _align]]]
    116         [list after 100 [list catch [itcl::code $this _align]]]
     115        [list after cancel [list catch [itcl::code $this _align]]]
     116        [list after 100 [list catch [itcl::code $this _align]]]
    117117    "
    118118
    119119    itk_component add geditor {
    120         Rappture::Editor $itk_component(graph).editor \
    121             -activatecommand [itcl::code $this _marker activate] \
    122             -validatecommand [itcl::code $this _marker validate] \
    123             -applycommand [itcl::code $this _marker apply]
     120        Rappture::Editor $itk_component(graph).editor \
     121            -activatecommand [itcl::code $this _marker activate] \
     122            -validatecommand [itcl::code $this _marker validate] \
     123            -applycommand [itcl::code $this _marker apply]
    124124    }
    125125
    126126    itk_component add devcntls {
    127         Rappture::Notebook $itk_component(inner).devcntls
     127        Rappture::Notebook $itk_component(inner).devcntls
    128128    }
    129129    pack $itk_component(devcntls) -side bottom -fill x
    … …  
    141141    set _device ""
    142142    foreach name [array names _tab2fields] {
    143         eval itcl::delete object $_tab2fields($name)
     143        eval itcl::delete object $_tab2fields($name)
    144144    }
    145145    after cancel [list catch [itcl::code $this _fixAxes]]
    … …  
    158158itcl::body Rappture::DeviceViewer1D::add {dataobj {settings ""}} {
    159159    array set params {
    160         -color auto
    161         -brightness 0
    162         -width 1
    163         -raise 0
    164         -linestyle solid
    165         -description ""
    166         -param ""
     160        -color auto
     161        -brightness 0
     162        -width 1
     163        -raise 0
     164        -linestyle solid
     165        -description ""
     166        -param ""
    167167    }
    168168    foreach {opt val} $settings {
    169         if {![info exists params($opt)]} {
    170             error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
    171         }
    172         set params($opt) $val
     169        if {![info exists params($opt)]} {
     170            error "bad settings \"$opt\": should be [join [lsort [array names params]] {, }]"
     171        }
     172        set params($opt) $val
    173173    }
    174174 
    … …  
    176176
    177177    if {$pos < 0} {
    178         if {![Rappture::library isvalid $dataobj]} {
    179             error "bad value \"$dataobj\": should be Rappture::library object"
    180         }
    181 
    182         lappend _dlist $dataobj
    183         set _dobj2raise($dataobj) $params(-raise)
    184 
    185         after cancel [list catch [itcl::code $this _loadDevice]]
    186         after idle [list catch [itcl::code $this _loadDevice]]
     178        if {![Rappture::library isvalid $dataobj]} {
     179            error "bad value \"$dataobj\": should be Rappture::library object"
     180        }
     181
     182        lappend _dlist $dataobj
     183        set _dobj2raise($dataobj) $params(-raise)
     184
     185        after cancel [list catch [itcl::code $this _loadDevice]]
     186        after idle [list catch [itcl::code $this _loadDevice]]
    187187    }
    188188}
    … …  
    198198    set dlist $_dlist
    199199    foreach obj $dlist {
    200         if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
    201             set i [lsearch -exact $dlist $obj]
    202             if {$i >= 0} {
    203                 set dlist [lreplace $dlist $i $i]
    204                 lappend dlist $obj
    205             }
    206         }
     200        if {[info exists _dobj2raise($obj)] && $_dobj2raise($obj)} {
     201            set i [lsearch -exact $dlist $obj]
     202            if {$i >= 0} {
     203                set dlist [lreplace $dlist $i $i]
     204                lappend dlist $obj
     205            }
     206        }
    207207    }
    208208    return $dlist
    … …  
    217217itcl::body Rappture::DeviceViewer1D::delete {args} {
    218218    if {[llength $args] == 0} {
    219         set args $_dlist
     219        set args $_dlist
    220220    }
    221221
    … …  
    223223    set changed 0
    224224    foreach dataobj $args {
    225         set pos [lsearch -exact $_dlist $dataobj]
    226         if {$pos >= 0} {
    227             set _dlist [lreplace $_dlist $pos $pos]
    228             catch {unset _dobj2raise($dataobj)}
    229             set changed 1
    230         }
     225        set pos [lsearch -exact $_dlist $dataobj]
     226        if {$pos >= 0} {
     227            set _dlist [lreplace $_dlist $pos $pos]
     228            catch {unset _dobj2raise($dataobj)}
     229            set changed 1
     230        }
    231231    }
    232232
    233233    # if anything changed, then rebuild the plot
    234234    if {$changed} {
    235         after cancel [list catch [itcl::code $this _loadDevice]]
    236         after idle [list catch [itcl::code $this _loadDevice]]
     235        after cancel [list catch [itcl::code $this _loadDevice]]
     236        after idle [list catch [itcl::code $this _loadDevice]]
    237237    }
    238238}
    … …  
    248248itcl::body Rappture::DeviceViewer1D::controls {option args} {
    249249    switch -- $option {
    250         insert {
    251             if {[llength $args] != 3} {
    252                 error "wrong # args: should be \"controls insert pos xmlobj path\""
    253             }
    254             set pos [lindex $args 0]
    255             set xmlobj [lindex $args 1]
    256             set path [lindex $args 2]
    257             if {[string match *structure.parameters* $path]} {
    258             } elseif {[string match structure.components* $path]} {
    259                 $itk_component(layout) controls insert $pos $xmlobj $path
    260             }
    261         }
    262         default {
    263             error "bad option \"$option\": should be insert"
    264         }
     250        insert {
     251            if {[llength $args] != 3} {
     252                error "wrong # args: should be \"controls insert pos xmlobj path\""
     253            }
     254            set pos [lindex $args 0]
     255            set xmlobj [lindex $args 1]
     256            set path [lindex $args 2]
     257            if {[string match *structure.parameters* $path]} {
     258            } elseif {[string match structure.components* $path]} {
     259                $itk_component(layout) controls insert $pos $xmlobj $path
     260            }
     261        }
     262        default {
     263            error "bad option \"$option\": should be insert"
     264        }
    265265    }
    266266}
    … …  
    279279itcl::body Rappture::DeviceViewer1D::download {option args} {
    280280    switch $option {
    281         coming {
    282             # nothing to do
    283         }
    284         controls {
    285             # no controls for this download yet
    286             return ""
    287         }
    288         now {
    289             return ""  ;# not implemented yet!
    290         }
    291         default {
    292             error "bad option \"$option\": should be coming, controls, now"
    293         }
     281        coming {
     282            # nothing to do
     283        }
     284        controls {
     285            # no controls for this download yet
     286            return ""
     287        }
     288        now {
     289            return ""  ;# not implemented yet!
     290        }
     291        default {
     292            error "bad option \"$option\": should be coming, controls, now"
     293        }
    294294    }
    295295}
    … …  
    308308    #
    309309    foreach name [array names _tab2fields] {
    310         eval itcl::delete object $_tab2fields($name)
     310        eval itcl::delete object $_tab2fields($name)
    311311    }
    312312    catch {unset _tab2fields}
    … …  
    314314
    315315    if {[winfo exists $itk_component(top).cntls]} {
    316         $itk_component(top).cntls delete 0 end
     316        $itk_component(top).cntls delete 0 end
    317317    }
    318318
    … …  
    322322    #
    323323    if {$_device != ""} {
    324         foreach nn [$_device children fields] {
    325             set name [$_device get fields.$nn.about.label]
    326             if {$name == ""} {
    327                 set name $nn
    328             }
    329 
    330             set fobj [Rappture::Field ::#auto $_device fields.$nn]
    331             lappend _tab2fields($name) $fobj
    332         }
     324        foreach nn [$_device children fields] {
     325            set name [$_device get fields.$nn.about.label]
     326            if {$name == ""} {
     327                set name $nn
     328            }
     329
     330            set fobj [Rappture::Field ::#auto $_device fields.$nn]
     331            lappend _tab2fields($name) $fobj
     332        }
    333333    }
    334334    set tabs [lsort [array names _tab2fields]]
    335335
    336336    if {[$itk_component(tabs) size] > 0} {
    337         $itk_component(tabs) delete 0 end
     337        $itk_component(tabs) delete 0 end
    338338    }
    339339
    340340    if {[llength $tabs] <= 0} {
    341         #
    342         # No fields?  Then we don't need to bother with tabs.
    343         # Just pack the inner frame directly.  If there are no
    344         # fields, get rid of the graph.
    345         #
    346         pack $itk_component(inner) -expand yes -fill both
    347         if {[llength $tabs] > 0} {
    348             pack $itk_component(graph) -expand yes -fill both
    349         } else {
    350             pack forget $itk_component(graph)
    351             $itk_component(layout) configure -leftmargin 0 -rightmargin 0
    352         }
     341        #
     342        # No fields?  Then we don't need to bother with tabs.
     343        # Just pack the inner frame directly.  If there are no
     344        # fields, get rid of the graph.
     345        #
     346        pack $itk_component(inner) -expand yes -fill both
     347        if {[llength $tabs] > 0} {
     348            pack $itk_component(graph) -expand yes -fill both
     349        } else {
     350            pack forget $itk_component(graph)
     351            $itk_component(layout) configure -leftmargin 0 -rightmargin 0
     352        }
    353353    } else {
    354         #
    355         # Two or more fields?  Then create a tab for each field
    356         # and select the first one by default.  Make sure the
    357         # graph is packed.
    358         #
    359         pack forget $itk_component(inner)
    360         pack $itk_component(graph) -expand yes -fill both
    361 
    362         foreach name $tabs {
    363             $itk_component(tabs) insert end $name \
    364                 -activebackground $itk_option(-background)
    365         }
    366         $itk_component(tabs) select 0
     354        #
     355        # Two or more fields?  Then create a tab for each field
     356        # and select the first one by default.  Make sure the
     357        # graph is packed.
     358        #
     359        pack forget $itk_component(inner)
     360        pack $itk_component(graph) -expand yes -fill both
     361
     362        foreach name $tabs {
     363            $itk_component(tabs) insert end $name \
     364                -activebackground $itk_option(-background)
     365        }
     366        $itk_component(tabs) select 0
    367367    }
    368368
    … …  
    375375    #
    376376    if {$_device != ""} {
    377         _loadParameters $itk_component(top) parameters
     377        _loadParameters $itk_component(top) parameters
    378378    }
    379379
    … …  
    388388    #
    389389    $itk_component(graph) configure \
    390         -rightmargin [$itk_component(layout) extents bar3D]
     390        -rightmargin [$itk_component(layout) extents bar3D]
    391391
    392392    after cancel [list catch [itcl::code $this _fixSize]]
    … …  
    404404itcl::body Rappture::DeviceViewer1D::_loadParameters {frame path} {
    405405    foreach cname [$_device children $path] {
    406         set handled 0
    407         set type [$_device element -as type $path.$cname]
    408         if {$type == "about"} {
    409             continue
    410         }
    411         if {$type == "number"} {
    412             set name [$_device element -as id $path.$cname]
    413 
    414             # look for a field that uses this parameter
    415             set found ""
    416             foreach fname [$_device children fields] {
    417                 foreach comp [$_device children fields.$fname] {
    418                     set v [$_device get fields.$fname.$comp.constant]
    419                     if {[string equal $v $name]} {
    420                         set found "fields.$fname.$comp"
    421                         break
    422                     }
    423                 }
    424                 if {"" != $found} break
    425             }
    426 
    427             if {"" != $found} {
    428                 set _field2parm($found) $name
    429                 set handled 1
    430             }
    431         }
    432 
    433         #
    434         # Any parameter that was not handled above should be handled
    435         # here, by adding it to a control panel above the device
    436         # layout area.
    437         #
    438         if {!$handled} {
    439             if {![winfo exists $frame.cntls]} {
    440                 Rappture::Controls $frame.cntls $_owner
    441                 pack $frame.cntls -expand yes -fill both
    442             }
    443             $frame.cntls insert end $path.$cname
    444 
    445             #
    446             # If this is a group, then we must add its children
    447             # recursively.
    448             #
    449             if {$type == "group"} {
    450                 set gr [$frame.cntls control -value end]
    451                 _loadParameters [$gr component inner] $path.$cname
    452             }
    453         }
     406        set handled 0
     407        set type [$_device element -as type $path.$cname]
     408        if {$type == "about"} {
     409            continue
     410        }
     411        if {$type == "number"} {
     412            set name [$_device element -as id $path.$cname]
     413
     414            # look for a field that uses this parameter
     415            set found ""
     416            foreach fname [$_device children fields] {
     417                foreach comp [$_device children fields.$fname] {
     418                    set v [$_device get fields.$fname.$comp.constant]
     419                    if {[string equal $v $name]} {
     420                        set found "fields.$fname.$comp"
     421                        break
     422                    }
     423                }
     424                if {"" != $found} break
     425            }
     426
     427            if {"" != $found} {
     428                set _field2parm($found) $name
     429                set handled 1
     430            }
     431        }
     432
     433        #
     434        # Any parameter that was not handled above should be handled
     435        # here, by adding it to a control panel above the device
     436        # layout area.
     437        #
     438        if {!$handled} {
     439            if {![winfo exists $frame.cntls]} {
     440                Rappture::Controls $frame.cntls $_owner
     441                pack $frame.cntls -expand yes -fill both
     442            }
     443            $frame.cntls insert end $path.$cname
     444
     445            #
     446            # If this is a group, then we must add its children
     447            # recursively.
     448            #
     449            if {$type == "group"} {
     450                set gr [$frame.cntls control -value end]
     451                _loadParameters [$gr component inner] $path.$cname
     452            }
     453        }
    454454    }
    455455}
    … …  
    470470    set i [$itk_component(tabs) index select]
    471471    if {$i != ""} {
    472         set name [$itk_component(tabs) get $i]
    473         $itk_component(tabs) tab configure $name \
    474             -window $itk_component(inner) -fill both
     472        set name [$itk_component(tabs) get $i]
     473        $itk_component(tabs) tab configure $name \
     474            -window $itk_component(inner) -fill both
    475475    } else {
    476         set name [lindex [array names _tab2fields] 0]
     476        set name [lindex [array names _tab2fields] 0]
    477477    }
    478478
    … …  
    485485    foreach {zmin zmax} [$itk_component(layout) limits] { break }
    486486    if {$zmin != "" && $zmin < $zmax} {
    487         $graph axis configure x -min $zmin -max $zmax
     487        $graph axis configure x -min $zmin -max $zmax
    488488    }
    489489
    490490    if {$_device != ""} {
    491         set units [$_device get units]
    492         if {$units != "arbitrary"} {
    493             $graph axis configure x -hide no -title "Position ($units)"
    494         } else {
    495             $graph axis configure x -hide yes
    496         }
     491        set units [$_device get units]
     492        if {$units != "arbitrary"} {
     493            $graph axis configure x -hide no -title "Position ($units)"
     494        } else {
     495            $graph axis configure x -hide yes
     496        }
    497497    } else {
    498         $graph axis configure x -hide no -title "Position"
     498        $graph axis configure x -hide no -title "Position"
    499499    }
    500500
    … …  
    504504    set flist ""
    505505    if {[info exists _tab2fields($name)]} {
    506         set flist $_tab2fields($name)
     506        set flist $_tab2fields($name)
    507507    }
    508508
    509509    set n 0
    510510    foreach fobj $flist {
    511         catch {unset hints}
    512         array set hints [$fobj hints]
    513 
    514         if {[info exists hints(units)]} {
    515             set _units $hints(units)
    516             $graph axis configure y -title "$name ($hints(units))"
    517         } else {
    518             set _units ""
    519             $graph axis configure y -title $name
    520         }
    521 
    522         if {[info exists hints(scale)]
    523               && [string match log* $hints(scale)]} {
    524             $graph axis configure y -logscale yes
    525         } else {
    526             $graph axis configure y -logscale no
    527         }
    528 
    529         foreach comp [$fobj components] {
    530             # can only handle 1D meshes here
    531             if {[$fobj components -dimensions $comp] != "1D"} {
    532                 continue
    533             }
    534 
    535             set elem "elem[incr n]"
    536             set xv [$fobj mesh $comp]
    537             set yv [$fobj values $comp]
    538 
    539             $graph element create $elem -x $xv -y $yv \
    540                 -color black -symbol "" -linewidth 2
    541 
    542             if {[info exists hints(color)]} {
    543                 $graph element configure $elem -color $hints(color)
    544             }
    545 
    546             foreach {path x y val} [$fobj controls get $comp] {
    547                 if {$path != ""} {
    548                     set id "control[incr n]"
    549                     $graph marker create text -coords [list $x $y] \
    550                         -text $val -anchor s -name $id -background ""
    551                     $graph marker bind $id <Enter> \
    552                         [itcl::code $this _marker enter $id]
    553                     $graph marker bind $id <Leave> \
    554                         [itcl::code $this _marker leave $id]
    555                     $graph marker bind $id <ButtonPress> \
    556                         [itcl::code $this _marker edit $id $fobj/$path]
    557                 }
    558             }
    559         }
     511        catch {unset hints}
     512        array set hints [$fobj hints]
     513
     514        if {[info exists hints(units)]} {
     515            set _units $hints(units)
     516            $graph axis configure y -title "$name ($hints(units))"
     517        } else {
     518            set _units ""
     519            $graph axis configure y -title $name
     520        }
     521
     522        if {[info exists hints(scale)]
     523              && [string match log* $hints(scale)]} {
     524            $graph axis configure y -logscale yes
     525        } else {
     526            $graph axis configure y -logscale no
     527        }
     528
     529        foreach comp [$fobj components] {
     530            # can only handle 1D meshes here
     531            if {[$fobj components -dimensions $comp] != "1D"} {
     532                continue
     533            }
     534
     535            set elem "elem[incr n]"
     536            set xv [$fobj mesh $comp]
     537            set yv [$fobj values $comp]
     538
     539            $graph element create $elem -x $xv -y $yv \
     540                -color black -symbol "" -linewidth 2
     541
     542            if {[info exists hints(color)]} {
     543                $graph element configure $elem -color $hints(color)
     544            }
     545
     546            foreach {path x y val} [$fobj controls get $comp] {
     547                if {$path != ""} {
     548                    set id "control[incr n]"
     549                    $graph marker create text -coords [list $x $y] \
     550                        -text $val -anchor s -name $id -background ""
     551                    $graph marker bind $id <Enter> \
     552                        [itcl::code $this _marker enter $id]
     553                    $graph marker bind $id <Leave> \
     554                        [itcl::code $this _marker leave $id]
     555                    $graph marker bind $id <ButtonPress> \
     556                        [itcl::code $this _marker edit $id $fobj/$path]
     557                }
     558            }
     559        }
    560560    }
    561561
    … …  
    590590    set graph $itk_component(graph)
    591591    if {![winfo ismapped $graph]} {
    592         after cancel [list catch [itcl::code $this _fixAxes]]
    593         after 100 [list catch [itcl::code $this _fixAxes]]
    594         return
     592        after cancel [list catch [itcl::code $this _fixAxes]]
     593        after 100 [list catch [itcl::code $this _fixAxes]]
     594        return
    595595    }
    596596
    … …  
    607607
    608608    if {$log} {
    609         set min [expr {0.9*$min}]
    610         set max [expr {1.1*$max}]
     609        set min [expr {0.9*$min}]
     610        set max [expr {1.1*$max}]
    611611    } else {
    612         if {$min > 0} {
    613             set min [expr {0.95*$min}]
    614         } else {
    615             set min [expr {1.05*$min}]
    616         }
    617         if {$max > 0} {
    618             set max [expr {1.05*$max}]
    619         } else {
    620             set max [expr {0.95*$max}]
    621         }
     612        if {$min > 0} {
     613            set min [expr {0.95*$min}]
     614        } else {
     615            set min [expr {1.05*$min}]
     616        }
     617        if {$max > 0} {
     618            set max [expr {1.05*$max}]
     619        } else {
     620            set max [expr {0.95*$max}]
     621        }
    622622    }
    623623
    … …  
    626626    set h [expr {[font metrics $fnt -linespace] + 5}]
    627627    foreach mname [$graph marker names] {
    628         set xy [$graph marker cget $mname -coord]
    629         foreach {x y} [eval $graph transform $xy] { break }
    630         set y [expr {$y-$h}]  ;# find top of text in pixels
    631         foreach {x y} [eval $graph invtransform [list 0 $y]] { break }
    632         if {$y > $max} { set max $y }
     628        set xy [$graph marker cget $mname -coord]
     629        foreach {x y} [eval $graph transform $xy] { break }
     630        set y [expr {$y-$h}]  ;# find top of text in pixels
     631        foreach {x y} [eval $graph invtransform [list 0 $y]] { break }
     632        if {$y > $max} { set max $y }
    633633    }
    634634
    635635    if {$log} {
    636         set min [expr {pow(10.0,floor(log10($min)))}]
    637         set max [expr {pow(10.0,ceil(log10($max)))}]
     636        set min [expr {pow(10.0,floor(log10($min)))}]
     637        set max [expr {pow(10.0,ceil(log10($max)))}]
    638638    } else {
    639         set min [expr {0.1*floor(10*$min)}]
    640         set max [expr {0.1*ceil(10*$max)}]
     639        set min [expr {0.1*floor(10*$min)}]
     640        set max [expr {0.1*ceil(10*$max)}]
    641641    }
    642642
    … …  
    685685itcl::body Rappture::DeviceViewer1D::_marker {option {name ""} {path ""}} {
    686686    switch -- $option {
    687         enter {
    688             $itk_component(graph) marker configure $name -background #e5e5e5
    689             #
    690             # BE CAREFUL:  Need an update here to force the graph to
    691             #   refresh itself or else a subsequent click on the
    692             #   marker will ignore the text that was recently changed,
    693             #   and fail to generate a <ButtonPress> event!
    694             #
    695             update idletasks
    696         }
    697         leave {
    698             $itk_component(graph) marker configure $name -background ""
    699             #
    700             # BE CAREFUL:  Need an update here to force the graph to
    701             #   refresh itself or else a subsequent click on the
    702             #   marker will ignore the text that was recently changed,
    703             #   and fail to generate a <ButtonPress> event!
    704             #
    705             update idletasks
    706         }
    707         edit {
    708             set _marker(name) $name
    709             set _marker(fobj) [lindex [split $path /] 0]
    710             set _marker(path) [lindex [split $path /] 1]
    711             $itk_component(geditor) activate
    712         }
    713         activate {
    714             set g $itk_component(graph)
    715             set val [$g marker cget $_marker(name) -text]
    716             foreach {x y} [$g marker cget $_marker(name) -coords] { break }
    717             foreach {x y} [$g transform $x $y] { break }
    718             set x [expr {$x + [winfo rootx $g] - 4}]
    719             set y [expr {$y + [winfo rooty $g] - 5}]
    720 
    721             set fnt $itk_option(-font)
    722             set h [expr {[font metrics $fnt -linespace] + 2}]
    723             set w [expr {[font measure $fnt $val] + 5}]
    724 
    725             return [list text $val \
    726                 x [expr {$x-$w/2}] \
    727                 y [expr {$y-$h}] \
    728                 w $w \
    729                 h $h]
    730         }
    731         validate {
    732             if {$_units != ""} {
    733                 if {[catch {Rappture::Units::convert $name \
    734                         -context $_units -to $_units} result] != 0} {
    735                     if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
    736                           || [regexp {(.)(.+)} $result match first tail]} {
    737                         set result "[string toupper $first]$tail"
    738                     }
    739                     bell
    740                     Rappture::Tooltip::cue $itk_component(geditor) $result
    741                     return 0
    742                 }
    743             }
    744             if {[catch {$_marker(fobj) controls validate $_marker(path) $name} result]} {
    745                 bell
    746                 Rappture::Tooltip::cue $itk_component(geditor) $result
    747                 return 0
    748             }
    749             return 1
    750         }
    751         apply {
    752             if {$_units != ""} {
    753                 catch {Rappture::Units::convert $name \
    754                     -context $_units -to $_units} value
    755             } else {
    756                 set value $name
    757             }
    758 
    759             $_marker(fobj) controls put $_marker(path) $value
    760             $_owner changed $_marker(path)
    761             event generate $itk_component(hull) <<Edit>>
    762 
    763             _changeTabs
    764         }
     687        enter {
     688            $itk_component(graph) marker configure $name -background #e5e5e5
     689            #
     690            # BE CAREFUL:  Need an update here to force the graph to
     691            #   refresh itself or else a subsequent click on the
     692            #   marker will ignore the text that was recently changed,
     693            #   and fail to generate a <ButtonPress> event!
     694            #
     695            update idletasks
     696        }
     697        leave {
     698            $itk_component(graph) marker configure $name -background ""
     699            #
     700            # BE CAREFUL:  Need an update here to force the graph to
     701            #   refresh itself or else a subsequent click on the
     702            #   marker will ignore the text that was recently changed,
     703            #   and fail to generate a <ButtonPress> event!
     704            #
     705            update idletasks
     706        }
     707        edit {
     708            set _marker(name) $name
     709            set _marker(fobj) [lindex [split $path /] 0]
     710            set _marker(path) [lindex [split $path /] 1]
     711            $itk_component(geditor) activate
     712        }
     713        activate {
     714            set g $itk_component(graph)
     715            set val [$g marker cget $_marker(name) -text]
     716            foreach {x y} [$g marker cget $_marker(name) -coords] { break }
     717            foreach {x y} [$g transform $x $y] { break }
     718            set x [expr {$x + [winfo rootx $g] - 4}]
     719            set y [expr {$y + [winfo rooty $g] - 5}]
     720
     721            set fnt $itk_option(-font)
     722            set h [expr {[font metrics $fnt -linespace] + 2}]
     723            set w [expr {[font measure $fnt $val] + 5}]
     724
     725            return [list text $val \
     726                x [expr {$x-$w/2}] \
     727                y [expr {$y-$h}] \
     728                w $w \
     729                h $h]
     730        }
     731        validate {
     732            if {$_units != ""} {
     733                if {[catch {Rappture::Units::convert $name \
     734                        -context $_units -to $_units} result] != 0} {
     735                    if {[regexp {^bad.*: +(.)(.+)} $result match first tail]
     736                          || [regexp {(.)(.+)} $result match first tail]} {
     737                        set result "[string toupper $first]$tail"
     738                    }
     739                    bell
     740                    Rappture::Tooltip::cue $itk_component(geditor) $result
     741                    return 0
     742                }
     743            }
     744            if {[catch {$_marker(fobj) controls validate $_marker(path) $name} result]} {
     745                bell
     746                Rappture::Tooltip::cue $itk_component(geditor) $result
     747                return 0
     748            }
     749            return 1
     750        }
     751        apply {
     752            if {$_units != ""} {
     753                catch {Rappture::Units::convert $name \
     754                    -context $_units -to $_units} value
     755            } else {
     756                set value $name
     757            }
     758
     759            $_marker(fobj) controls put $_marker(path) $value
     760            $_owner changed $_marker(path)
     761            event generate $itk_component(hull) <<Edit>>
     762
     763            _changeTabs
     764        }
    765765    }
    766766}
    … …  
    776776    set presets ""
    777777    foreach pre [$libObj children -type preset $path] {
    778         lappend presets \
    779             [$libObj get $path.$pre.value] \
    780             [$libObj get $path.$pre.label]
     778        lappend presets \
     779            [$libObj get $path.$pre.value] \
     780            [$libObj get $path.$pre.label]
    781781    }
    782782
    … …  
    784784    set units [$libObj get $path.units]
    785785    if {$units != ""} {
    786         set desc [Rappture::Units::description $units]
    787         if {[string match temperature* $desc]} {
    788             set type Rappture::TemperatureGauge
    789         }
     786        set desc [Rappture::Units::description $units]
     787        if {[string match temperature* $desc]} {
     788            set type Rappture::TemperatureGauge
     789        }
    790790    }
    791791
    … …  
    793793    set w "$container.gauge[incr counter]"
    794794    while {[winfo exists $w]} {
    795         set w "$container.gauge[incr counter]"
     795        set w "$container.gauge[incr counter]"
    796796    }
    797797
    … …  
    811811
    812812    if {$type == "Rappture::Gauge" && "" != $min && "" != $max} {
    813         set color [$libObj get $path.color]
    814         if {$color == ""} {
    815             set color blue
    816         }
    817         if {$units != ""} {
    818             set min [Rappture::Units::convert $min -to $units -units off]
    819             set max [Rappture::Units::convert $max -to $units -units off]
    820         }
    821         $w configure -spectrum [Rappture::Spectrum ::#auto [list \
    822             $min white $max $color] -units $units]
     813        set color [$libObj get $path.color]
     814        if {$color == ""} {
     815            set color blue
     816        }
     817        if {$units != ""} {
     818            set min [Rappture::Units::convert $min -to $units -units off]
     819            set max [Rappture::Units::convert $max -to $units -units off]
     820        }
     821        $w configure -spectrum [Rappture::Spectrum ::#auto [list \
     822            $min white $max $color] -units $units]
    823823    }
    824824
    825825    set str [$libObj get $path.label]
    826826    if {$str != ""} {
    827         set help [$libObj get $path.help]
    828         if {"" != $help} {
    829             append str "\n$help"
    830         }
    831         if {$units != ""} {
    832             set desc [Rappture::Units::description $units]
    833             append str "\n(units of $desc)"
    834         }
    835         Rappture::Tooltip::for $w $str
     827        set help [$libObj get $path.help]
     828        if {"" != $help} {
     829            append str "\n$help"
     830        }
     831        if {$units != ""} {
     832            set desc [Rappture::Units::description $units]
     833            append str "\n(units of $desc)"
     834        }
     835        Rappture::Tooltip::for $w $str
    836836    }
    837837
    838838    set str [$libObj get $path.icon]
    839839    if {$str != ""} {
    840         $w configure -image [image create photo -data $str]
     840        $w configure -image [image create photo -data $str]
    841841    }
    842842}
    … …  
    864864itcl::configbody Rappture::DeviceViewer1D::device {
    865865    if {$itk_option(-device) != ""} {
    866         if {![Rappture::library isvalid $itk_option(-device)]} {
    867             error "bad value \"$itk_option(-device)\": should be Rappture::Library"
    868         }
     866        if {![Rappture::library isvalid $itk_option(-device)]} {
     867            error "bad value \"$itk_option(-device)\": should be Rappture::Library"
     868        }
    869869    }
    870870
    871871    delete
    872872    if {"" != $itk_option(-device)} {
    873         add $itk_option(-device)
     873        add $itk_option(-device)
    874874    }
    875875    _loadDevice
Note: See TracChangeset for help on using the changeset viewer.