source: branches/r9/gui/scripts/spectrum.tcl @ 5106

Last change on this file since 5106 was 3330, checked in by gah, 11 years ago

merge (by hand) with Rappture1.2 branch

File size: 9.6 KB
Line 
1# -*- mode: tcl; indent-tabs-mode: nil -*-
2# ----------------------------------------------------------------------
3#  COMPONENT: spectrum - maps a range of real values onto a color
4#
5#  This data object represents the mapping of a range of real values
6#  onto a range of colors.  It is used in conjunction with other
7#  widgets, such as the Rappture::Gauge.
8#
9#  EXAMPLE:
10#    Rappture::Spectrum #auto {
11#       0.0   red
12#       1.0   green
13#      10.0   #d9d9d9
14#    }
15# ======================================================================
16#  AUTHOR:  Michael McLennan, Purdue University
17#  Copyright (c) 2004-2012  HUBzero Foundation, LLC
18#
19#  See the file "license.terms" for information on usage and
20#  redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES.
21# ======================================================================
22package require Itk
23
24itcl::class Rappture::Spectrum {
25    inherit Rappture::Dispatcher
26
27    public variable units ""  ;# default units for all real values
28
29    constructor {{sdata ""} args} { # defined below }
30
31    public method insert {args}
32    public method delete {first {last ""}}
33    public method get {args}
34
35    private variable _axis ""       ;# list of real values along axis
36    private variable _rvals ""      ;# list of red components along axis
37    private variable _gvals ""      ;# list of green components along axis
38    private variable _bvals ""      ;# list of blue components along axis
39    private variable _spectrum 0    ;# use continuous visible spectrum
40    private variable _specv0 0      ;# minimum value
41    private variable _specw0 0      ;# wavelength for minimum
42}
43                                                                               
44# ----------------------------------------------------------------------
45# CONSTRUCTOR
46# ----------------------------------------------------------------------
47itcl::body Rappture::Spectrum::constructor {{sdata ""} args} {
48    register !change  ;# used to signal changes in spectrum
49
50    if {[llength $sdata] > 0} {
51        regsub -all {\n} $sdata { } sdata
52        eval insert $sdata
53    }
54    eval configure $args
55}
56
57# ----------------------------------------------------------------------
58# USAGE: insert ?<value1> <color1> <value2> <color2> ...?
59#
60# Clients use this to insert one or more values into the spectrum.
61# Each value has an associated color.  These values are used in the
62# "get" method to map any incoming value to its interpolated color
63# in the spectrum.
64# ----------------------------------------------------------------------
65itcl::body Rappture::Spectrum::insert {args} {
66    set changed 0
67
68    # special case. Two values in nm, then use
69    # spectrum instead of gradient.
70    if {[llength $args] == 4} {
71        set cnt 0
72        foreach {value color} $args {
73            if {[string match "*nm" $color]} {
74                incr cnt
75            }
76        }
77        if {$cnt == 2} {
78            set val0 [lindex $args 0]
79            set color0 [string trimright [lindex $args 1] "nm"]
80            set val1 [lindex $args 2]
81            set color1 [string trimright [lindex $args 3] "nm"]
82           
83            if {"" != $units} {
84                set val0 [Rappture::Units::convert $val0 \
85                              -context $units -to $units -units off]
86                set val1 [Rappture::Units::convert $val1 \
87                              -context $units -to $units -units off]
88            }
89
90            set _spectrum [expr (double($color1) - double($color0)) \
91                           / (double($val1) - double($val0))]
92            set _specv0 $val0
93            set _specw0 $color0
94            return
95        }
96    }
97
98    foreach {value color} $args {
99        if {"" != $units} {
100            set value [Rappture::Units::convert $value \
101                -context $units -to $units -units off]
102        }
103        foreach {r g b} [Rappture::color::RGB $color] { break }
104        set i 0
105        foreach v $_axis {
106            if {$value == $v} {
107                set _rvals [lreplace $_rvals $i $i $r]
108                set _gvals [lreplace $_gvals $i $i $g]
109                set _bvals [lreplace $_bvals $i $i $b]
110                set changed 1
111                break
112            } elseif {$value < $v} {
113                set _axis  [linsert $_axis $i $value]
114                set _rvals [linsert $_rvals $i $r]
115                set _gvals [linsert $_gvals $i $g]
116                set _bvals [linsert $_bvals $i $b]
117                set changed 1
118                break
119            }
120            incr i
121        }
122
123        if {$i >= [llength $_axis]} {
124            lappend _axis $value
125            lappend _rvals $r
126            lappend _gvals $g
127            lappend _bvals $b
128            set changed 1
129        }
130    }
131
132    # let any clients know if something has changed
133    if {$changed} {
134        event !change
135    }
136}
137
138# ----------------------------------------------------------------------
139# USAGE: delete <first> ?<last>?
140#
141# Clients use this to delete one or more entries from the spectrum.
142# The <first> and <last> represent the integer index of the desired
143# element.  If only <first> is specified, then that one element is
144# deleted.  If <last> is specified, then all elements in the range
145# <first> to <last> are deleted.
146# ----------------------------------------------------------------------
147itcl::body Rappture::Spectrum::delete {first {last ""}} {
148    if {$last == ""} {
149        set last $first
150    }
151    if {![regexp {^[0-9]+|end$} $first]} {
152        error "bad index \"$first\": should be integer or \"end\""
153    }
154    if {![regexp {^[0-9]+|end$} $last]} {
155        error "bad index \"$last\": should be integer or \"end\""
156    }
157
158    if {[llength [lrange $_axis $first $last]] > 0} {
159        set _axis [lreplace $_axis $first $last]
160        set _rvals [lreplace $_rvals $first $last]
161        set _gvals [lreplace $_gvals $first $last]
162        set _bvals [lreplace $_bvals $first $last]
163        event !change
164    }
165}
166
167# ----------------------------------------------------------------------
168# USAGE: get ?-color|-fraction? ?<value>?
169#
170# Clients use this to get information about the spectrum.  With no args,
171# it returns a list of elements in the form accepted by the "insert"
172# method.  Otherwise, it returns the interpolated value for the given
173# <value>.  By default, it returns the interpolated color, but the
174# -fraction flag can be specified to query the fractional position
175# along the spectrum.
176# ----------------------------------------------------------------------
177itcl::body Rappture::Spectrum::get {args} {
178    if {[llength $args] == 0} {
179        set rlist ""
180        foreach v $_axis r $_rvals g $_gvals b $_bvals {
181            lappend rlist "$v$units" [format {#%.4x%.4x%.4x} $r $g $b]
182        }
183        return $rlist
184    }
185
186    set what "-color"
187    while {[llength $args] > 0} {
188        set first [lindex $args 0]
189        if {[regexp {^-[a-zA-Z]} $first]} {
190            set what $first
191            set args [lrange $args 1 end]
192        } else {
193            break
194        }
195    }
196    if {[llength $args] != 1} {
197        error "wrong # args: should be \"get ?-color|-fraction? ?value?\""
198    }
199
200    set value [lindex $args 0]
201    if {$units != ""} {
202        set value [Rappture::Units::convert $value \
203            -context $units -to $units -units off]
204    }
205
206    switch -- $what {
207        -color {
208            if {$_spectrum != 0} {
209                # continuous spectrum. just compute wavelength
210                set waveln [expr ($value - $_specv0) * $_spectrum + $_specw0]
211                return [Rappture::color::wave2RGB $waveln]
212            }
213            set i 0
214            set ilast ""
215            while {$i <= [llength $_axis]} {
216                set v [lindex $_axis $i]
217
218                if {$v == ""} {
219                    set r [lindex $_rvals $ilast]
220                    set g [lindex $_gvals $ilast]
221                    set b [lindex $_bvals $ilast]
222                    return [format {#%.4x%.4x%.4x} $r $g $b]
223                } elseif {$value < $v} {
224                    if {$ilast == ""} {
225                        set r [lindex $_rvals $i]
226                        set g [lindex $_gvals $i]
227                        set b [lindex $_bvals $i]
228                    } else {
229                        set vlast [lindex $_axis $ilast]
230                        set frac [expr {($value-$vlast)/double($v-$vlast)}]
231
232                        set rlast [lindex $_rvals $ilast]
233                        set r [lindex $_rvals $i]
234                        set r [expr {round($frac*($r-$rlast) + $rlast)}]
235
236                        set glast [lindex $_gvals $ilast]
237                        set g [lindex $_gvals $i]
238                        set g [expr {round($frac*($g-$glast) + $glast)}]
239
240                        set blast [lindex $_bvals $ilast]
241                        set b [lindex $_bvals $i]
242                        set b [expr {round($frac*($b-$blast) + $blast)}]
243                    }
244                    return [format {#%.4x%.4x%.4x} $r $g $b]
245                }
246                set ilast $i
247                incr i
248            }
249        }
250        -fraction {
251            set v0 [lindex $_axis 0]
252            set vend [lindex $_axis end]
253            return [expr {($value-$v0)/double($vend-$v0)}]
254        }
255        default {
256            error "bad flag \"$what\": should be -color or -fraction"
257        }
258    }
259}
260
261# ----------------------------------------------------------------------
262# CONFIGURATION OPTIONS: -units
263# ----------------------------------------------------------------------
264itcl::configbody Rappture::Spectrum::units {
265    if {"" != $units && [Rappture::Units::System::for $units] == ""} {
266        error "bad value \"$units\": should be system of units"
267    }
268    event !change
269}
Note: See TracBrowser for help on using the repository browser.