Ignore:
Timestamp:
Oct 22, 2010, 4:06:10 PM (14 years ago)
Author:
gah
Message:
 
File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/gui/scripts/spectrum.tcl

    r1342 r1929  
    4040    private variable _specw0 0      ;# wavelength for minimum
    4141}
    42                                                                                
     42                                                                               
    4343# ----------------------------------------------------------------------
    4444# CONSTRUCTOR
    … …  
    4848
    4949    if {[llength $sdata] > 0} {
    50         regsub -all {\n} $sdata { } sdata
    51         eval insert $sdata
     50        regsub -all {\n} $sdata { } sdata
     51        eval insert $sdata
    5252    }
    5353    eval configure $args
    … …  
    6868    # spectrum instead of gradient.
    6969    if {[llength $args] == 4} {
    70         set cnt 0
    71         foreach {value color} $args {
    72             if {[string match "*nm" $color]} {
    73                 incr cnt
    74             }
    75         }
    76         if {$cnt == 2} {
    77             set val0 [lindex $args 0]
    78             set color0 [string trimright [lindex $args 1] "nm"]
    79             set val1 [lindex $args 2]
    80             set color1 [string trimright [lindex $args 3] "nm"]
    81            
    82             if {"" != $units} {
    83                 set val0 [Rappture::Units::convert $val0 \
    84                               -context $units -to $units -units off]
    85                 set val1 [Rappture::Units::convert $val1 \
    86                               -context $units -to $units -units off]
    87             }
    88 
    89             set _spectrum [expr (double($color1) - double($color0)) \
    90                            / (double($val1) - double($val0))]
    91             set _specv0 $val0
    92             set _specw0 $color0
    93             return
    94         }
     70        set cnt 0
     71        foreach {value color} $args {
     72            if {[string match "*nm" $color]} {
     73                incr cnt
     74            }
     75        }
     76        if {$cnt == 2} {
     77            set val0 [lindex $args 0]
     78            set color0 [string trimright [lindex $args 1] "nm"]
     79            set val1 [lindex $args 2]
     80            set color1 [string trimright [lindex $args 3] "nm"]
     81           
     82            if {"" != $units} {
     83                set val0 [Rappture::Units::convert $val0 \
     84                              -context $units -to $units -units off]
     85                set val1 [Rappture::Units::convert $val1 \
     86                              -context $units -to $units -units off]
     87            }
     88
     89            set _spectrum [expr (double($color1) - double($color0)) \
     90                           / (double($val1) - double($val0))]
     91            set _specv0 $val0
     92            set _specw0 $color0
     93            return
     94        }
    9595    }
    9696
    9797    foreach {value color} $args {
    98         if {"" != $units} {
    99             set value [Rappture::Units::convert $value \
    100                 -context $units -to $units -units off]
    101         }
    102         foreach {r g b} [Rappture::color::RGB $color] { break }
    103         set i 0
    104         foreach v $_axis {
    105             if {$value == $v} {
    106                 set _rvals [lreplace $_rvals $i $i $r]
    107                 set _gvals [lreplace $_gvals $i $i $g]
    108                 set _bvals [lreplace $_bvals $i $i $b]
    109                 set changed 1
    110                 break
    111             } elseif {$value < $v} {
    112                 set _axis  [linsert $_axis $i $value]
    113                 set _rvals [linsert $_rvals $i $r]
    114                 set _gvals [linsert $_gvals $i $g]
    115                 set _bvals [linsert $_bvals $i $b]
    116                 set changed 1
    117                 break
    118             }
    119             incr i
    120         }
    121 
    122         if {$i >= [llength $_axis]} {
    123             lappend _axis $value
    124             lappend _rvals $r
    125             lappend _gvals $g
    126             lappend _bvals $b
    127             set changed 1
    128         }
     98        if {"" != $units} {
     99            set value [Rappture::Units::convert $value \
     100                -context $units -to $units -units off]
     101        }
     102        foreach {r g b} [Rappture::color::RGB $color] { break }
     103        set i 0
     104        foreach v $_axis {
     105            if {$value == $v} {
     106                set _rvals [lreplace $_rvals $i $i $r]
     107                set _gvals [lreplace $_gvals $i $i $g]
     108                set _bvals [lreplace $_bvals $i $i $b]
     109                set changed 1
     110                break
     111            } elseif {$value < $v} {
     112                set _axis  [linsert $_axis $i $value]
     113                set _rvals [linsert $_rvals $i $r]
     114                set _gvals [linsert $_gvals $i $g]
     115                set _bvals [linsert $_bvals $i $b]
     116                set changed 1
     117                break
     118            }
     119            incr i
     120        }
     121
     122        if {$i >= [llength $_axis]} {
     123            lappend _axis $value
     124            lappend _rvals $r
     125            lappend _gvals $g
     126            lappend _bvals $b
     127            set changed 1
     128        }
    129129    }
    130130
    131131    # let any clients know if something has changed
    132132    if {$changed} {
    133         event !change
     133        event !change
    134134    }
    135135}
    … …  
    146146itcl::body Rappture::Spectrum::delete {first {last ""}} {
    147147    if {$last == ""} {
    148         set last $first
     148        set last $first
    149149    }
    150150    if {![regexp {^[0-9]+|end$} $first]} {
    151         error "bad index \"$first\": should be integer or \"end\""
     151        error "bad index \"$first\": should be integer or \"end\""
    152152    }
    153153    if {![regexp {^[0-9]+|end$} $last]} {
    154         error "bad index \"$last\": should be integer or \"end\""
     154        error "bad index \"$last\": should be integer or \"end\""
    155155    }
    156156
    157157    if {[llength [lrange $_axis $first $last]] > 0} {
    158         set _axis [lreplace $_axis $first $last]
    159         set _rvals [lreplace $_rvals $first $last]
    160         set _gvals [lreplace $_gvals $first $last]
    161         set _bvals [lreplace $_bvals $first $last]
    162         event !change
     158        set _axis [lreplace $_axis $first $last]
     159        set _rvals [lreplace $_rvals $first $last]
     160        set _gvals [lreplace $_gvals $first $last]
     161        set _bvals [lreplace $_bvals $first $last]
     162        event !change
    163163    }
    164164}
    … …  
    176176itcl::body Rappture::Spectrum::get {args} {
    177177    if {[llength $args] == 0} {
    178         set rlist ""
    179         foreach v $_axis r $_rvals g $_gvals b $_bvals {
    180             lappend rlist "$v$units" [format {#%.4x%.4x%.4x} $r $g $b]
    181         }
    182         return $rlist
     178        set rlist ""
     179        foreach v $_axis r $_rvals g $_gvals b $_bvals {
     180            lappend rlist "$v$units" [format {#%.4x%.4x%.4x} $r $g $b]
     181        }
     182        return $rlist
    183183    }
    184184
    185185    set what "-color"
    186186    while {[llength $args] > 0} {
    187         set first [lindex $args 0]
    188         if {[regexp {^-[a-zA-Z]} $first]} {
    189             set what $first
    190             set args [lrange $args 1 end]
    191         } else {
    192             break
    193         }
     187        set first [lindex $args 0]
     188        if {[regexp {^-[a-zA-Z]} $first]} {
     189            set what $first
     190            set args [lrange $args 1 end]
     191        } else {
     192            break
     193        }
    194194    }
    195195    if {[llength $args] != 1} {
    196         error "wrong # args: should be \"get ?-color|-fraction? ?value?\""
     196        error "wrong # args: should be \"get ?-color|-fraction? ?value?\""
    197197    }
    198198
    199199    set value [lindex $args 0]
    200200    if {$units != ""} {
    201         set value [Rappture::Units::convert $value \
    202             -context $units -to $units -units off]
     201        set value [Rappture::Units::convert $value \
     202            -context $units -to $units -units off]
    203203    }
    204204
    205205    switch -- $what {
    206         -color {
    207             if {$_spectrum != 0} {
    208                 # continuous spectrum. just compute wavelength
    209                 set waveln [expr ($value - $_specv0) * $_spectrum + $_specw0]
    210                 return [Rappture::color::wave2RGB $waveln]
    211             }
    212             set i 0
    213             set ilast ""
    214             while {$i <= [llength $_axis]} {
    215                 set v [lindex $_axis $i]
    216 
    217                 if {$v == ""} {
    218                     set r [lindex $_rvals $ilast]
    219                     set g [lindex $_gvals $ilast]
    220                     set b [lindex $_bvals $ilast]
    221                     return [format {#%.4x%.4x%.4x} $r $g $b]
    222                 } elseif {$value < $v} {
    223                     if {$ilast == ""} {
    224                         set r [lindex $_rvals $i]
    225                         set g [lindex $_gvals $i]
    226                         set b [lindex $_bvals $i]
    227                     } else {
    228                         set vlast [lindex $_axis $ilast]
    229                         set frac [expr {($value-$vlast)/double($v-$vlast)}]
    230 
    231                         set rlast [lindex $_rvals $ilast]
    232                         set r [lindex $_rvals $i]
    233                         set r [expr {round($frac*($r-$rlast) + $rlast)}]
    234 
    235                         set glast [lindex $_gvals $ilast]
    236                         set g [lindex $_gvals $i]
    237                         set g [expr {round($frac*($g-$glast) + $glast)}]
    238 
    239                         set blast [lindex $_bvals $ilast]
    240                         set b [lindex $_bvals $i]
    241                         set b [expr {round($frac*($b-$blast) + $blast)}]
    242                     }
    243                     return [format {#%.4x%.4x%.4x} $r $g $b]
    244                 }
    245                 set ilast $i
    246                 incr i
    247             }
    248         }
    249         -fraction {
    250             set v0 [lindex $_axis 0]
    251             set vend [lindex $_axis end]
    252             return [expr {($value-$v0)/double($vend-$v0)}]
    253         }
    254         default {
    255             error "bad flag \"$what\": should be -color or -fraction"
    256         }
     206        -color {
     207            if {$_spectrum != 0} {
     208                # continuous spectrum. just compute wavelength
     209                set waveln [expr ($value - $_specv0) * $_spectrum + $_specw0]
     210                return [Rappture::color::wave2RGB $waveln]
     211            }
     212            set i 0
     213            set ilast ""
     214            while {$i <= [llength $_axis]} {
     215                set v [lindex $_axis $i]
     216
     217                if {$v == ""} {
     218                    set r [lindex $_rvals $ilast]
     219                    set g [lindex $_gvals $ilast]
     220                    set b [lindex $_bvals $ilast]
     221                    return [format {#%.4x%.4x%.4x} $r $g $b]
     222                } elseif {$value < $v} {
     223                    if {$ilast == ""} {
     224                        set r [lindex $_rvals $i]
     225                        set g [lindex $_gvals $i]
     226                        set b [lindex $_bvals $i]
     227                    } else {
     228                        set vlast [lindex $_axis $ilast]
     229                        set frac [expr {($value-$vlast)/double($v-$vlast)}]
     230
     231                        set rlast [lindex $_rvals $ilast]
     232                        set r [lindex $_rvals $i]
     233                        set r [expr {round($frac*($r-$rlast) + $rlast)}]
     234
     235                        set glast [lindex $_gvals $ilast]
     236                        set g [lindex $_gvals $i]
     237                        set g [expr {round($frac*($g-$glast) + $glast)}]
     238
     239                        set blast [lindex $_bvals $ilast]
     240                        set b [lindex $_bvals $i]
     241                        set b [expr {round($frac*($b-$blast) + $blast)}]
     242                    }
     243                    return [format {#%.4x%.4x%.4x} $r $g $b]
     244                }
     245                set ilast $i
     246                incr i
     247            }
     248        }
     249        -fraction {
     250            set v0 [lindex $_axis 0]
     251            set vend [lindex $_axis end]
     252            return [expr {($value-$v0)/double($vend-$v0)}]
     253        }
     254        default {
     255            error "bad flag \"$what\": should be -color or -fraction"
     256        }
    257257    }
    258258}
    … …  
    263263itcl::configbody Rappture::Spectrum::units {
    264264    if {"" != $units && [Rappture::Units::System::for $units] == ""} {
    265         error "bad value \"$units\": should be system of units"
     265        error "bad value \"$units\": should be system of units"
    266266    }
    267267    event !change
Note: See TracChangeset for help on using the changeset viewer.