1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
|
#!../src/bltwish
package require BLT
# --------------------------------------------------------------------------
# Starting with Tcl 8.x, the BLT commands are stored in their own
# namespace called "blt". The idea is to prevent name clashes with
# Tcl commands and variables from other packages, such as a "table"
# command in two different packages.
#
# You can access the BLT commands in a couple of ways. You can prefix
# all the BLT commands with the namespace qualifier "blt::"
#
# blt::graph .g
# blt::table . .g -resize both
#
# or you can import all the command into the global namespace.
#
# namespace import blt::*
# graph .g
# table . .g -resize both
#
# --------------------------------------------------------------------------
if { $tcl_version >= 8.0 } {
namespace import blt::*
namespace import -force blt::tile::*
}
source scripts/demo.tcl
if { ([info exists tcl_platform]) && ($tcl_platform(platform) == "windows") } {
source scripts/send.tcl
SendInit
SendVerify
}
# ----------------------------------------------------------------------
# This procedure is invoked each time a token is grabbed from the
# sample window. It configures the token to display the current
# color, and returns the color value that is later passed to the
# target handler.
# ----------------------------------------------------------------------
proc package_color {token} {
set bg [.sample cget -background]
set fg [.sample cget -foreground]
$token.label configure -text "Color" -background $bg -foreground $fg
return $bg
}
# ----------------------------------------------------------------------
# This procedure is invoked each time a token is grabbed from an
# entry widget. It configures the token to display the current
# string, and returns the string that is later passed to the target
# handler.
# ----------------------------------------------------------------------
proc package_string {str token} {
if {[string length $str] > 20} {
set mesg "[string range $str 0 19]..."
} else {
set mesg $str
}
$token.label configure -text $mesg
return $str
}
# ----------------------------------------------------------------------
# Main application window...
# ----------------------------------------------------------------------
label .sample -text "Color" -height 2 -borderwidth 3 -relief sunken
#
# Set up the color sample as a drag&drop source for "color" values
# and "string" values
#
drag&drop source .sample -packagecmd {package_color %t}
drag&drop source .sample handler color
drag&drop source .sample handler string
#
# Set up the color sample as a drag&drop target for "color" values:
#
drag&drop target .sample handler color {set_color %v}
#
# Establish the appearance of the token window:
#
set token [drag&drop token .sample -activebackground yellow ]
label $token.label -text "Color"
pack $token.label
scale .redScale -label "Red" -orient horizontal \
-from 0 -to 255 -command adjust_color
frame .redSample -width 20 -height 20 -borderwidth 3 -relief sunken
scale .greenScale -label "Green" -orient horizontal \
-from 0 -to 255 -command adjust_color
frame .greenSample -width 20 -height 20 -borderwidth 3 -relief sunken
scale .blueScale -label "Blue" -orient horizontal \
-from 0 -to 255 -command adjust_color
frame .blueSample -width 20 -height 20 -borderwidth 3 -relief sunken
frame .color
label .color.label -text "Color:"
pack .color.label -side left
entry .color.value -width 10
pack .color.value -side left -expand yes -fill both
bind .color.value <KeyPress-Return> {set_color [%W get]}
#
# Set up the entry widget as a drag&drop source for "string" values:
#
drag&drop source .color.value \
-packagecmd {package_string [%W get] %t} \
-selftarget yes
drag&drop source .color.value handler string
#
# Set up the entry widget as a drag&drop target for "string" values:
#
drag&drop target .color.value handler string {
%W delete 0 end
%W insert 0 "%v"
}
#
# Establish the appearance of the token window:
#
set token [drag&drop token .color.value]
label $token.label
pack $token.label
# ----------------------------------------------------------------------
# This procedure loads a new color value into this editor.
# ----------------------------------------------------------------------
proc set_color {cval} {
set rgb [winfo rgb . $cval]
set rval [expr round([lindex $rgb 0]/65535.0*255)]
.redScale set $rval
set gval [expr round([lindex $rgb 1]/65535.0*255)]
.greenScale set $gval
set bval [expr round([lindex $rgb 2]/65535.0*255)]
.blueScale set $bval
}
# ----------------------------------------------------------------------
# This procedure is invoked whenever an RGB slider changes to
# update the color samples in this display.
# ----------------------------------------------------------------------
proc adjust_color {args} {
set rval [.redScale get]
.redSample configure -background [format "#%.2x0000" $rval]
set gval [.greenScale get]
.greenSample configure -background [format "#00%.2x00" $gval]
set bval [.blueScale get]
.blueSample configure -background [format "#0000%.2x" $bval]
.sample configure -background \
[format "#%.2x%.2x%.2x" $rval $gval $bval]
if {$rval+$gval+$bval < 1.5*255} {
.sample configure -foreground white
} else {
.sample configure -foreground black
}
}
table . \
0,0 .sample -columnspan 2 -pady {0 4} \
1,0 .color -columnspan 2 -padx 4 -pady 4 \
2,0 .redScale \
2,1 .redSample \
3,0 .greenScale \
3,1 .greenSample \
4,0 .blueScale \
4,1 .blueSample
eval table configure . [winfo children .] -fill both
|
