Artifact
0ae3d4c6d419e80b8771da084bf82a310094db5f:
- File
addons/bwidgetR1.6/color.tcl
— part of check-in
[f8e3ba8cce]
at
2011-06-30 18:30:46
on branch trunk
— added bwidgetR1.6 supergrid and supertext to fossil
(user:
ramsan
size: 14235)
0000: 6e 61 6d 65 73 70 61 63 65 20 65 76 61 6c 20 53 namespace eval S
0010: 65 6c 65 63 74 43 6f 6c 6f 72 20 7b 0a 20 20 20 electColor {.
0020: 20 57 69 64 67 65 74 3a 3a 64 65 66 69 6e 65 20 Widget::define
0030: 53 65 6c 65 63 74 43 6f 6c 6f 72 20 63 6f 6c 6f SelectColor colo
0040: 72 20 44 69 61 6c 6f 67 0a 0a 20 20 20 20 57 69 r Dialog.. Wi
0050: 64 67 65 74 3a 3a 64 65 63 6c 61 72 65 20 53 65 dget::declare Se
0060: 6c 65 63 74 43 6f 6c 6f 72 20 7b 0a 20 20 20 20 lectColor {.
0070: 20 20 20 20 7b 2d 74 69 74 6c 65 20 20 20 20 20 {-title
0080: 53 74 72 69 6e 67 20 20 20 20 20 22 53 65 6c 65 String "Sele
0090: 63 74 20 61 20 63 6f 6c 6f 72 22 20 30 7d 0a 20 ct a color" 0}.
00a0: 20 20 20 20 20 20 20 7b 2d 70 61 72 65 6e 74 20 {-parent
00b0: 20 20 20 53 74 72 69 6e 67 20 20 20 20 20 22 22 String ""
00c0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 30 0
00d0: 7d 0a 20 20 20 20 20 20 20 20 7b 2d 63 6f 6c 6f }. {-colo
00e0: 72 20 20 20 20 20 54 6b 52 65 73 6f 75 72 63 65 r TkResource
00f0: 20 22 22 20 20 20 20 20 20 20 20 20 20 20 20 20 ""
0100: 20 20 30 20 7b 6c 61 62 65 6c 20 2d 62 61 63 6b 0 {label -back
0110: 67 72 6f 75 6e 64 7d 7d 0a 09 7b 2d 74 79 70 65 ground}}..{-type
0120: 20 20 20 20 20 20 45 6e 75 6d 20 20 20 20 20 20 Enum
0130: 20 22 64 69 61 6c 6f 67 22 20 20 20 20 20 20 20 "dialog"
0140: 20 20 31 20 7b 64 69 61 6c 6f 67 20 70 6f 70 75 1 {dialog popu
0150: 70 7d 7d 0a 09 7b 2d 70 6c 61 63 65 6d 65 6e 74 p}}..{-placement
0160: 20 53 74 72 69 6e 67 20 20 20 20 20 22 63 65 6e String "cen
0170: 74 65 72 22 20 20 20 20 20 20 20 20 20 31 7d 0a ter" 1}.
0180: 20 20 20 20 7d 0a 0a 20 20 20 20 76 61 72 69 61 }.. varia
0190: 62 6c 65 20 5f 62 61 73 65 43 6f 6c 6f 72 73 20 ble _baseColors
01a0: 7b 0a 20 20 20 20 20 20 20 20 5c 23 30 30 30 30 {. \#0000
01b0: 66 66 20 5c 23 30 30 66 66 30 30 20 5c 23 30 30 ff \#00ff00 \#00
01c0: 66 66 66 66 20 5c 23 66 66 30 30 30 30 20 5c 23 ffff \#ff0000 \#
01d0: 66 66 30 30 66 66 20 5c 23 66 66 66 66 30 30 0a ff00ff \#ffff00.
01e0: 20 20 20 20 20 20 20 20 5c 23 30 30 30 30 39 39 \#000099
01f0: 20 5c 23 30 30 39 39 30 30 20 5c 23 30 30 39 39 \#009900 \#0099
0200: 39 39 20 5c 23 39 39 30 30 30 30 20 5c 23 39 39 99 \#990000 \#99
0210: 30 30 39 39 20 5c 23 39 39 39 39 30 30 0a 20 20 0099 \#999900.
0220: 20 20 20 20 20 20 5c 23 30 30 30 30 30 30 20 5c \#000000 \
0230: 23 33 33 33 33 33 33 20 5c 23 36 36 36 36 36 36 #333333 \#666666
0240: 20 5c 23 39 39 39 39 39 39 20 5c 23 63 63 63 63 \#999999 \#cccc
0250: 63 63 20 5c 23 66 66 66 66 66 66 0a 20 20 20 20 cc \#ffffff.
0260: 7d 0a 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 }.. variable
0270: 5f 75 73 65 72 43 6f 6c 6f 72 73 20 7b 0a 20 20 _userColors {.
0280: 20 20 20 20 20 20 5c 23 66 66 66 66 66 66 20 5c \#ffffff \
0290: 23 66 66 66 66 66 66 20 5c 23 66 66 66 66 66 66 #ffffff \#ffffff
02a0: 20 5c 23 66 66 66 66 66 66 20 5c 23 66 66 66 66 \#ffffff \#ffff
02b0: 66 66 20 5c 23 66 66 66 66 66 66 0a 20 20 20 20 ff \#ffffff.
02c0: 20 20 20 20 5c 23 66 66 66 66 66 66 20 5c 23 66 \#ffffff \#f
02d0: 66 66 66 66 66 20 5c 23 66 66 66 66 66 66 20 5c fffff \#ffffff \
02e0: 23 66 66 66 66 66 66 20 5c 23 66 66 66 66 66 66 #ffffff \#ffffff
02f0: 0a 20 20 20 20 7d 0a 0a 20 20 20 20 69 66 20 7b . }.. if {
0300: 5b 73 74 72 69 6e 67 20 65 71 75 61 6c 20 24 3a [string equal $:
0310: 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c :tcl_platform(pl
0320: 61 74 66 6f 72 6d 29 20 22 75 6e 69 78 22 5d 7d atform) "unix"]}
0330: 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 75 {. set u
0340: 73 65 54 6b 44 69 61 6c 6f 67 75 65 20 30 0a 20 seTkDialogue 0.
0350: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
0360: 20 20 20 20 73 65 74 20 75 73 65 54 6b 44 69 61 set useTkDia
0370: 6c 6f 67 75 65 20 31 0a 20 20 20 20 7d 0a 0a 20 logue 1. }..
0380: 20 20 20 76 61 72 69 61 62 6c 65 20 5f 73 65 6c variable _sel
0390: 65 63 74 79 70 65 0a 20 20 20 20 76 61 72 69 61 ectype. varia
03a0: 62 6c 65 20 5f 73 65 6c 65 63 74 69 6f 6e 0a 20 ble _selection.
03b0: 20 20 20 76 61 72 69 61 62 6c 65 20 5f 77 63 6f variable _wco
03c0: 6c 6f 72 0a 20 20 20 20 76 61 72 69 61 62 6c 65 lor. variable
03d0: 20 5f 69 6d 61 67 65 0a 20 20 20 20 76 61 72 69 _image. vari
03e0: 61 62 6c 65 20 5f 68 73 76 0a 7d 0a 0a 70 72 6f able _hsv.}..pro
03f0: 63 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a 63 c SelectColor::c
0400: 72 65 61 74 65 20 7b 20 70 61 74 68 20 61 72 67 reate { path arg
0410: 73 20 7d 20 7b 0a 20 20 20 20 57 69 64 67 65 74 s } {. Widget
0420: 3a 3a 69 6e 69 74 20 53 65 6c 65 63 74 43 6f 6c ::init SelectCol
0430: 6f 72 20 24 70 61 74 68 20 24 61 72 67 73 0a 0a or $path $args..
0440: 20 20 20 20 73 65 74 20 74 79 70 65 20 5b 57 69 set type [Wi
0450: 64 67 65 74 3a 3a 63 67 65 74 20 24 70 61 74 68 dget::cget $path
0460: 20 2d 74 79 70 65 5d 0a 0a 20 20 20 20 73 77 69 -type].. swi
0470: 74 63 68 20 2d 2d 20 5b 57 69 64 67 65 74 3a 3a tch -- [Widget::
0480: 63 67 65 74 20 24 70 61 74 68 20 2d 74 79 70 65 cget $path -type
0490: 5d 20 7b 0a 09 22 64 69 61 6c 6f 67 22 20 7b 0a ] {.."dialog" {.
04a0: 09 20 20 20 20 72 65 74 75 72 6e 20 5b 65 76 61 . return [eva
04b0: 6c 20 5b 6c 69 73 74 20 53 65 6c 65 63 74 43 6f l [list SelectCo
04c0: 6c 6f 72 3a 3a 64 69 61 6c 6f 67 20 24 70 61 74 lor::dialog $pat
04d0: 68 5d 20 24 61 72 67 73 5d 0a 09 7d 0a 0a 09 22 h] $args]..}..."
04e0: 70 6f 70 75 70 22 20 7b 0a 09 20 20 20 20 73 65 popup" {.. se
04f0: 74 20 6c 69 73 74 20 20 20 20 20 20 5b 6c 69 73 t list [lis
0500: 74 20 61 74 20 63 65 6e 74 65 72 20 6c 65 66 74 t at center left
0510: 20 72 69 67 68 74 20 61 62 6f 76 65 20 62 65 6c right above bel
0520: 6f 77 5d 0a 09 20 20 20 20 73 65 74 20 70 6c 61 ow].. set pla
0530: 63 65 6d 65 6e 74 20 5b 57 69 64 67 65 74 3a 3a cement [Widget::
0540: 63 67 65 74 20 24 70 61 74 68 20 2d 70 6c 61 63 cget $path -plac
0550: 65 6d 65 6e 74 5d 0a 09 20 20 20 20 73 65 74 20 ement].. set
0560: 77 68 65 72 65 20 20 20 20 20 5b 6c 69 6e 64 65 where [linde
0570: 78 20 24 70 6c 61 63 65 6d 65 6e 74 20 30 5d 0a x $placement 0].
0580: 0a 09 20 20 20 20 69 66 20 7b 5b 6c 73 65 61 72 .. if {[lsear
0590: 63 68 20 24 6c 69 73 74 20 24 77 68 65 72 65 5d ch $list $where]
05a0: 20 3c 20 30 7d 20 7b 0a 09 09 72 65 74 75 72 6e < 0} {...return
05b0: 20 2d 63 6f 64 65 20 65 72 72 6f 72 20 5c 0a 09 -code error \..
05c0: 09 20 20 20 20 5b 42 57 69 64 67 65 74 3a 3a 62 . [BWidget::b
05d0: 61 64 4f 70 74 69 6f 6e 53 74 72 69 6e 67 20 70 adOptionString p
05e0: 6c 61 63 65 6d 65 6e 74 20 24 70 6c 61 63 65 6d lacement $placem
05f0: 65 6e 74 20 24 6c 69 73 74 5d 0a 09 20 20 20 20 ent $list]..
0600: 7d 0a 0a 09 20 20 20 20 23 23 20 49 66 20 74 68 }... ## If th
0610: 65 79 20 73 70 65 63 69 66 69 65 64 20 61 20 70 ey specified a p
0620: 61 72 65 6e 74 20 61 6e 64 20 64 69 64 6e 27 74 arent and didn't
0630: 20 70 61 73 73 20 61 20 73 65 63 6f 6e 64 20 61 pass a second a
0640: 72 67 75 6d 65 6e 74 0a 09 20 20 20 20 23 23 20 rgument.. ##
0650: 69 6e 20 74 68 65 20 70 6c 61 63 65 6d 65 6e 74 in the placement
0660: 2c 20 73 65 74 20 74 68 65 20 70 6c 61 63 65 6d , set the placem
0670: 65 6e 74 20 72 65 6c 61 74 69 76 65 20 74 6f 20 ent relative to
0680: 74 68 65 20 70 61 72 65 6e 74 2e 0a 09 20 20 20 the parent...
0690: 20 73 65 74 20 70 61 72 65 6e 74 20 5b 57 69 64 set parent [Wid
06a0: 67 65 74 3a 3a 63 67 65 74 20 24 70 61 74 68 20 get::cget $path
06b0: 2d 70 61 72 65 6e 74 5d 0a 09 20 20 20 20 69 66 -parent].. if
06c0: 20 7b 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {[string length
06d0: 20 24 70 61 72 65 6e 74 5d 7d 20 7b 0a 09 09 69 $parent]} {...i
06e0: 66 20 7b 5b 6c 6c 65 6e 67 74 68 20 24 70 6c 61 f {[llength $pla
06f0: 63 65 6d 65 6e 74 5d 20 3d 3d 20 31 7d 20 7b 20 cement] == 1} {
0700: 6c 61 70 70 65 6e 64 20 70 6c 61 63 65 6d 65 6e lappend placemen
0710: 74 20 24 70 61 72 65 6e 74 20 7d 0a 09 20 20 20 t $parent }..
0720: 20 7d 0a 09 20 20 20 20 72 65 74 75 72 6e 20 5b }.. return [
0730: 65 76 61 6c 20 5b 6c 69 73 74 20 53 65 6c 65 63 eval [list Selec
0740: 74 43 6f 6c 6f 72 3a 3a 6d 65 6e 75 20 24 70 61 tColor::menu $pa
0750: 74 68 20 24 70 6c 61 63 65 6d 65 6e 74 5d 20 24 th $placement] $
0760: 61 72 67 73 5d 0a 09 7d 0a 20 20 20 20 7d 0a 7d args]..}. }.}
0770: 0a 0a 70 72 6f 63 20 53 65 6c 65 63 74 43 6f 6c ..proc SelectCol
0780: 6f 72 3a 3a 6d 65 6e 75 20 7b 70 61 74 68 20 70 or::menu {path p
0790: 6c 61 63 65 6d 65 6e 74 20 61 72 67 73 7d 20 7b lacement args} {
07a0: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f 62 . variable _b
07b0: 61 73 65 43 6f 6c 6f 72 73 0a 20 20 20 20 76 61 aseColors. va
07c0: 72 69 61 62 6c 65 20 5f 75 73 65 72 43 6f 6c 6f riable _userColo
07d0: 72 73 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 rs. variable
07e0: 5f 77 63 6f 6c 6f 72 0a 20 20 20 20 76 61 72 69 _wcolor. vari
07f0: 61 62 6c 65 20 5f 73 65 6c 65 63 74 79 70 65 0a able _selectype.
0800: 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f 73 65 variable _se
0810: 6c 65 63 74 69 6f 6e 0a 0a 20 20 20 20 57 69 64 lection.. Wid
0820: 67 65 74 3a 3a 69 6e 69 74 20 53 65 6c 65 63 74 get::init Select
0830: 43 6f 6c 6f 72 20 24 70 61 74 68 20 24 61 72 67 Color $path $arg
0840: 73 0a 20 20 20 20 73 65 74 20 74 6f 70 20 5b 3a s. set top [:
0850: 3a 6d 65 6e 75 20 24 70 61 74 68 5d 0a 20 20 20 :menu $path].
0860: 20 77 6d 20 77 69 74 68 64 72 61 77 20 20 24 74 wm withdraw $t
0870: 6f 70 0a 20 20 20 20 77 6d 20 74 72 61 6e 73 69 op. wm transi
0880: 65 6e 74 20 24 74 6f 70 20 5b 77 69 6e 66 6f 20 ent $top [winfo
0890: 74 6f 70 6c 65 76 65 6c 20 5b 77 69 6e 66 6f 20 toplevel [winfo
08a0: 70 61 72 65 6e 74 20 24 74 6f 70 5d 5d 0a 0a 20 parent $top]]..
08b0: 20 20 20 73 65 74 20 66 72 61 6d 65 20 5b 66 72 set frame [fr
08c0: 61 6d 65 20 24 74 6f 70 2e 66 72 61 6d 65 20 5c ame $top.frame \
08d0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
08e0: 20 20 20 20 2d 68 69 67 68 6c 69 67 68 74 74 68 -highlightth
08f0: 69 63 6b 6e 65 73 73 20 30 20 5c 0a 20 20 20 20 ickness 0 \.
0900: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d -
0910: 72 65 6c 69 65 66 20 72 61 69 73 65 64 20 2d 62 relief raised -b
0920: 6f 72 64 65 72 77 69 64 74 68 20 32 5d 0a 20 20 orderwidth 2].
0930: 20 20 73 65 74 20 63 6f 6c 20 20 20 20 30 0a 20 set col 0.
0940: 20 20 20 73 65 74 20 72 6f 77 20 20 20 20 30 0a set row 0.
0950: 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 20 30 set count 0
0960: 0a 20 20 20 20 73 65 74 20 63 6f 6c 6f 72 73 20 . set colors
0970: 5b 63 6f 6e 63 61 74 20 24 5f 62 61 73 65 43 6f [concat $_baseCo
0980: 6c 6f 72 73 20 24 5f 75 73 65 72 43 6f 6c 6f 72 lors $_userColor
0990: 73 5d 0a 20 20 20 20 66 6f 72 65 61 63 68 20 63 s]. foreach c
09a0: 6f 6c 6f 72 20 24 63 6f 6c 6f 72 73 20 7b 0a 20 olor $colors {.
09b0: 20 20 20 20 20 20 20 73 65 74 20 66 20 5b 66 72 set f [fr
09c0: 61 6d 65 20 24 66 72 61 6d 65 2e 63 24 63 6f 75 ame $frame.c$cou
09d0: 6e 74 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 nt \.
09e0: 20 20 20 20 20 20 20 20 2d 68 69 67 68 6c 69 67 -highlig
09f0: 68 74 74 68 69 63 6b 6e 65 73 73 20 31 20 5c 0a htthickness 1 \.
0a00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a10: 20 20 20 2d 68 69 67 68 6c 69 67 68 74 63 6f 6c -highlightcol
0a20: 6f 72 20 77 68 69 74 65 20 5c 0a 20 20 20 20 20 or white \.
0a30: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 72 -r
0a40: 65 6c 69 65 66 20 73 6f 6c 69 64 20 2d 62 6f 72 elief solid -bor
0a50: 64 65 72 77 69 64 74 68 20 31 20 5c 0a 20 20 20 derwidth 1 \.
0a60: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
0a70: 2d 77 69 64 74 68 20 31 36 20 2d 68 65 69 67 68 -width 16 -heigh
0a80: 74 20 31 36 20 2d 62 61 63 6b 67 72 6f 75 6e 64 t 16 -background
0a90: 20 24 63 6f 6c 6f 72 5d 0a 20 20 20 20 20 20 20 $color].
0aa0: 20 62 69 6e 64 20 24 66 20 3c 42 75 74 74 6f 6e bind $f <Button
0ab0: 50 72 65 73 73 2d 31 3e 20 5b 6c 69 73 74 20 73 Press-1> [list s
0ac0: 65 74 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a et SelectColor::
0ad0: 5f 73 65 6c 65 63 74 69 6f 6e 20 24 63 6f 75 6e _selection $coun
0ae0: 74 5d 0a 20 20 20 20 20 20 20 20 62 69 6e 64 20 t]. bind
0af0: 24 66 20 3c 45 6e 74 65 72 3e 20 20 20 20 20 20 $f <Enter>
0b00: 20 20 20 7b 66 6f 63 75 73 20 25 57 7d 0a 20 20 {focus %W}.
0b10: 20 20 20 20 20 20 67 72 69 64 20 24 66 20 2d 63 grid $f -c
0b20: 6f 6c 75 6d 6e 20 24 63 6f 6c 20 2d 72 6f 77 20 olumn $col -row
0b30: 24 72 6f 77 20 2d 70 61 64 78 20 31 20 2d 70 61 $row -padx 1 -pa
0b40: 64 79 20 31 0a 20 20 20 20 20 20 20 20 62 69 6e dy 1. bin
0b50: 64 74 61 67 73 20 24 66 20 24 66 0a 20 20 20 20 dtags $f $f.
0b60: 20 20 20 20 69 6e 63 72 20 63 6f 75 6e 74 0a 20 incr count.
0b70: 20 20 20 20 20 20 20 69 66 20 7b 5b 69 6e 63 72 if {[incr
0b80: 20 63 6f 6c 5d 20 3d 3d 20 36 20 7d 20 7b 0a 20 col] == 6 } {.
0b90: 20 20 20 20 20 20 20 20 20 20 20 73 65 74 20 20 set
0ba0: 63 6f 6c 20 30 0a 20 20 20 20 20 20 20 20 20 20 col 0.
0bb0: 20 20 69 6e 63 72 20 72 6f 77 0a 20 20 20 20 20 incr row.
0bc0: 20 20 20 7d 0a 20 20 20 20 7d 0a 20 20 20 20 73 }. }. s
0bd0: 65 74 20 66 20 5b 6c 61 62 65 6c 20 24 66 72 61 et f [label $fra
0be0: 6d 65 2e 63 24 63 6f 75 6e 74 20 5c 0a 20 20 20 me.c$count \.
0bf0: 20 20 20 20 20 20 20 20 20 20 20 20 2d 68 69 67 -hig
0c00: 68 6c 69 67 68 74 74 68 69 63 6b 6e 65 73 73 20 hlightthickness
0c10: 31 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 1 \.
0c20: 20 20 20 2d 68 69 67 68 6c 69 67 68 74 63 6f 6c -highlightcol
0c30: 6f 72 20 77 68 69 74 65 20 5c 0a 20 20 20 20 20 or white \.
0c40: 20 20 20 20 20 20 20 20 20 20 2d 72 65 6c 69 65 -relie
0c50: 66 20 66 6c 61 74 20 2d 62 6f 72 64 65 72 77 69 f flat -borderwi
0c60: 64 74 68 20 30 20 5c 0a 20 20 20 20 20 20 20 20 dth 0 \.
0c70: 20 20 20 20 20 20 20 2d 77 69 64 74 68 20 31 36 -width 16
0c80: 20 2d 68 65 69 67 68 74 20 31 36 20 2d 69 6d 61 -height 16 -ima
0c90: 67 65 20 5b 42 69 74 6d 61 70 3a 3a 67 65 74 20 ge [Bitmap::get
0ca0: 70 61 6c 65 74 74 65 5d 5d 0a 20 20 20 20 67 72 palette]]. gr
0cb0: 69 64 20 24 66 20 2d 63 6f 6c 75 6d 6e 20 24 63 id $f -column $c
0cc0: 6f 6c 20 2d 72 6f 77 20 24 72 6f 77 20 2d 70 61 ol -row $row -pa
0cd0: 64 78 20 31 20 2d 70 61 64 79 20 31 0a 20 20 20 dx 1 -pady 1.
0ce0: 20 62 69 6e 64 20 24 66 20 3c 42 75 74 74 6f 6e bind $f <Button
0cf0: 50 72 65 73 73 2d 31 3e 20 5b 6c 69 73 74 20 73 Press-1> [list s
0d00: 65 74 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a et SelectColor::
0d10: 5f 73 65 6c 65 63 74 69 6f 6e 20 24 63 6f 75 6e _selection $coun
0d20: 74 5d 0a 20 20 20 20 62 69 6e 64 20 24 66 20 3c t]. bind $f <
0d30: 45 6e 74 65 72 3e 20 20 20 20 20 20 20 20 20 7b Enter> {
0d40: 66 6f 63 75 73 20 25 57 7d 0a 20 20 20 20 70 61 focus %W}. pa
0d50: 63 6b 20 24 66 72 61 6d 65 0a 0a 20 20 20 20 62 ck $frame.. b
0d60: 69 6e 64 20 24 66 72 61 6d 65 20 3c 42 75 74 74 ind $frame <Butt
0d70: 6f 6e 50 72 65 73 73 2d 31 3e 20 7b 73 65 74 20 onPress-1> {set
0d80: 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a 5f 73 65 SelectColor::_se
0d90: 6c 65 63 74 69 6f 6e 20 2d 31 7d 0a 20 20 20 20 lection -1}.
0da0: 62 69 6e 64 20 24 66 72 61 6d 65 20 3c 46 6f 63 bind $frame <Foc
0db0: 75 73 4f 75 74 3e 20 20 20 20 20 20 7b 73 65 74 usOut> {set
0dc0: 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a 5f 73 SelectColor::_s
0dd0: 65 6c 65 63 74 69 6f 6e 20 2d 32 7d 0a 20 20 20 election -2}.
0de0: 20 65 76 61 6c 20 5b 6c 69 73 74 20 42 57 69 64 eval [list BWid
0df0: 67 65 74 3a 3a 70 6c 61 63 65 20 24 74 6f 70 20 get::place $top
0e00: 30 20 30 5d 20 24 70 6c 61 63 65 6d 65 6e 74 0a 0 0] $placement.
0e10: 0a 20 20 20 20 77 6d 20 64 65 69 63 6f 6e 69 66 . wm deiconif
0e20: 79 20 24 74 6f 70 0a 20 20 20 20 72 61 69 73 65 y $top. raise
0e30: 20 24 74 6f 70 0a 20 20 20 20 69 66 20 7b 24 3a $top. if {$:
0e40: 3a 74 63 6c 5f 70 6c 61 74 66 6f 72 6d 28 70 6c :tcl_platform(pl
0e50: 61 74 66 6f 72 6d 29 20 3d 3d 20 22 75 6e 69 78 atform) == "unix
0e60: 22 7d 20 7b 0a 09 74 6b 77 61 69 74 20 76 69 73 "} {..tkwait vis
0e70: 69 62 69 6c 69 74 79 20 24 74 6f 70 0a 09 75 70 ibility $top..up
0e80: 64 61 74 65 0a 20 20 20 20 7d 0a 20 20 20 20 66 date. }. f
0e90: 6f 63 75 73 20 2d 66 6f 72 63 65 20 24 66 72 61 ocus -force $fra
0ea0: 6d 65 0a 20 20 20 20 42 57 69 64 67 65 74 3a 3a me. BWidget::
0eb0: 67 72 61 62 20 73 65 74 20 24 66 72 61 6d 65 0a grab set $frame.
0ec0: 0a 20 20 20 20 74 6b 77 61 69 74 20 76 61 72 69 . tkwait vari
0ed0: 61 62 6c 65 20 53 65 6c 65 63 74 43 6f 6c 6f 72 able SelectColor
0ee0: 3a 3a 5f 73 65 6c 65 63 74 69 6f 6e 0a 20 20 20 ::_selection.
0ef0: 20 75 70 64 61 74 65 0a 20 20 20 20 42 57 69 64 update. BWid
0f00: 67 65 74 3a 3a 67 72 61 62 20 72 65 6c 65 61 73 get::grab releas
0f10: 65 20 24 66 72 61 6d 65 0a 20 20 20 20 64 65 73 e $frame. des
0f20: 74 72 6f 79 20 24 74 6f 70 0a 20 20 20 20 75 70 troy $top. up
0f30: 64 61 74 65 0a 20 20 20 20 57 69 64 67 65 74 3a date. Widget:
0f40: 3a 64 65 73 74 72 6f 79 20 24 74 6f 70 0a 20 20 :destroy $top.
0f50: 20 20 69 66 20 7b 24 5f 73 65 6c 65 63 74 69 6f if {$_selectio
0f60: 6e 20 3d 3d 20 24 63 6f 75 6e 74 7d 20 7b 0a 20 n == $count} {.
0f70: 20 20 20 20 20 20 20 72 65 74 75 72 6e 20 5b 65 return [e
0f80: 76 61 6c 20 5b 6c 69 73 74 20 64 69 61 6c 6f 67 val [list dialog
0f90: 20 24 70 61 74 68 5d 20 24 61 72 67 73 5d 0a 20 $path] $args].
0fa0: 20 20 20 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 } else {.
0fb0: 20 20 20 20 72 65 74 75 72 6e 20 5b 6c 69 6e 64 return [lind
0fc0: 65 78 20 24 63 6f 6c 6f 72 73 20 24 5f 73 65 6c ex $colors $_sel
0fd0: 65 63 74 69 6f 6e 5d 0a 20 20 20 20 7d 0a 7d 0a ection]. }.}.
0fe0: 0a 0a 70 72 6f 63 20 53 65 6c 65 63 74 43 6f 6c ..proc SelectCol
0ff0: 6f 72 3a 3a 64 69 61 6c 6f 67 20 7b 70 61 74 68 or::dialog {path
1000: 20 61 72 67 73 7d 20 7b 0a 20 20 20 20 76 61 72 args} {. var
1010: 69 61 62 6c 65 20 5f 62 61 73 65 43 6f 6c 6f 72 iable _baseColor
1020: 73 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f s. variable _
1030: 75 73 65 72 43 6f 6c 6f 72 73 0a 20 20 20 20 76 userColors. v
1040: 61 72 69 61 62 6c 65 20 5f 77 69 64 67 65 74 0a ariable _widget.
1050: 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f 73 65 variable _se
1060: 6c 65 63 74 69 6f 6e 0a 20 20 20 20 76 61 72 69 lection. vari
1070: 61 62 6c 65 20 5f 69 6d 61 67 65 0a 20 20 20 20 able _image.
1080: 76 61 72 69 61 62 6c 65 20 5f 68 73 76 0a 0a 20 variable _hsv..
1090: 20 20 20 57 69 64 67 65 74 3a 3a 69 6e 69 74 20 Widget::init
10a0: 53 65 6c 65 63 74 43 6f 6c 6f 72 20 24 70 61 74 SelectColor $pat
10b0: 68 3a 53 65 6c 65 63 74 43 6f 6c 6f 72 20 24 61 h:SelectColor $a
10c0: 72 67 73 0a 20 20 20 20 73 65 74 20 74 6f 70 20 rgs. set top
10d0: 20 20 5b 44 69 61 6c 6f 67 3a 3a 63 72 65 61 74 [Dialog::creat
10e0: 65 20 24 70 61 74 68 20 5c 0a 20 20 20 20 20 20 e $path \.
10f0: 20 20 20 20 20 20 20 20 20 20 20 20 20 2d 74 69 -ti
1100: 74 6c 65 20 20 5b 57 69 64 67 65 74 3a 3a 63 67 tle [Widget::cg
1110: 65 74 20 24 70 61 74 68 3a 53 65 6c 65 63 74 43 et $path:SelectC
1120: 6f 6c 6f 72 20 2d 74 69 74 6c 65 5d 20 20 5c 0a olor -title] \.
1130: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1140: 20 20 20 2d 70 61 72 65 6e 74 20 5b 57 69 64 67 -parent [Widg
1150: 65 74 3a 3a 63 67 65 74 20 24 70 61 74 68 3a 53 et::cget $path:S
1160: 65 6c 65 63 74 43 6f 6c 6f 72 20 2d 70 61 72 65 electColor -pare
1170: 6e 74 5d 20 5c 0a 20 20 20 20 20 20 20 20 20 20 nt] \.
1180: 20 20 20 20 20 20 20 20 20 2d 73 65 70 61 72 61 -separa
1190: 74 6f 72 20 31 20 2d 64 65 66 61 75 6c 74 20 30 tor 1 -default 0
11a0: 20 2d 63 61 6e 63 65 6c 20 31 5d 0a 20 20 20 20 -cancel 1].
11b0: 77 6d 20 72 65 73 69 7a 61 62 6c 65 20 24 74 6f wm resizable $to
11c0: 70 20 30 20 30 0a 20 20 20 20 73 65 74 20 64 6c p 0 0. set dl
11d0: 67 66 20 20 5b 24 74 6f 70 20 67 65 74 66 72 61 gf [$top getfra
11e0: 6d 65 5d 20 20 0a 20 20 20 20 73 65 74 20 66 67 me] . set fg
11f0: 20 20 20 20 5b 66 72 61 6d 65 20 24 64 6c 67 66 [frame $dlgf
1200: 2e 66 67 5d 0a 20 20 20 20 73 65 74 20 64 65 73 .fg]. set des
1210: 63 20 20 5b 6c 69 73 74 20 5c 0a 20 20 20 20 20 c [list \.
1220: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 62 61 ba
1230: 73 65 20 5f 62 61 73 65 43 6f 6c 6f 72 73 20 22 se _baseColors "
1240: 42 61 73 65 20 63 6f 6c 6f 72 73 22 20 5c 0a 20 Base colors" \.
1250: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1260: 20 20 75 73 65 72 20 5f 75 73 65 72 43 6f 6c 6f user _userColo
1270: 72 73 20 22 55 73 65 72 20 63 6f 6c 6f 72 73 22 rs "User colors"
1280: 5d 0a 20 20 20 20 73 65 74 20 63 6f 75 6e 74 20 ]. set count
1290: 30 0a 20 20 20 20 66 6f 72 65 61 63 68 20 7b 74 0. foreach {t
12a0: 79 70 65 20 76 61 72 63 6f 6c 20 64 65 66 54 69 ype varcol defTi
12b0: 74 6c 65 7d 20 24 64 65 73 63 20 7b 0a 20 20 20 tle} $desc {.
12c0: 20 20 20 20 20 73 65 74 20 63 6f 6c 20 20 20 30 set col 0
12d0: 0a 20 20 20 20 20 20 20 20 73 65 74 20 6c 69 6e . set lin
12e0: 20 20 20 30 0a 20 20 20 20 20 20 20 20 73 65 74 0. set
12f0: 20 74 69 74 6c 65 20 5b 6c 69 6e 64 65 78 20 5b title [lindex [
1300: 42 57 69 64 67 65 74 3a 3a 67 65 74 6e 61 6d 65 BWidget::getname
1310: 20 22 24 7b 74 79 70 65 7d 43 6f 6c 6f 72 73 22 "${type}Colors"
1320: 5d 20 30 5d 0a 20 20 20 20 20 20 20 20 69 66 20 ] 0]. if
1330: 7b 21 5b 73 74 72 69 6e 67 20 6c 65 6e 67 74 68 {![string length
1340: 20 24 74 69 74 6c 65 5d 7d 20 7b 0a 20 20 20 20 $title]} {.
1350: 20 20 20 20 20 20 20 20 73 65 74 20 74 69 74 6c set titl
1360: 65 20 24 64 65 66 54 69 74 6c 65 0a 20 20 20 20 e $defTitle.
1370: 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 73 65 }. se
1380: 74 20 74 69 74 66 20 20 5b 54 69 74 6c 65 46 72 t titf [TitleFr
1390: 61 6d 65 20 24 66 67 2e 24 74 79 70 65 20 2d 74 ame $fg.$type -t
13a0: 65 78 74 20 24 74 69 74 6c 65 5d 0a 20 20 20 20 ext $title].
13b0: 20 20 20 20 73 65 74 20 73 75 62 66 20 20 5b 24 set subf [$
13c0: 74 69 74 66 20 67 65 74 66 72 61 6d 65 5d 0a 20 titf getframe].
13d0: 20 20 20 20 20 20 20 66 6f 72 65 61 63 68 20 63 foreach c
13e0: 6f 6c 6f 72 20 5b 73 65 74 20 24 76 61 72 63 6f olor [set $varco
13f0: 6c 5d 20 7b 0a 20 20 20 20 20 20 20 20 20 20 20 l] {.
1400: 20 73 65 74 20 66 72 6f 75 6e 64 20 5b 66 72 61 set fround [fra
1410: 6d 65 20 24 66 67 2e 72 6f 75 6e 64 24 63 6f 75 me $fg.round$cou
1420: 6e 74 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 nt \.
1430: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1440: 20 2d 68 69 67 68 6c 69 67 68 74 74 68 69 63 6b -highlightthick
1450: 6e 65 73 73 20 31 20 5c 0a 20 20 20 20 20 20 20 ness 1 \.
1460: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1470: 20 20 20 20 20 2d 72 65 6c 69 65 66 20 73 75 6e -relief sun
1480: 6b 65 6e 20 2d 62 6f 72 64 65 72 77 69 64 74 68 ken -borderwidth
1490: 20 32 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 2].
14a0: 73 65 74 20 66 63 6f 6c 6f 72 20 5b 66 72 61 6d set fcolor [fram
14b0: 65 20 24 66 67 2e 63 6f 6c 6f 72 24 63 6f 75 6e e $fg.color$coun
14c0: 74 20 2d 77 69 64 74 68 20 31 36 20 2d 68 65 69 t -width 16 -hei
14d0: 67 68 74 20 31 32 20 5c 0a 20 20 20 20 20 20 20 ght 12 \.
14e0: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
14f0: 20 20 20 20 20 2d 68 69 67 68 6c 69 67 68 74 74 -highlightt
1500: 68 69 63 6b 6e 65 73 73 20 30 20 5c 0a 20 20 20 hickness 0 \.
1510: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1520: 20 20 20 20 20 20 20 20 20 2d 72 65 6c 69 65 66 -relief
1530: 20 66 6c 61 74 20 2d 62 6f 72 64 65 72 77 69 64 flat -borderwid
1540: 74 68 20 30 20 5c 0a 20 20 20 20 20 20 20 20 20 th 0 \.
1550: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1560: 20 20 20 2d 62 61 63 6b 67 72 6f 75 6e 64 20 24 -background $
1570: 63 6f 6c 6f 72 5d 0a 20 20 20 20 20 20 20 20 20 color].
1580: 20 20 20 70 61 63 6b 20 24 66 63 6f 6c 6f 72 20 pack $fcolor
1590: 2d 69 6e 20 24 66 72 6f 75 6e 64 0a 20 20 20 20 -in $fround.
15a0: 20 20 20 20 20 20 20 20 67 72 69 64 20 24 66 72 grid $fr
15b0: 6f 75 6e 64 20 2d 69 6e 20 24 73 75 62 66 20 2d ound -in $subf -
15c0: 72 6f 77 20 24 6c 69 6e 20 2d 63 6f 6c 75 6d 6e row $lin -column
15d0: 20 24 63 6f 6c 20 2d 70 61 64 78 20 31 20 2d 70 $col -padx 1 -p
15e0: 61 64 79 20 31 0a 0a 20 20 20 20 20 20 20 20 20 ady 1..
15f0: 20 20 20 62 69 6e 64 20 24 66 72 6f 75 6e 64 20 bind $fround
1600: 3c 42 75 74 74 6f 6e 50 72 65 73 73 2d 31 3e 20 <ButtonPress-1>
1610: 5b 6c 69 73 74 20 53 65 6c 65 63 74 43 6f 6c 6f [list SelectColo
1620: 72 3a 3a 5f 73 65 6c 65 63 74 5f 72 67 62 20 24 r::_select_rgb $
1630: 63 6f 75 6e 74 5d 0a 20 20 20 20 20 20 20 20 20 count].
1640: 20 20 20 62 69 6e 64 20 24 66 63 6f 6c 6f 72 20 bind $fcolor
1650: 3c 42 75 74 74 6f 6e 50 72 65 73 73 2d 31 3e 20 <ButtonPress-1>
1660: 5b 6c 69 73 74 20 53 65 6c 65 63 74 43 6f 6c 6f [list SelectColo
1670: 72 3a 3a 5f 73 65 6c 65 63 74 5f 72 67 62 20 24 r::_select_rgb $
1680: 63 6f 75 6e 74 5d 0a 0a 09 20 20 20 20 62 69 6e count]... bin
1690: 64 20 24 66 72 6f 75 6e 64 20 3c 44 6f 75 62 6c d $fround <Doubl
16a0: 65 2d 31 3e 20 5c 0a 09 20 20 20 20 09 22 53 65 e-1> \.. ."Se
16b0: 6c 65 63 74 43 6f 6c 6f 72 3a 3a 5f 73 65 6c 65 lectColor::_sele
16c0: 63 74 5f 72 67 62 20 5b 6c 69 73 74 20 24 63 6f ct_rgb [list $co
16d0: 75 6e 74 5d 3b 20 5b 6c 69 73 74 20 24 74 6f 70 unt]; [list $top
16e0: 5d 20 69 6e 76 6f 6b 65 20 30 22 0a 09 20 20 20 ] invoke 0"..
16f0: 20 62 69 6e 64 20 24 66 63 6f 6c 6f 72 20 3c 44 bind $fcolor <D
1700: 6f 75 62 6c 65 2d 31 3e 20 5c 0a 09 20 20 20 20 ouble-1> \..
1710: 09 22 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a 5f ."SelectColor::_
1720: 73 65 6c 65 63 74 5f 72 67 62 20 5b 6c 69 73 74 select_rgb [list
1730: 20 24 63 6f 75 6e 74 5d 3b 20 5b 6c 69 73 74 20 $count]; [list
1740: 24 74 6f 70 5d 20 69 6e 76 6f 6b 65 20 30 22 0a $top] invoke 0".
1750: 0a 20 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 . inc
1760: 72 20 63 6f 75 6e 74 0a 20 20 20 20 20 20 20 20 r count.
1770: 20 20 20 20 69 66 20 7b 5b 69 6e 63 72 20 63 6f if {[incr co
1780: 6c 5d 20 3d 3d 20 36 7d 20 7b 0a 20 20 20 20 20 l] == 6} {.
1790: 20 20 20 20 20 20 20 20 20 20 20 69 6e 63 72 20 incr
17a0: 6c 69 6e 0a 20 20 20 20 20 20 20 20 20 20 20 20 lin.
17b0: 20 20 20 20 73 65 74 20 20 63 6f 6c 20 30 0a 20 set col 0.
17c0: 20 20 20 20 20 20 20 20 20 20 20 7d 0a 20 20 20 }.
17d0: 20 20 20 20 20 7d 0a 20 20 20 20 20 20 20 20 70 }. p
17e0: 61 63 6b 20 24 74 69 74 66 20 2d 61 6e 63 68 6f ack $titf -ancho
17f0: 72 20 77 20 2d 70 61 64 79 20 32 0a 20 20 20 20 r w -pady 2.
1800: 7d 0a 20 20 20 20 73 65 74 20 66 72 6f 75 6e 64 }. set fround
1810: 20 5b 66 72 61 6d 65 20 24 66 67 2e 72 6f 75 6e [frame $fg.roun
1820: 64 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 d \.
1830: 20 20 20 20 20 20 20 20 2d 68 69 67 68 6c 69 67 -highlig
1840: 68 74 74 68 69 63 6b 6e 65 73 73 20 30 20 5c 0a htthickness 0 \.
1850: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1860: 20 20 20 20 2d 72 65 6c 69 65 66 20 73 75 6e 6b -relief sunk
1870: 65 6e 20 2d 62 6f 72 64 65 72 77 69 64 74 68 20 en -borderwidth
1880: 32 5d 0a 20 20 20 20 73 65 74 20 66 63 6f 6c 6f 2]. set fcolo
1890: 72 20 5b 66 72 61 6d 65 20 24 66 67 2e 63 6f 6c r [frame $fg.col
18a0: 6f 72 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 or \.
18b0: 20 20 20 20 20 20 20 20 20 2d 77 69 64 74 68 20 -width
18c0: 35 30 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 50 \.
18d0: 20 20 20 20 20 20 20 20 20 2d 68 69 67 68 6c 69 -highli
18e0: 67 68 74 74 68 69 63 6b 6e 65 73 73 20 30 20 5c ghtthickness 0 \
18f0: 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 .
1900: 20 20 20 20 20 2d 72 65 6c 69 65 66 20 66 6c 61 -relief fla
1910: 74 20 2d 62 6f 72 64 65 72 77 69 64 74 68 20 30 t -borderwidth 0
1920: 5d 0a 20 20 20 20 70 61 63 6b 20 24 66 63 6f 6c ]. pack $fcol
1930: 6f 72 20 2d 69 6e 20 24 66 72 6f 75 6e 64 20 2d or -in $fround -
1940: 66 69 6c 6c 20 79 20 2d 65 78 70 61 6e 64 20 79 fill y -expand y
1950: 65 73 0a 20 20 20 20 70 61 63 6b 20 24 66 72 6f es. pack $fro
1960: 75 6e 64 20 2d 61 6e 63 68 6f 72 20 65 20 2d 70 und -anchor e -p
1970: 61 64 79 20 32 20 2d 66 69 6c 6c 20 79 20 2d 65 ady 2 -fill y -e
1980: 78 70 61 6e 64 20 79 65 73 0a 0a 20 20 20 20 73 xpand yes.. s
1990: 65 74 20 66 64 20 20 5b 66 72 61 6d 65 20 24 64 et fd [frame $d
19a0: 6c 67 66 2e 66 64 5d 0a 20 20 20 20 73 65 74 20 lgf.fd]. set
19b0: 66 31 20 20 5b 66 72 61 6d 65 20 24 66 64 2e 66 f1 [frame $fd.f
19c0: 31 20 2d 72 65 6c 69 65 66 20 73 75 6e 6b 65 6e 1 -relief sunken
19d0: 20 2d 62 6f 72 64 65 72 77 69 64 74 68 20 32 5d -borderwidth 2]
19e0: 0a 20 20 20 20 73 65 74 20 66 32 20 20 5b 66 72 . set f2 [fr
19f0: 61 6d 65 20 24 66 64 2e 66 32 20 2d 72 65 6c 69 ame $fd.f2 -reli
1a00: 65 66 20 73 75 6e 6b 65 6e 20 2d 62 6f 72 64 65 ef sunken -borde
1a10: 72 77 69 64 74 68 20 32 5d 0a 20 20 20 20 73 65 rwidth 2]. se
1a20: 74 20 63 31 20 20 5b 63 61 6e 76 61 73 20 24 66 t c1 [canvas $f
1a30: 31 2e 63 20 2d 77 69 64 74 68 20 32 30 30 20 2d 1.c -width 200 -
1a40: 68 65 69 67 68 74 20 32 30 30 20 2d 62 64 20 30 height 200 -bd 0
1a50: 20 2d 68 69 67 68 6c 69 67 68 74 74 68 69 63 6b -highlightthick
1a60: 6e 65 73 73 20 30 5d 0a 20 20 20 20 73 65 74 20 ness 0]. set
1a70: 63 32 20 20 5b 63 61 6e 76 61 73 20 24 66 32 2e c2 [canvas $f2.
1a80: 63 20 2d 77 69 64 74 68 20 31 35 20 20 2d 68 65 c -width 15 -he
1a90: 69 67 68 74 20 32 30 30 20 2d 62 64 20 30 20 2d ight 200 -bd 0 -
1aa0: 68 69 67 68 6c 69 67 68 74 74 68 69 63 6b 6e 65 highlightthickne
1ab0: 73 73 20 30 5d 0a 0a 20 20 20 20 66 6f 72 20 7b ss 0].. for {
1ac0: 73 65 74 20 76 61 6c 20 30 7d 20 7b 24 76 61 6c set val 0} {$val
1ad0: 20 3c 20 34 30 7d 20 7b 69 6e 63 72 20 76 61 6c < 40} {incr val
1ae0: 7d 20 7b 0a 20 20 20 20 20 20 20 20 24 63 32 20 } {. $c2
1af0: 63 72 65 61 74 65 20 72 65 63 74 61 6e 67 6c 65 create rectangle
1b00: 20 30 20 5b 65 78 70 72 20 7b 35 2a 24 76 61 6c 0 [expr {5*$val
1b10: 7d 5d 20 31 35 20 5b 65 78 70 72 20 7b 35 2a 24 }] 15 [expr {5*$
1b20: 76 61 6c 2b 35 7d 5d 20 2d 74 61 67 73 20 76 61 val+5}] -tags va
1b30: 6c 5b 65 78 70 72 20 7b 33 39 2d 24 76 61 6c 7d l[expr {39-$val}
1b40: 5d 0a 20 20 20 20 7d 0a 20 20 20 20 24 63 32 20 ]. }. $c2
1b50: 63 72 65 61 74 65 20 70 6f 6c 79 67 6f 6e 20 30 create polygon 0
1b60: 20 30 20 31 30 20 35 20 30 20 31 30 20 2d 66 69 0 10 5 0 10 -fi
1b70: 6c 6c 20 62 6c 61 63 6b 20 2d 6f 75 74 6c 69 6e ll black -outlin
1b80: 65 20 77 68 69 74 65 20 2d 74 61 67 73 20 74 61 e white -tags ta
1b90: 72 67 65 74 0a 0a 20 20 20 20 70 61 63 6b 20 24 rget.. pack $
1ba0: 63 31 20 24 63 32 0a 20 20 20 20 70 61 63 6b 20 c1 $c2. pack
1bb0: 24 66 31 20 24 66 32 20 2d 73 69 64 65 20 6c 65 $f1 $f2 -side le
1bc0: 66 74 20 2d 70 61 64 78 20 31 30 20 2d 61 6e 63 ft -padx 10 -anc
1bd0: 68 6f 72 20 6e 0a 0a 20 20 20 20 70 61 63 6b 20 hor n.. pack
1be0: 24 66 67 20 24 66 64 20 2d 73 69 64 65 20 6c 65 $fg $fd -side le
1bf0: 66 74 20 2d 61 6e 63 68 6f 72 20 6e 20 2d 66 69 ft -anchor n -fi
1c00: 6c 6c 20 79 0a 0a 20 20 20 20 62 69 6e 64 20 24 ll y.. bind $
1c10: 63 31 20 3c 42 75 74 74 6f 6e 50 72 65 73 73 2d c1 <ButtonPress-
1c20: 31 3e 20 5b 6c 69 73 74 20 53 65 6c 65 63 74 43 1> [list SelectC
1c30: 6f 6c 6f 72 3a 3a 5f 73 65 6c 65 63 74 5f 68 75 olor::_select_hu
1c40: 65 5f 73 61 74 20 25 78 20 25 79 5d 0a 20 20 20 e_sat %x %y].
1c50: 20 62 69 6e 64 20 24 63 31 20 3c 42 31 2d 4d 6f bind $c1 <B1-Mo
1c60: 74 69 6f 6e 3e 20 20 20 20 20 5b 6c 69 73 74 20 tion> [list
1c70: 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a 5f 73 65 SelectColor::_se
1c80: 6c 65 63 74 5f 68 75 65 5f 73 61 74 20 25 78 20 lect_hue_sat %x
1c90: 25 79 5d 0a 0a 20 20 20 20 62 69 6e 64 20 24 63 %y].. bind $c
1ca0: 32 20 3c 42 75 74 74 6f 6e 50 72 65 73 73 2d 31 2 <ButtonPress-1
1cb0: 3e 20 5b 6c 69 73 74 20 53 65 6c 65 63 74 43 6f > [list SelectCo
1cc0: 6c 6f 72 3a 3a 5f 73 65 6c 65 63 74 5f 76 61 6c lor::_select_val
1cd0: 75 65 20 25 78 20 25 79 5d 0a 20 20 20 20 62 69 ue %x %y]. bi
1ce0: 6e 64 20 24 63 32 20 3c 42 31 2d 4d 6f 74 69 6f nd $c2 <B1-Motio
1cf0: 6e 3e 20 20 20 20 20 5b 6c 69 73 74 20 53 65 6c n> [list Sel
1d00: 65 63 74 43 6f 6c 6f 72 3a 3a 5f 73 65 6c 65 63 ectColor::_selec
1d10: 74 5f 76 61 6c 75 65 20 25 78 20 25 79 5d 0a 0a t_value %x %y]..
1d20: 20 20 20 20 69 66 20 7b 21 5b 69 6e 66 6f 20 65 if {![info e
1d30: 78 69 73 74 73 20 5f 69 6d 61 67 65 5d 20 7c 7c xists _image] ||
1d40: 20 5b 63 61 74 63 68 20 7b 69 6d 61 67 65 20 74 [catch {image t
1d50: 79 70 65 20 24 5f 69 6d 61 67 65 7d 5d 7d 20 7b ype $_image}]} {
1d60: 0a 20 20 20 20 20 20 20 20 73 65 74 20 5f 69 6d . set _im
1d70: 61 67 65 20 5b 69 6d 61 67 65 20 63 72 65 61 74 age [image creat
1d80: 65 20 70 68 6f 74 6f 20 2d 77 69 64 74 68 20 32 e photo -width 2
1d90: 30 30 20 2d 68 65 69 67 68 74 20 32 30 30 5d 0a 00 -height 200].
1da0: 20 20 20 20 20 20 20 20 66 6f 72 20 7b 73 65 74 for {set
1db0: 20 78 20 30 7d 20 7b 24 78 20 3c 20 32 30 30 7d x 0} {$x < 200}
1dc0: 20 7b 69 6e 63 72 20 78 20 34 7d 20 7b 0a 20 20 {incr x 4} {.
1dd0: 20 20 20 20 20 20 20 20 20 20 66 6f 72 20 7b 73 for {s
1de0: 65 74 20 79 20 30 7d 20 7b 24 79 20 3c 20 32 30 et y 0} {$y < 20
1df0: 30 7d 20 7b 69 6e 63 72 20 79 20 34 7d 20 7b 0a 0} {incr y 4} {.
1e00: 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20 20
1e10: 24 5f 69 6d 61 67 65 20 70 75 74 20 5c 0a 09 09 $_image put \...
1e20: 20 20 20 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 [eval [list
1e30: 66 6f 72 6d 61 74 20 22 5c 23 25 30 34 78 25 30 format "\#%04x%0
1e40: 34 78 25 30 34 78 22 5d 20 5c 0a 09 09 09 5b 68 4x%04x"] \....[h
1e50: 73 76 54 6f 52 67 62 20 5b 65 78 70 72 20 7b 24 svToRgb [expr {$
1e60: 78 2f 31 39 36 2e 30 7d 5d 20 5b 65 78 70 72 20 x/196.0}] [expr
1e70: 7b 28 31 39 36 2d 24 79 29 2f 31 39 36 2e 30 7d {(196-$y)/196.0}
1e80: 5d 20 30 2e 38 35 5d 5d 20 5c 0a 09 09 09 2d 74 ] 0.85]] \....-t
1e90: 6f 20 24 78 20 24 79 20 5b 65 78 70 72 20 7b 24 o $x $y [expr {$
1ea0: 78 2b 34 7d 5d 20 5b 65 78 70 72 20 7b 24 79 2b x+4}] [expr {$y+
1eb0: 34 7d 5d 0a 20 20 20 20 20 20 20 20 20 20 20 20 4}].
1ec0: 7d 0a 20 20 20 20 20 20 20 20 7d 0a 20 20 20 20 }. }.
1ed0: 7d 0a 20 20 20 20 24 63 31 20 63 72 65 61 74 65 }. $c1 create
1ee0: 20 69 6d 61 67 65 20 20 30 20 30 20 2d 61 6e 63 image 0 0 -anc
1ef0: 68 6f 72 20 6e 77 20 2d 69 6d 61 67 65 20 24 5f hor nw -image $_
1f00: 69 6d 61 67 65 0a 20 20 20 20 24 63 31 20 63 72 image. $c1 cr
1f10: 65 61 74 65 20 62 69 74 6d 61 70 20 30 20 30 20 eate bitmap 0 0
1f20: 5c 0a 20 20 20 20 20 20 20 20 2d 62 69 74 6d 61 \. -bitma
1f30: 70 20 40 5b 66 69 6c 65 20 6a 6f 69 6e 20 24 3a p @[file join $:
1f40: 3a 42 57 49 44 47 45 54 3a 3a 4c 49 42 52 41 52 :BWIDGET::LIBRAR
1f50: 59 20 22 69 6d 61 67 65 73 22 20 22 74 61 72 67 Y "images" "targ
1f60: 65 74 2e 78 62 6d 22 5d 20 5c 0a 20 20 20 20 20 et.xbm"] \.
1f70: 20 20 20 2d 61 6e 63 68 6f 72 20 6e 77 20 2d 74 -anchor nw -t
1f80: 61 67 73 20 74 61 72 67 65 74 0a 0a 20 20 20 20 ags target..
1f90: 73 65 74 20 5f 73 65 6c 65 63 74 69 6f 6e 20 2d set _selection -
1fa0: 31 0a 20 20 20 20 73 65 74 20 5f 77 69 64 67 65 1. set _widge
1fb0: 74 28 66 63 6f 6c 6f 72 29 20 24 66 67 0a 20 20 t(fcolor) $fg.
1fc0: 20 20 73 65 74 20 5f 77 69 64 67 65 74 28 63 68 set _widget(ch
1fd0: 73 29 20 20 20 20 24 63 31 0a 20 20 20 20 73 65 s) $c1. se
1fe0: 74 20 5f 77 69 64 67 65 74 28 63 76 29 20 20 20 t _widget(cv)
1ff0: 20 20 24 63 32 0a 20 20 20 20 73 65 74 20 72 67 $c2. set rg
2000: 62 20 20 20 20 20 20 20 20 20 20 20 20 20 5b 77 b [w
2010: 69 6e 66 6f 20 72 67 62 20 24 70 61 74 68 20 5b info rgb $path [
2020: 57 69 64 67 65 74 3a 3a 63 67 65 74 20 24 70 61 Widget::cget $pa
2030: 74 68 3a 53 65 6c 65 63 74 43 6f 6c 6f 72 20 2d th:SelectColor -
2040: 63 6f 6c 6f 72 5d 5d 0a 20 20 20 20 73 65 74 20 color]]. set
2050: 5f 68 73 76 20 20 20 20 20 20 20 20 20 20 20 20 _hsv
2060: 5b 65 76 61 6c 20 72 67 62 54 6f 48 73 76 20 24 [eval rgbToHsv $
2070: 72 67 62 5d 0a 20 20 20 20 5f 73 65 74 5f 72 67 rgb]. _set_rg
2080: 62 20 20 20 20 20 5b 65 76 61 6c 20 66 6f 72 6d b [eval form
2090: 61 74 20 22 5c 23 25 30 34 78 25 30 34 78 25 30 at "\#%04x%04x%0
20a0: 34 78 22 20 24 72 67 62 5d 0a 20 20 20 20 5f 73 4x" $rgb]. _s
20b0: 65 74 5f 68 75 65 5f 73 61 74 20 5b 6c 69 6e 64 et_hue_sat [lind
20c0: 65 78 20 24 5f 68 73 76 20 30 5d 20 5b 6c 69 6e ex $_hsv 0] [lin
20d0: 64 65 78 20 24 5f 68 73 76 20 31 5d 0a 20 20 20 dex $_hsv 1].
20e0: 20 5f 73 65 74 5f 76 61 6c 75 65 20 20 20 5b 6c _set_value [l
20f0: 69 6e 64 65 78 20 24 5f 68 73 76 20 32 5d 0a 0a index $_hsv 2]..
2100: 20 20 20 20 24 74 6f 70 20 61 64 64 20 2d 6e 61 $top add -na
2110: 6d 65 20 6f 6b 0a 20 20 20 20 24 74 6f 70 20 61 me ok. $top a
2120: 64 64 20 2d 6e 61 6d 65 20 63 61 6e 63 65 6c 0a dd -name cancel.
2130: 20 20 20 20 73 65 74 20 72 65 73 20 5b 24 74 6f set res [$to
2140: 70 20 64 72 61 77 5d 0a 20 20 20 20 69 66 20 7b p draw]. if {
2150: 24 72 65 73 20 3d 3d 20 30 7d 20 7b 0a 20 20 20 $res == 0} {.
2160: 20 20 20 20 20 73 65 74 20 63 6f 6c 6f 72 20 5b set color [
2170: 24 66 67 2e 63 6f 6c 6f 72 20 63 67 65 74 20 2d $fg.color cget -
2180: 62 61 63 6b 67 72 6f 75 6e 64 5d 0a 20 20 20 20 background].
2190: 7d 20 65 6c 73 65 20 7b 0a 20 20 20 20 20 20 20 } else {.
21a0: 20 73 65 74 20 63 6f 6c 6f 72 20 22 22 0a 20 20 set color "".
21b0: 20 20 7d 0a 20 20 20 20 64 65 73 74 72 6f 79 20 }. destroy
21c0: 24 74 6f 70 0a 20 20 20 20 72 65 74 75 72 6e 20 $top. return
21d0: 24 63 6f 6c 6f 72 0a 7d 0a 0a 70 72 6f 63 20 53 $color.}..proc S
21e0: 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a 73 65 74 63 electColor::setc
21f0: 6f 6c 6f 72 20 7b 20 69 64 78 20 63 6f 6c 6f 72 olor { idx color
2200: 20 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c } {. variabl
2210: 65 20 5f 75 73 65 72 43 6f 6c 6f 72 73 0a 20 20 e _userColors.
2220: 20 20 73 65 74 20 5f 75 73 65 72 43 6f 6c 6f 72 set _userColor
2230: 73 20 5b 6c 72 65 70 6c 61 63 65 20 24 5f 75 73 s [lreplace $_us
2240: 65 72 43 6f 6c 6f 72 73 20 24 69 64 78 20 24 69 erColors $idx $i
2250: 64 78 20 24 63 6f 6c 6f 72 5d 0a 7d 0a 0a 70 72 dx $color].}..pr
2260: 6f 63 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a 3a oc SelectColor::
2270: 5f 73 65 6c 65 63 74 5f 72 67 62 20 7b 63 6f 75 _select_rgb {cou
2280: 6e 74 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 62 nt} {. variab
2290: 6c 65 20 5f 62 61 73 65 43 6f 6c 6f 72 73 0a 20 le _baseColors.
22a0: 20 20 20 76 61 72 69 61 62 6c 65 20 5f 75 73 65 variable _use
22b0: 72 43 6f 6c 6f 72 73 0a 20 20 20 20 76 61 72 69 rColors. vari
22c0: 61 62 6c 65 20 5f 73 65 6c 65 63 74 69 6f 6e 0a able _selection.
22d0: 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f 77 69 variable _wi
22e0: 64 67 65 74 0a 20 20 20 20 76 61 72 69 61 62 6c dget. variabl
22f0: 65 20 5f 68 73 76 0a 0a 20 20 20 20 73 65 74 20 e _hsv.. set
2300: 66 72 61 6d 65 20 24 5f 77 69 64 67 65 74 28 66 frame $_widget(f
2310: 63 6f 6c 6f 72 29 0a 20 20 20 20 69 66 20 7b 24 color). if {$
2320: 5f 73 65 6c 65 63 74 69 6f 6e 20 3e 3d 20 30 7d _selection >= 0}
2330: 20 7b 0a 20 20 20 20 20 20 20 20 24 66 72 61 6d {. $fram
2340: 65 2e 72 6f 75 6e 64 24 5f 73 65 6c 65 63 74 69 e.round$_selecti
2350: 6f 6e 20 63 6f 6e 66 69 67 75 72 65 20 5c 0a 20 on configure \.
2360: 20 20 20 20 20 20 20 20 20 20 20 2d 72 65 6c 69 -reli
2370: 65 66 20 73 75 6e 6b 65 6e 20 2d 68 69 67 68 6c ef sunken -highl
2380: 69 67 68 74 74 68 69 63 6b 6e 65 73 73 20 31 20 ightthickness 1
2390: 2d 62 6f 72 64 65 72 77 69 64 74 68 20 32 0a 20 -borderwidth 2.
23a0: 20 20 20 7d 0a 20 20 20 20 24 66 72 61 6d 65 2e }. $frame.
23b0: 72 6f 75 6e 64 24 63 6f 75 6e 74 20 63 6f 6e 66 round$count conf
23c0: 69 67 75 72 65 20 5c 0a 20 20 20 20 20 20 20 20 igure \.
23d0: 2d 72 65 6c 69 65 66 20 66 6c 61 74 20 2d 68 69 -relief flat -hi
23e0: 67 68 6c 69 67 68 74 74 68 69 63 6b 6e 65 73 73 ghlightthickness
23f0: 20 32 20 2d 62 6f 72 64 65 72 77 69 64 74 68 20 2 -borderwidth
2400: 31 0a 20 20 20 20 66 6f 63 75 73 20 24 66 72 61 1. focus $fra
2410: 6d 65 2e 72 6f 75 6e 64 24 63 6f 75 6e 74 0a 20 me.round$count.
2420: 20 20 20 73 65 74 20 5f 73 65 6c 65 63 74 69 6f set _selectio
2430: 6e 20 24 63 6f 75 6e 74 0a 20 20 20 20 73 65 74 n $count. set
2440: 20 62 67 20 20 20 5b 24 66 72 61 6d 65 2e 63 6f bg [$frame.co
2450: 6c 6f 72 24 63 6f 75 6e 74 20 63 67 65 74 20 2d lor$count cget -
2460: 62 61 63 6b 67 72 6f 75 6e 64 5d 0a 20 20 20 20 background].
2470: 73 65 74 20 75 73 65 72 20 5b 65 78 70 72 20 7b set user [expr {
2480: 24 5f 73 65 6c 65 63 74 69 6f 6e 2d 5b 6c 6c 65 $_selection-[lle
2490: 6e 67 74 68 20 24 5f 62 61 73 65 43 6f 6c 6f 72 ngth $_baseColor
24a0: 73 5d 7d 5d 0a 20 20 20 20 69 66 20 7b 24 75 73 s]}]. if {$us
24b0: 65 72 20 3e 3d 20 30 20 26 26 0a 20 20 20 20 20 er >= 0 &&.
24c0: 20 20 20 5b 73 74 72 69 6e 67 20 65 71 75 61 6c [string equal
24d0: 20 5c 0a 20 20 20 20 20 20 20 20 20 20 20 20 20 \.
24e0: 20 5b 77 69 6e 66 6f 20 72 67 62 20 24 66 72 61 [winfo rgb $fra
24f0: 6d 65 2e 63 6f 6c 6f 72 24 5f 73 65 6c 65 63 74 me.color$_select
2500: 69 6f 6e 20 24 62 67 5d 20 5c 0a 20 20 20 20 20 ion $bg] \.
2510: 20 20 20 20 20 20 20 20 20 5b 77 69 6e 66 6f 20 [winfo
2520: 72 67 62 20 24 66 72 61 6d 65 2e 63 6f 6c 6f 72 rgb $frame.color
2530: 24 5f 73 65 6c 65 63 74 69 6f 6e 20 77 68 69 74 $_selection whit
2540: 65 5d 5d 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 e]]} {. s
2550: 65 74 20 62 67 20 5b 24 66 72 61 6d 65 2e 63 6f et bg [$frame.co
2560: 6c 6f 72 20 63 67 65 74 20 2d 62 67 5d 0a 20 20 lor cget -bg].
2570: 20 20 20 20 20 20 24 66 72 61 6d 65 2e 63 6f 6c $frame.col
2580: 6f 72 24 5f 73 65 6c 65 63 74 69 6f 6e 20 63 6f or$_selection co
2590: 6e 66 69 67 75 72 65 20 2d 62 61 63 6b 67 72 6f nfigure -backgro
25a0: 75 6e 64 20 24 62 67 0a 20 20 20 20 20 20 20 20 und $bg.
25b0: 73 65 74 20 5f 75 73 65 72 43 6f 6c 6f 72 73 20 set _userColors
25c0: 5b 6c 72 65 70 6c 61 63 65 20 24 5f 75 73 65 72 [lreplace $_user
25d0: 43 6f 6c 6f 72 73 20 24 75 73 65 72 20 24 75 73 Colors $user $us
25e0: 65 72 20 24 62 67 5d 0a 20 20 20 20 7d 20 65 6c er $bg]. } el
25f0: 73 65 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 se {. set
2600: 20 5f 68 73 76 20 5b 65 76 61 6c 20 72 67 62 54 _hsv [eval rgbT
2610: 6f 48 73 76 20 5b 77 69 6e 66 6f 20 72 67 62 20 oHsv [winfo rgb
2620: 24 66 72 61 6d 65 2e 63 6f 6c 6f 72 24 63 6f 75 $frame.color$cou
2630: 6e 74 20 24 62 67 5d 5d 0a 20 20 20 20 20 20 20 nt $bg]].
2640: 20 5f 73 65 74 5f 68 75 65 5f 73 61 74 20 5b 6c _set_hue_sat [l
2650: 69 6e 64 65 78 20 24 5f 68 73 76 20 30 5d 20 5b index $_hsv 0] [
2660: 6c 69 6e 64 65 78 20 24 5f 68 73 76 20 31 5d 0a lindex $_hsv 1].
2670: 20 20 20 20 20 20 20 20 5f 73 65 74 5f 76 61 6c _set_val
2680: 75 65 20 20 20 5b 6c 69 6e 64 65 78 20 24 5f 68 ue [lindex $_h
2690: 73 76 20 32 5d 0a 20 20 20 20 20 20 20 20 24 66 sv 2]. $f
26a0: 72 61 6d 65 2e 63 6f 6c 6f 72 20 63 6f 6e 66 69 rame.color confi
26b0: 67 75 72 65 20 2d 62 61 63 6b 67 72 6f 75 6e 64 gure -background
26c0: 20 24 62 67 0a 20 20 20 20 7d 0a 7d 0a 0a 0a 70 $bg. }.}...p
26d0: 72 6f 63 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a roc SelectColor:
26e0: 3a 5f 73 65 74 5f 72 67 62 20 7b 72 67 62 7d 20 :_set_rgb {rgb}
26f0: 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f {. variable _
2700: 73 65 6c 65 63 74 69 6f 6e 0a 20 20 20 20 76 61 selection. va
2710: 72 69 61 62 6c 65 20 5f 62 61 73 65 43 6f 6c 6f riable _baseColo
2720: 72 73 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 rs. variable
2730: 5f 75 73 65 72 43 6f 6c 6f 72 73 0a 20 20 20 20 _userColors.
2740: 76 61 72 69 61 62 6c 65 20 5f 77 69 64 67 65 74 variable _widget
2750: 0a 0a 20 20 20 20 73 65 74 20 66 72 61 6d 65 20 .. set frame
2760: 24 5f 77 69 64 67 65 74 28 66 63 6f 6c 6f 72 29 $_widget(fcolor)
2770: 0a 20 20 20 20 24 66 72 61 6d 65 2e 63 6f 6c 6f . $frame.colo
2780: 72 20 63 6f 6e 66 69 67 75 72 65 20 2d 62 61 63 r configure -bac
2790: 6b 67 72 6f 75 6e 64 20 24 72 67 62 0a 20 20 20 kground $rgb.
27a0: 20 73 65 74 20 75 73 65 72 20 5b 65 78 70 72 20 set user [expr
27b0: 7b 24 5f 73 65 6c 65 63 74 69 6f 6e 2d 5b 6c 6c {$_selection-[ll
27c0: 65 6e 67 74 68 20 24 5f 62 61 73 65 43 6f 6c 6f ength $_baseColo
27d0: 72 73 5d 7d 5d 0a 20 20 20 20 69 66 20 7b 24 75 rs]}]. if {$u
27e0: 73 65 72 20 3e 3d 20 30 7d 20 7b 0a 20 20 20 20 ser >= 0} {.
27f0: 20 20 20 20 24 66 72 61 6d 65 2e 63 6f 6c 6f 72 $frame.color
2800: 24 5f 73 65 6c 65 63 74 69 6f 6e 20 63 6f 6e 66 $_selection conf
2810: 69 67 75 72 65 20 2d 62 61 63 6b 67 72 6f 75 6e igure -backgroun
2820: 64 20 24 72 67 62 0a 20 20 20 20 20 20 20 20 73 d $rgb. s
2830: 65 74 20 5f 75 73 65 72 43 6f 6c 6f 72 73 20 5b et _userColors [
2840: 6c 72 65 70 6c 61 63 65 20 24 5f 75 73 65 72 43 lreplace $_userC
2850: 6f 6c 6f 72 73 20 24 75 73 65 72 20 24 75 73 65 olors $user $use
2860: 72 20 24 72 67 62 5d 0a 20 20 20 20 7d 0a 7d 0a r $rgb]. }.}.
2870: 0a 0a 70 72 6f 63 20 53 65 6c 65 63 74 43 6f 6c ..proc SelectCol
2880: 6f 72 3a 3a 5f 73 65 6c 65 63 74 5f 68 75 65 5f or::_select_hue_
2890: 73 61 74 20 7b 78 20 79 7d 20 7b 0a 20 20 20 20 sat {x y} {.
28a0: 76 61 72 69 61 62 6c 65 20 5f 77 69 64 67 65 74 variable _widget
28b0: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f 68 . variable _h
28c0: 73 76 0a 0a 20 20 20 20 69 66 20 7b 24 78 20 3c sv.. if {$x <
28d0: 20 30 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 0} {. se
28e0: 74 20 78 20 30 0a 20 20 20 20 7d 20 65 6c 73 65 t x 0. } else
28f0: 69 66 20 7b 24 78 20 3e 20 32 30 30 7d 20 7b 0a if {$x > 200} {.
2900: 20 20 20 20 20 20 20 20 73 65 74 20 78 20 32 30 set x 20
2910: 30 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 0. }. if {
2920: 24 79 20 3c 20 30 20 7d 20 7b 0a 20 20 20 20 20 $y < 0 } {.
2930: 20 20 20 73 65 74 20 79 20 30 0a 20 20 20 20 7d set y 0. }
2940: 20 65 6c 73 65 69 66 20 7b 24 79 20 3e 20 32 30 elseif {$y > 20
2950: 30 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 0} {. set
2960: 20 79 20 32 30 30 0a 20 20 20 20 7d 0a 20 20 20 y 200. }.
2970: 20 73 65 74 20 68 75 65 20 20 5b 65 78 70 72 20 set hue [expr
2980: 7b 24 78 2f 32 30 30 2e 30 7d 5d 0a 20 20 20 20 {$x/200.0}].
2990: 73 65 74 20 73 61 74 20 20 5b 65 78 70 72 20 7b set sat [expr {
29a0: 28 32 30 30 2d 24 79 29 2f 32 30 30 2e 30 7d 5d (200-$y)/200.0}]
29b0: 0a 20 20 20 20 73 65 74 20 5f 68 73 76 20 5b 6c . set _hsv [l
29c0: 72 65 70 6c 61 63 65 20 24 5f 68 73 76 20 30 20 replace $_hsv 0
29d0: 31 20 24 68 75 65 20 24 73 61 74 5d 0a 20 20 20 1 $hue $sat].
29e0: 20 24 5f 77 69 64 67 65 74 28 63 68 73 29 20 63 $_widget(chs) c
29f0: 6f 6f 72 64 73 20 74 61 72 67 65 74 20 5b 65 78 oords target [ex
2a00: 70 72 20 7b 24 78 2d 39 7d 5d 20 5b 65 78 70 72 pr {$x-9}] [expr
2a10: 20 7b 24 79 2d 39 7d 5d 0a 20 20 20 20 5f 64 72 {$y-9}]. _dr
2a20: 61 77 5f 76 61 6c 75 65 73 20 24 68 75 65 20 24 aw_values $hue $
2a30: 73 61 74 0a 20 20 20 20 5f 73 65 74 5f 72 67 62 sat. _set_rgb
2a40: 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 66 6f 72 [eval [list for
2a50: 6d 61 74 20 22 5c 23 25 30 34 78 25 30 34 78 25 mat "\#%04x%04x%
2a60: 30 34 78 22 5d 20 5b 65 76 61 6c 20 5b 6c 69 73 04x"] [eval [lis
2a70: 74 20 68 73 76 54 6f 52 67 62 5d 20 24 5f 68 73 t hsvToRgb] $_hs
2a80: 76 5d 5d 0a 7d 0a 0a 0a 70 72 6f 63 20 53 65 6c v]].}...proc Sel
2a90: 65 63 74 43 6f 6c 6f 72 3a 3a 5f 73 65 74 5f 68 ectColor::_set_h
2aa0: 75 65 5f 73 61 74 20 7b 68 75 65 20 73 61 74 7d ue_sat {hue sat}
2ab0: 20 7b 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 {. variable
2ac0: 5f 77 69 64 67 65 74 0a 0a 20 20 20 20 73 65 74 _widget.. set
2ad0: 20 78 20 5b 65 78 70 72 20 7b 24 68 75 65 2a 32 x [expr {$hue*2
2ae0: 30 30 2d 39 7d 5d 0a 20 20 20 20 73 65 74 20 79 00-9}]. set y
2af0: 20 5b 65 78 70 72 20 7b 28 31 2d 24 73 61 74 29 [expr {(1-$sat)
2b00: 2a 32 30 30 2d 39 7d 5d 0a 20 20 20 20 24 5f 77 *200-9}]. $_w
2b10: 69 64 67 65 74 28 63 68 73 29 20 63 6f 6f 72 64 idget(chs) coord
2b20: 73 20 74 61 72 67 65 74 20 24 78 20 24 79 0a 20 s target $x $y.
2b30: 20 20 20 5f 64 72 61 77 5f 76 61 6c 75 65 73 20 _draw_values
2b40: 24 68 75 65 20 24 73 61 74 0a 7d 0a 0a 0a 0a 70 $hue $sat.}....p
2b50: 72 6f 63 20 53 65 6c 65 63 74 43 6f 6c 6f 72 3a roc SelectColor:
2b60: 3a 5f 73 65 6c 65 63 74 5f 76 61 6c 75 65 20 7b :_select_value {
2b70: 78 20 79 7d 20 7b 0a 20 20 20 20 76 61 72 69 61 x y} {. varia
2b80: 62 6c 65 20 5f 77 69 64 67 65 74 0a 20 20 20 20 ble _widget.
2b90: 76 61 72 69 61 62 6c 65 20 5f 68 73 76 0a 0a 20 variable _hsv..
2ba0: 20 20 20 69 66 20 7b 24 79 20 3c 20 30 7d 20 7b if {$y < 0} {
2bb0: 0a 20 20 20 20 20 20 20 20 73 65 74 20 79 20 30 . set y 0
2bc0: 0a 20 20 20 20 7d 20 65 6c 73 65 69 66 20 7b 24 . } elseif {$
2bd0: 79 20 3e 20 32 30 30 7d 20 7b 0a 20 20 20 20 20 y > 200} {.
2be0: 20 20 20 73 65 74 20 79 20 32 30 30 0a 20 20 20 set y 200.
2bf0: 20 7d 0a 20 20 20 20 24 5f 77 69 64 67 65 74 28 }. $_widget(
2c00: 63 76 29 20 63 6f 6f 72 64 73 20 74 61 72 67 65 cv) coords targe
2c10: 74 20 30 20 5b 65 78 70 72 20 7b 24 79 2d 35 7d t 0 [expr {$y-5}
2c20: 5d 20 31 30 20 24 79 20 30 20 5b 65 78 70 72 20 ] 10 $y 0 [expr
2c30: 7b 24 79 2b 35 7d 5d 0a 20 20 20 20 73 65 74 20 {$y+5}]. set
2c40: 5f 68 73 76 20 5b 6c 72 65 70 6c 61 63 65 20 24 _hsv [lreplace $
2c50: 5f 68 73 76 20 32 20 32 20 5b 65 78 70 72 20 7b _hsv 2 2 [expr {
2c60: 28 32 30 30 2d 24 79 29 2f 32 30 30 2e 30 7d 5d (200-$y)/200.0}]
2c70: 5d 0a 20 20 20 20 5f 73 65 74 5f 72 67 62 20 5b ]. _set_rgb [
2c80: 65 76 61 6c 20 5b 6c 69 73 74 20 66 6f 72 6d 61 eval [list forma
2c90: 74 20 22 5c 23 25 30 34 78 25 30 34 78 25 30 34 t "\#%04x%04x%04
2ca0: 78 22 5d 20 5b 65 76 61 6c 20 5b 6c 69 73 74 20 x"] [eval [list
2cb0: 68 73 76 54 6f 52 67 62 5d 20 24 5f 68 73 76 5d hsvToRgb] $_hsv]
2cc0: 5d 0a 7d 0a 0a 0a 70 72 6f 63 20 53 65 6c 65 63 ].}...proc Selec
2cd0: 74 43 6f 6c 6f 72 3a 3a 5f 64 72 61 77 5f 76 61 tColor::_draw_va
2ce0: 6c 75 65 73 20 7b 68 75 65 20 73 61 74 7d 20 7b lues {hue sat} {
2cf0: 0a 20 20 20 20 76 61 72 69 61 62 6c 65 20 5f 77 . variable _w
2d00: 69 64 67 65 74 0a 0a 20 20 20 20 66 6f 72 20 7b idget.. for {
2d10: 73 65 74 20 76 61 6c 20 30 7d 20 7b 24 76 61 6c set val 0} {$val
2d20: 20 3c 20 34 30 7d 20 7b 69 6e 63 72 20 76 61 6c < 40} {incr val
2d30: 7d 20 7b 0a 20 20 20 20 20 20 20 20 73 65 74 20 } {. set
2d40: 6c 20 20 20 5b 68 73 76 54 6f 52 67 62 20 24 68 l [hsvToRgb $h
2d50: 75 65 20 24 73 61 74 20 5b 65 78 70 72 20 7b 24 ue $sat [expr {$
2d60: 76 61 6c 2f 33 39 2e 30 7d 5d 5d 0a 20 20 20 20 val/39.0}]].
2d70: 20 20 20 20 73 65 74 20 63 6f 6c 20 5b 65 76 61 set col [eva
2d80: 6c 20 5b 6c 69 73 74 20 66 6f 72 6d 61 74 20 22 l [list format "
2d90: 5c 23 25 30 34 78 25 30 34 78 25 30 34 78 22 5d \#%04x%04x%04x"]
2da0: 20 24 6c 5d 0a 20 20 20 20 20 20 20 20 24 5f 77 $l]. $_w
2db0: 69 64 67 65 74 28 63 76 29 20 69 74 65 6d 63 6f idget(cv) itemco
2dc0: 6e 66 69 67 75 72 65 20 76 61 6c 24 76 61 6c 20 nfigure val$val
2dd0: 2d 66 69 6c 6c 20 24 63 6f 6c 20 2d 6f 75 74 6c -fill $col -outl
2de0: 69 6e 65 20 24 63 6f 6c 0a 20 20 20 20 7d 0a 7d ine $col. }.}
2df0: 0a 0a 0a 70 72 6f 63 20 53 65 6c 65 63 74 43 6f ...proc SelectCo
2e00: 6c 6f 72 3a 3a 5f 73 65 74 5f 76 61 6c 75 65 20 lor::_set_value
2e10: 7b 76 61 6c 75 65 7d 20 7b 0a 20 20 20 20 76 61 {value} {. va
2e20: 72 69 61 62 6c 65 20 5f 77 69 64 67 65 74 0a 0a riable _widget..
2e30: 20 20 20 20 73 65 74 20 79 20 5b 65 78 70 72 20 set y [expr
2e40: 7b 69 6e 74 28 28 31 2d 24 76 61 6c 75 65 29 2a {int((1-$value)*
2e50: 32 30 30 29 7d 5d 0a 20 20 20 20 24 5f 77 69 64 200)}]. $_wid
2e60: 67 65 74 28 63 76 29 20 63 6f 6f 72 64 73 20 74 get(cv) coords t
2e70: 61 72 67 65 74 20 30 20 5b 65 78 70 72 20 7b 24 arget 0 [expr {$
2e80: 79 2d 35 7d 5d 20 31 30 20 24 79 20 30 20 5b 65 y-5}] 10 $y 0 [e
2e90: 78 70 72 20 7b 24 79 2b 35 7d 5d 0a 7d 0a 0a 0a xpr {$y+5}].}...
2ea0: 23 20 2d 2d 0a 23 20 20 54 61 6b 65 6e 20 66 72 # --.# Taken fr
2eb0: 6f 6d 20 74 6b 38 2e 30 2f 64 65 6d 6f 73 2f 74 om tk8.0/demos/t
2ec0: 63 6f 6c 6f 72 2e 74 63 6c 0a 23 20 2d 2d 0a 23 color.tcl.# --.#
2ed0: 20 54 68 65 20 70 72 6f 63 65 64 75 72 65 20 62 The procedure b
2ee0: 65 6c 6f 77 20 63 6f 6e 76 65 72 74 73 20 61 6e elow converts an
2ef0: 20 48 53 42 20 76 61 6c 75 65 20 74 6f 20 52 47 HSB value to RG
2f00: 42 2e 20 20 49 74 20 74 61 6b 65 73 20 68 75 65 B. It takes hue
2f10: 2c 20 73 61 74 75 72 61 74 69 6f 6e 2c 0a 23 20 , saturation,.#
2f20: 61 6e 64 20 76 61 6c 75 65 20 63 6f 6d 70 6f 6e and value compon
2f30: 65 6e 74 73 20 28 66 6c 6f 61 74 69 6e 67 2d 70 ents (floating-p
2f40: 6f 69 6e 74 2c 20 30 2d 31 2e 30 29 20 61 73 20 oint, 0-1.0) as
2f50: 61 72 67 75 6d 65 6e 74 73 2c 20 61 6e 64 20 72 arguments, and r
2f60: 65 74 75 72 6e 73 20 61 0a 23 20 6c 69 73 74 20 eturns a.# list
2f70: 63 6f 6e 74 61 69 6e 69 6e 67 20 52 47 42 20 63 containing RGB c
2f80: 6f 6d 70 6f 6e 65 6e 74 73 20 28 69 6e 74 65 67 omponents (integ
2f90: 65 72 73 2c 20 30 2d 36 35 35 33 35 29 20 61 73 ers, 0-65535) as
2fa0: 20 72 65 73 75 6c 74 2e 20 20 54 68 65 20 63 6f result. The co
2fb0: 64 65 0a 23 20 68 65 72 65 20 69 73 20 61 20 63 de.# here is a c
2fc0: 6f 70 79 20 6f 66 20 74 68 65 20 63 6f 64 65 20 opy of the code
2fd0: 6f 6e 20 70 61 67 65 20 36 31 36 20 6f 66 20 22 on page 616 of "
2fe0: 46 75 6e 64 61 6d 65 6e 74 61 6c 73 20 6f 66 20 Fundamentals of
2ff0: 49 6e 74 65 72 61 63 74 69 76 65 0a 23 20 43 6f Interactive.# Co
3000: 6d 70 75 74 65 72 20 47 72 61 70 68 69 63 73 22 mputer Graphics"
3010: 20 62 79 20 46 6f 6c 65 79 20 61 6e 64 20 56 61 by Foley and Va
3020: 6e 20 44 61 6d 2e 0a 0a 70 72 6f 63 20 53 65 6c n Dam...proc Sel
3030: 65 63 74 43 6f 6c 6f 72 3a 3a 68 73 76 54 6f 52 ectColor::hsvToR
3040: 67 62 20 7b 68 75 65 20 73 61 74 20 76 61 6c 7d gb {hue sat val}
3050: 20 7b 0a 20 20 20 20 73 65 74 20 76 20 5b 65 78 {. set v [ex
3060: 70 72 20 7b 72 6f 75 6e 64 28 36 35 35 33 35 2e pr {round(65535.
3070: 30 2a 24 76 61 6c 29 7d 5d 0a 20 20 20 20 69 66 0*$val)}]. if
3080: 20 7b 24 73 61 74 20 3d 3d 20 30 7d 20 7b 0a 09 {$sat == 0} {..
3090: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 76 20 return [list $v
30a0: 24 76 20 24 76 5d 0a 20 20 20 20 7d 20 65 6c 73 $v $v]. } els
30b0: 65 20 7b 0a 09 73 65 74 20 68 75 65 20 5b 65 78 e {..set hue [ex
30c0: 70 72 20 7b 24 68 75 65 2a 36 2e 30 7d 5d 0a 09 pr {$hue*6.0}]..
30d0: 69 66 20 7b 24 68 75 65 20 3e 3d 20 36 2e 30 7d if {$hue >= 6.0}
30e0: 20 7b 0a 09 20 20 20 20 73 65 74 20 68 75 65 20 {.. set hue
30f0: 30 2e 30 0a 09 7d 0a 09 73 65 74 20 69 20 5b 65 0.0..}..set i [e
3100: 78 70 72 20 7b 69 6e 74 28 24 68 75 65 29 7d 5d xpr {int($hue)}]
3110: 0a 09 73 65 74 20 66 20 5b 65 78 70 72 20 7b 24 ..set f [expr {$
3120: 68 75 65 2d 24 69 7d 5d 0a 09 73 65 74 20 70 20 hue-$i}]..set p
3130: 5b 65 78 70 72 20 7b 72 6f 75 6e 64 28 36 35 35 [expr {round(655
3140: 33 35 2e 30 2a 24 76 61 6c 2a 28 31 20 2d 20 24 35.0*$val*(1 - $
3150: 73 61 74 29 29 7d 5d 0a 20 20 20 20 20 20 20 20 sat))}].
3160: 73 65 74 20 71 20 5b 65 78 70 72 20 7b 72 6f 75 set q [expr {rou
3170: 6e 64 28 36 35 35 33 35 2e 30 2a 24 76 61 6c 2a nd(65535.0*$val*
3180: 28 31 20 2d 20 28 24 73 61 74 2a 24 66 29 29 29 (1 - ($sat*$f)))
3190: 7d 5d 0a 20 20 20 20 20 20 20 20 73 65 74 20 74 }]. set t
31a0: 20 5b 65 78 70 72 20 7b 72 6f 75 6e 64 28 36 35 [expr {round(65
31b0: 35 33 35 2e 30 2a 24 76 61 6c 2a 28 31 20 2d 20 535.0*$val*(1 -
31c0: 28 24 73 61 74 2a 28 31 20 2d 20 24 66 29 29 29 ($sat*(1 - $f)))
31d0: 29 7d 5d 0a 20 20 20 20 20 20 20 20 73 77 69 74 )}]. swit
31e0: 63 68 20 24 69 20 7b 0a 09 20 20 20 20 30 20 7b ch $i {.. 0 {
31f0: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 76 20 return [list $v
3200: 24 74 20 24 70 5d 7d 0a 09 20 20 20 20 31 20 7b $t $p]}.. 1 {
3210: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 71 20 return [list $q
3220: 24 76 20 24 70 5d 7d 0a 09 20 20 20 20 32 20 7b $v $p]}.. 2 {
3230: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 70 20 return [list $p
3240: 24 76 20 24 74 5d 7d 0a 09 20 20 20 20 33 20 7b $v $t]}.. 3 {
3250: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 70 20 return [list $p
3260: 24 71 20 24 76 5d 7d 0a 09 20 20 20 20 34 20 7b $q $v]}.. 4 {
3270: 72 65 74 75 72 6e 20 5b 6c 69 73 74 20 24 74 20 return [list $t
3280: 24 70 20 24 76 5d 7d 0a 20 20 20 20 20 20 20 20 $p $v]}.
3290: 20 20 20 20 35 20 7b 72 65 74 75 72 6e 20 5b 6c 5 {return [l
32a0: 69 73 74 20 24 76 20 24 70 20 24 71 5d 7d 0a 20 ist $v $p $q]}.
32b0: 20 20 20 20 20 20 20 7d 0a 20 20 20 20 7d 0a 7d }. }.}
32c0: 0a 0a 0a 23 20 2d 2d 0a 23 20 20 54 61 6b 65 6e ...# --.# Taken
32d0: 20 66 72 6f 6d 20 74 6b 38 2e 30 2f 64 65 6d 6f from tk8.0/demo
32e0: 73 2f 74 63 6f 6c 6f 72 2e 74 63 6c 0a 23 20 2d s/tcolor.tcl.# -
32f0: 2d 0a 23 20 54 68 65 20 70 72 6f 63 65 64 75 72 -.# The procedur
3300: 65 20 62 65 6c 6f 77 20 63 6f 6e 76 65 72 74 73 e below converts
3310: 20 61 6e 20 52 47 42 20 76 61 6c 75 65 20 74 6f an RGB value to
3320: 20 48 53 42 2e 20 20 49 74 20 74 61 6b 65 73 20 HSB. It takes
3330: 72 65 64 2c 20 67 72 65 65 6e 2c 0a 23 20 61 6e red, green,.# an
3340: 64 20 62 6c 75 65 20 63 6f 6d 70 6f 6e 65 6e 74 d blue component
3350: 73 20 28 30 2d 36 35 35 33 35 29 20 61 73 20 61 s (0-65535) as a
3360: 72 67 75 6d 65 6e 74 73 2c 20 61 6e 64 20 72 65 rguments, and re
3370: 74 75 72 6e 73 20 61 20 6c 69 73 74 20 63 6f 6e turns a list con
3380: 74 61 69 6e 69 6e 67 0a 23 20 48 53 42 20 63 6f taining.# HSB co
3390: 6d 70 6f 6e 65 6e 74 73 20 28 66 6c 6f 61 74 69 mponents (floati
33a0: 6e 67 2d 70 6f 69 6e 74 2c 20 30 2d 31 29 20 61 ng-point, 0-1) a
33b0: 73 20 72 65 73 75 6c 74 2e 20 20 54 68 65 20 63 s result. The c
33c0: 6f 64 65 20 68 65 72 65 20 69 73 20 61 20 63 6f ode here is a co
33d0: 70 79 0a 23 20 6f 66 20 74 68 65 20 63 6f 64 65 py.# of the code
33e0: 20 6f 6e 20 70 61 67 65 20 36 31 35 20 6f 66 20 on page 615 of
33f0: 22 46 75 6e 64 61 6d 65 6e 74 61 6c 73 20 6f 66 "Fundamentals of
3400: 20 49 6e 74 65 72 61 63 74 69 76 65 20 43 6f 6d Interactive Com
3410: 70 75 74 65 72 20 47 72 61 70 68 69 63 73 22 0a puter Graphics".
3420: 23 20 62 79 20 46 6f 6c 65 79 20 61 6e 64 20 56 # by Foley and V
3430: 61 6e 20 44 61 6d 2e 0a 0a 70 72 6f 63 20 53 65 an Dam...proc Se
3440: 6c 65 63 74 43 6f 6c 6f 72 3a 3a 72 67 62 54 6f lectColor::rgbTo
3450: 48 73 76 20 7b 72 65 64 20 67 72 65 65 6e 20 62 Hsv {red green b
3460: 6c 75 65 7d 20 7b 0a 20 20 20 20 69 66 20 7b 24 lue} {. if {$
3470: 72 65 64 20 3e 20 24 67 72 65 65 6e 7d 20 7b 0a red > $green} {.
3480: 09 73 65 74 20 6d 61 78 20 24 72 65 64 2e 30 0a .set max $red.0.
3490: 09 73 65 74 20 6d 69 6e 20 24 67 72 65 65 6e 2e .set min $green.
34a0: 30 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 0. } else {..
34b0: 73 65 74 20 6d 61 78 20 24 67 72 65 65 6e 2e 30 set max $green.0
34c0: 0a 09 73 65 74 20 6d 69 6e 20 24 72 65 64 2e 30 ..set min $red.0
34d0: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 24 . }. if {$
34e0: 62 6c 75 65 20 3e 20 24 6d 61 78 7d 20 7b 0a 09 blue > $max} {..
34f0: 73 65 74 20 6d 61 78 20 24 62 6c 75 65 2e 30 0a set max $blue.0.
3500: 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 69 66 } else {..if
3510: 20 7b 24 62 6c 75 65 20 3c 20 24 6d 69 6e 7d 20 {$blue < $min}
3520: 7b 0a 09 20 20 20 20 73 65 74 20 6d 69 6e 20 24 {.. set min $
3530: 62 6c 75 65 2e 30 0a 09 7d 0a 20 20 20 20 7d 0a blue.0..}. }.
3540: 20 20 20 20 73 65 74 20 72 61 6e 67 65 20 5b 65 set range [e
3550: 78 70 72 20 7b 24 6d 61 78 2d 24 6d 69 6e 7d 5d xpr {$max-$min}]
3560: 0a 20 20 20 20 69 66 20 7b 24 6d 61 78 20 3d 3d . if {$max ==
3570: 20 30 7d 20 7b 0a 09 73 65 74 20 73 61 74 20 30 0} {..set sat 0
3580: 0a 20 20 20 20 7d 20 65 6c 73 65 20 7b 0a 09 73 . } else {..s
3590: 65 74 20 73 61 74 20 5b 65 78 70 72 20 7b 28 24 et sat [expr {($
35a0: 6d 61 78 2d 24 6d 69 6e 29 2f 24 6d 61 78 7d 5d max-$min)/$max}]
35b0: 0a 20 20 20 20 7d 0a 20 20 20 20 69 66 20 7b 24 . }. if {$
35c0: 73 61 74 20 3d 3d 20 30 7d 20 7b 0a 09 73 65 74 sat == 0} {..set
35d0: 20 68 75 65 20 30 0a 20 20 20 20 7d 20 65 6c 73 hue 0. } els
35e0: 65 20 7b 0a 09 73 65 74 20 72 63 20 5b 65 78 70 e {..set rc [exp
35f0: 72 20 7b 28 24 6d 61 78 20 2d 20 24 72 65 64 29 r {($max - $red)
3600: 2f 24 72 61 6e 67 65 7d 5d 0a 09 73 65 74 20 67 /$range}]..set g
3610: 63 20 5b 65 78 70 72 20 7b 28 24 6d 61 78 20 2d c [expr {($max -
3620: 20 24 67 72 65 65 6e 29 2f 24 72 61 6e 67 65 7d $green)/$range}
3630: 5d 0a 09 73 65 74 20 62 63 20 5b 65 78 70 72 20 ]..set bc [expr
3640: 7b 28 24 6d 61 78 20 2d 20 24 62 6c 75 65 29 2f {($max - $blue)/
3650: 24 72 61 6e 67 65 7d 5d 0a 09 69 66 20 7b 24 72 $range}]..if {$r
3660: 65 64 20 3d 3d 20 24 6d 61 78 7d 20 7b 0a 09 20 ed == $max} {..
3670: 20 20 20 73 65 74 20 68 75 65 20 5b 65 78 70 72 set hue [expr
3680: 20 7b 2e 31 36 36 36 36 37 2a 28 24 62 63 20 2d {.166667*($bc -
3690: 20 24 67 63 29 7d 5d 0a 09 7d 20 65 6c 73 65 20 $gc)}]..} else
36a0: 7b 0a 09 20 20 20 20 69 66 20 7b 24 67 72 65 65 {.. if {$gree
36b0: 6e 20 3d 3d 20 24 6d 61 78 7d 20 7b 0a 09 09 73 n == $max} {...s
36c0: 65 74 20 68 75 65 20 5b 65 78 70 72 20 7b 2e 31 et hue [expr {.1
36d0: 36 36 36 36 37 2a 28 32 20 2b 20 24 72 63 20 2d 66667*(2 + $rc -
36e0: 20 24 62 63 29 7d 5d 0a 09 20 20 20 20 7d 20 65 $bc)}].. } e
36f0: 6c 73 65 20 7b 0a 09 09 73 65 74 20 68 75 65 20 lse {...set hue
3700: 5b 65 78 70 72 20 7b 2e 31 36 36 36 36 37 2a 28 [expr {.166667*(
3710: 34 20 2b 20 24 67 63 20 2d 20 24 72 63 29 7d 5d 4 + $gc - $rc)}]
3720: 0a 09 20 20 20 20 7d 0a 09 7d 0a 09 69 66 20 7b .. }..}..if {
3730: 24 68 75 65 20 3c 20 30 2e 30 7d 20 7b 0a 09 20 $hue < 0.0} {..
3740: 20 20 20 73 65 74 20 68 75 65 20 5b 65 78 70 72 set hue [expr
3750: 20 7b 24 68 75 65 20 2b 20 31 2e 30 7d 5d 0a 09 {$hue + 1.0}]..
3760: 7d 0a 20 20 20 20 7d 0a 20 20 20 20 72 65 74 75 }. }. retu
3770: 72 6e 20 5b 6c 69 73 74 20 24 68 75 65 20 24 73 rn [list $hue $s
3780: 61 74 20 5b 65 78 70 72 20 7b 24 6d 61 78 2f 36 at [expr {$max/6
3790: 35 35 33 35 7d 5d 5d 0a 7d 0a 0a 5535}]].}..