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