[3330] | 1 | # -*- mode: tcl; indent-tabs-mode: nil -*- |
---|
[13] | 2 | # ---------------------------------------------------------------------- |
---|
| 3 | # UTILITY: color |
---|
| 4 | # |
---|
| 5 | # This file contains various utility functions for manipulating |
---|
| 6 | # color values. |
---|
| 7 | # ====================================================================== |
---|
| 8 | # AUTHOR: Michael McLennan, Purdue University |
---|
[3177] | 9 | # Copyright (c) 2004-2012 HUBzero Foundation, LLC |
---|
[115] | 10 | # |
---|
| 11 | # See the file "license.terms" for information on usage and |
---|
| 12 | # redistribution of this file, and for a DISCLAIMER OF ALL WARRANTIES. |
---|
[13] | 13 | # ====================================================================== |
---|
| 14 | |
---|
| 15 | namespace eval Rappture::color { # forward declaration } |
---|
| 16 | |
---|
| 17 | # --------------------------------------------------------------------- |
---|
| 18 | # USAGE: brightness <color> <fraction> |
---|
| 19 | # |
---|
| 20 | # Used to brighten or dim a Tk <color> value by some +/- <fraction> in |
---|
| 21 | # the range 0-1. Returns another color in the same hue, but with |
---|
| 22 | # different brighness. |
---|
| 23 | # ---------------------------------------------------------------------- |
---|
| 24 | proc Rappture::color::brightness {color frac} { |
---|
| 25 | foreach {h s v} [Rappture::color::RGBtoHSV $color] { break } |
---|
| 26 | set v [expr {$v+$frac}] |
---|
| 27 | |
---|
| 28 | # if frac overflows the value, pass changes along to saturation |
---|
| 29 | if {$v < 0} { |
---|
[1929] | 30 | set s [expr {$s+$v}] |
---|
| 31 | if {$s < 0} { set s 0 } |
---|
| 32 | set v 0 |
---|
[13] | 33 | } |
---|
| 34 | if {$v > 1} { |
---|
[1929] | 35 | set s [expr {$s-($v-1)}] |
---|
| 36 | if {$s < 0} { set s 0 } |
---|
| 37 | set v 1 |
---|
[13] | 38 | } |
---|
| 39 | |
---|
| 40 | return [Rappture::color::HSVtoRGB $h $s $v] |
---|
| 41 | } |
---|
| 42 | |
---|
| 43 | # --------------------------------------------------------------------- |
---|
[64] | 44 | # USAGE: brightness_min <color> <min> |
---|
| 45 | # |
---|
| 46 | # Used to make sure a color is not too dim. If the value is less |
---|
| 47 | # than the <min>, then it is capped at that value. That way, the |
---|
| 48 | # return color shows up against black. |
---|
| 49 | # ---------------------------------------------------------------------- |
---|
| 50 | proc Rappture::color::brightness_min {color min} { |
---|
| 51 | foreach {h s v} [Rappture::color::RGBtoHSV $color] { break } |
---|
| 52 | if {$v < $min} { |
---|
[1929] | 53 | set v $min |
---|
[64] | 54 | } |
---|
| 55 | return [Rappture::color::HSVtoRGB $h $s $v] |
---|
| 56 | } |
---|
| 57 | |
---|
| 58 | # --------------------------------------------------------------------- |
---|
| 59 | # USAGE: brightness_max <color> <max> |
---|
| 60 | # |
---|
| 61 | # Used to make sure a color is not too dim. If the value is less |
---|
| 62 | # than the <min>, then it is capped at that value. That way, the |
---|
| 63 | # return color shows up against black. |
---|
| 64 | # ---------------------------------------------------------------------- |
---|
| 65 | proc Rappture::color::brightness_max {color max} { |
---|
| 66 | foreach {h s v} [Rappture::color::RGBtoHSV $color] { break } |
---|
| 67 | if {$v > $max} { |
---|
[1929] | 68 | set v $max |
---|
[64] | 69 | } |
---|
| 70 | return [Rappture::color::HSVtoRGB $h $s $v] |
---|
| 71 | } |
---|
| 72 | |
---|
| 73 | # --------------------------------------------------------------------- |
---|
[13] | 74 | # USAGE: RGBtoHSV <color> |
---|
| 75 | # |
---|
| 76 | # Used to convert a Tk <color> value to hue, saturation, value |
---|
| 77 | # components. Returns a list of the form {h s v}. |
---|
| 78 | # ---------------------------------------------------------------------- |
---|
| 79 | proc Rappture::color::RGBtoHSV {color} { |
---|
| 80 | # |
---|
| 81 | # If the colors are exhausted sometimes winfo can fail with a |
---|
| 82 | # division by zero. Catch it to avoid problems. |
---|
| 83 | # |
---|
| 84 | if { [catch {winfo rgb . $color} status] != 0 } { |
---|
[1929] | 85 | set s 0 |
---|
| 86 | set v 0 |
---|
| 87 | set h 0 |
---|
| 88 | return [list $h $s $v] |
---|
[13] | 89 | } |
---|
| 90 | foreach {r g b} $status {} |
---|
| 91 | set min [expr {($r < $g) ? $r : $g}] |
---|
| 92 | set min [expr {($b < $min) ? $b : $min}] |
---|
| 93 | set max [expr {($r > $g) ? $r : $g}] |
---|
| 94 | set max [expr {($b > $max) ? $b : $max}] |
---|
| 95 | |
---|
| 96 | set v [expr {$max/65535.0}] |
---|
| 97 | |
---|
| 98 | set delta [expr {$max-$min}] |
---|
| 99 | |
---|
| 100 | if { $delta == 0 } { |
---|
[1929] | 101 | # delta=0 => gray color |
---|
| 102 | set s 0 |
---|
| 103 | set v [expr {$r/65535.0}] |
---|
| 104 | set h 0 |
---|
| 105 | return [list $h $s $v] |
---|
[13] | 106 | } |
---|
| 107 | |
---|
| 108 | if {$max > 0} { |
---|
[1929] | 109 | set s [expr {$delta/double($max)}] |
---|
[13] | 110 | } else { |
---|
[1929] | 111 | # r=g=b=0 => s=0, v undefined |
---|
| 112 | set s 0 |
---|
| 113 | set v 0 |
---|
| 114 | set h 0 |
---|
| 115 | return [list $h $s $v] |
---|
[13] | 116 | } |
---|
| 117 | |
---|
| 118 | if {$r == $max} { |
---|
[1929] | 119 | set h [expr {($g - $b)/double($delta)}] |
---|
[13] | 120 | } elseif {$g == $max} { |
---|
[1929] | 121 | set h [expr {2 + ($b - $r)/double($delta)}] |
---|
[13] | 122 | } else { |
---|
[1929] | 123 | set h [expr {4 + ($r - $g)/double($delta)}] |
---|
[13] | 124 | } |
---|
| 125 | set h [expr {$h*1.04719756667}] ;# *60 degrees |
---|
| 126 | if {$h < 0} { |
---|
[1929] | 127 | set h [expr {$h+6.2831854}] |
---|
[13] | 128 | } |
---|
| 129 | return [list $h $s $v] |
---|
| 130 | } |
---|
| 131 | |
---|
| 132 | # --------------------------------------------------------------------- |
---|
| 133 | # USAGE: HSVtoRGB <color> |
---|
| 134 | # |
---|
| 135 | # Used to convert hue, saturation, value for a color to its |
---|
| 136 | # equivalent RGB form. Returns a prompt Tk color of the form |
---|
| 137 | # #RRGGBB. |
---|
| 138 | # ---------------------------------------------------------------------- |
---|
| 139 | proc Rappture::color::HSVtoRGB {h s v} { |
---|
| 140 | if {$s == 0} { |
---|
[1929] | 141 | set v [expr round(255*$v)] |
---|
| 142 | set r $v |
---|
| 143 | set g $v |
---|
| 144 | set b $v |
---|
[13] | 145 | } else { |
---|
[1929] | 146 | if {$h >= 6.28318} {set h [expr $h-6.28318]} |
---|
| 147 | set h [expr $h/1.0472] |
---|
| 148 | set f [expr $h-floor($h)] |
---|
| 149 | set p [expr round(255*$v*(1.0-$s))] |
---|
| 150 | set q [expr round(255*$v*(1.0-$s*$f))] |
---|
| 151 | set t [expr round(255*$v*(1.0-$s*(1.0-$f)))] |
---|
| 152 | set v [expr round(255*$v)] |
---|
[13] | 153 | |
---|
[1929] | 154 | switch [expr int($h)] { |
---|
| 155 | 0 {set r $v; set g $t; set b $p} |
---|
| 156 | 1 {set r $q; set g $v; set b $p} |
---|
| 157 | 2 {set r $p; set g $v; set b $t} |
---|
| 158 | 3 {set r $p; set g $q; set b $v} |
---|
| 159 | 4 {set r $t; set g $p; set b $v} |
---|
| 160 | 5 {set r $v; set g $p; set b $q} |
---|
| 161 | } |
---|
[13] | 162 | } |
---|
| 163 | return [format "#%.2x%.2x%.2x" $r $g $b] |
---|
| 164 | } |
---|
[1075] | 165 | |
---|
| 166 | # --------------------------------------------------------------------- |
---|
| 167 | # USAGE: wave2RGB <wavelength> |
---|
| 168 | # |
---|
| 169 | # Given a visible wavelength in nm, returns a Tk color of the form |
---|
| 170 | # #RRGGBB. Returns black for nonvisible wavelengths. Based on code from |
---|
| 171 | # Dan Bruton (astro@tamu.edu) http://www.physics.sfasu.edu/astro/color/spectra.html |
---|
| 172 | # ---------------------------------------------------------------------- |
---|
| 173 | |
---|
| 174 | proc Rappture::color::wave2RGB {wl} { |
---|
| 175 | |
---|
| 176 | # strip off any units |
---|
| 177 | set wl [string trimright $wl "nm"] |
---|
| 178 | |
---|
| 179 | if {$wl < 380 || $wl > 780} { |
---|
[1929] | 180 | return black |
---|
[1075] | 181 | } |
---|
| 182 | set gamma 0.8 |
---|
| 183 | set r 0.0 |
---|
| 184 | set g 0.0 |
---|
| 185 | set b 0.0 |
---|
| 186 | if {$wl <= 440} { |
---|
[1929] | 187 | set r [expr (440.0 - $wl) / 60.0] |
---|
| 188 | set b 1.0 |
---|
[1075] | 189 | } elseif {$wl <= 490} { |
---|
[1929] | 190 | set g [expr ($wl - 440.0) / 50.0] |
---|
| 191 | set b 1.0 |
---|
[1075] | 192 | } elseif {$wl <= 510} { |
---|
[1929] | 193 | set g 1.0 |
---|
| 194 | set b [expr (510.0 - $wl) / 20.0] |
---|
[1075] | 195 | } elseif {$wl <= 580} { |
---|
[1929] | 196 | set g 1.0 |
---|
| 197 | set r [expr ($wl - 510.0) / 70.0] |
---|
[1075] | 198 | } elseif {$wl <= 645} { |
---|
[1929] | 199 | set r 1.0 |
---|
| 200 | set g [expr (645.0 - $wl) / 65.0] |
---|
[1075] | 201 | } else { |
---|
[1929] | 202 | set r 1.0 |
---|
[1075] | 203 | } |
---|
| 204 | |
---|
| 205 | if {$wl > 700} { |
---|
[1929] | 206 | set sss [expr 0.3 + 0.7 * (780.0 - $wl) / 80.0] |
---|
[1075] | 207 | } elseif {$wl < 420} { |
---|
[1929] | 208 | set sss [expr 0.3 + 0.7 * ($wl - 380.0) / 40.0] |
---|
[1075] | 209 | } else { |
---|
[1929] | 210 | set sss 1.0 |
---|
[1075] | 211 | } |
---|
| 212 | set r [expr int(255.0 * pow(($sss * $r), $gamma))] |
---|
| 213 | set g [expr int(255.0 * pow(($sss * $g), $gamma))] |
---|
| 214 | set b [expr int(255.0 * pow(($sss * $b), $gamma))] |
---|
| 215 | return [format "#%.2X%.2X%.2X" $r $g $b] |
---|
| 216 | } |
---|
| 217 | |
---|
| 218 | # Returns a list containing three decimal values in the range 0 to 65535, |
---|
| 219 | # which are the red, green, and blue intensities that correspond to color |
---|
| 220 | # in the window given by window. Color may be specified in any of the forms |
---|
| 221 | # acceptable for a color option. |
---|
| 222 | proc Rappture::color::RGB {color} { |
---|
| 223 | if {[string match "*nm" $color]} { |
---|
[1929] | 224 | set color [Rappture::color::wave2RGB [string trimright $color "nm"]] |
---|
[1075] | 225 | } |
---|
| 226 | return [winfo rgb . $color] |
---|
| 227 | } |
---|