1#!/usr/local/bin/bltwish
2if {[lindex $argv end] != "spawn"} {
3    exec [info nameofexecutable] [info script] spawn &
4}
5
6package require BLT
7
8# --------------------------------------------------------------------------
9# Starting with Tcl 8.x, the BLT commands are stored in their own
10# namespace called "blt".  The idea is to prevent name clashes with
11# Tcl commands and variables from other packages, such as a "table"
12# command in two different packages.
13#
14# You can access the BLT commands in a couple of ways.  You can prefix
15# all the BLT commands with the namespace qualifier "blt::"
16#
17#    blt::graph .g
18#    blt::table . .g -resize both
19#
20# or you can import all the command into the global namespace.
21#
22#    namespace import blt::*
23#    graph .g
24#    table . .g -resize both
25#
26# --------------------------------------------------------------------------
27if { $tcl_version >= 8.0 } {
28    namespace import blt::*
29    namespace import -force blt::tile::*
30}
31source scripts/demo.tcl
32
33if { ([info exists tcl_platform]) && ($tcl_platform(platform) == "windows") } {
34    source scripts/send.tcl
35    SendInit
36    SendVerify
37}
38
39# ----------------------------------------------------------------------
40# This procedure is invoked each time a token is grabbed from the
41# sample window.  It configures the token to display the current
42# color, and returns the color value that is later passed to the
43# target handler.
44# ----------------------------------------------------------------------
45proc package_color {token} {
46    set bg [.sample cget -background]
47    set fg [.sample cget -foreground]
48
49    $token.label configure -background $bg -foreground $fg
50    return $bg
51}
52
53# ----------------------------------------------------------------------
54# Main application window...
55# ----------------------------------------------------------------------
56label .sample -text "Color" -height 2  -bd 10 -relief sunken
57
58#
59# Set up the color sample as a drag&drop source for "color" values:
60#
61drag&drop source .sample \
62    -packagecmd {package_color %t}  \
63    -sitecmd { puts "%s %t" }
64
65drag&drop source .sample handler color
66
67#
68# Set up the color sample as a drag&drop target for "color" values:
69#
70drag&drop target .sample handler color {set_color %v}
71
72#
73# Establish the appearance of the token window:
74#
75set token [drag&drop token .sample]
76label $token.label -text "Color"
77pack $token.label
78
79scale .redScale -label "Red" -orient horizontal \
80    -from 0 -to 255 -command adjust_color
81frame .redSample -width 20 -height 20 -borderwidth 3 -relief sunken
82
83scale .greenScale -label "Green" -orient horizontal \
84    -from 0 -to 255 -command adjust_color
85frame .greenSample -width 20 -height 20 -borderwidth 3 -relief sunken
86
87scale .blueScale -label "Blue" -orient horizontal \
88    -from 0 -to 255 -command adjust_color
89frame .blueSample -width 20 -height 20 -borderwidth 3 -relief sunken
90
91# ----------------------------------------------------------------------
92# This procedure loads a new color value into this editor.
93# ----------------------------------------------------------------------
94proc set_color {cval} {
95    set rgb [winfo rgb . $cval]
96
97    set rval [expr round([lindex $rgb 0]/65535.0*255)]
98    .redScale set $rval
99
100    set gval [expr round([lindex $rgb 1]/65535.0*255)]
101    .greenScale set $gval
102
103    set bval [expr round([lindex $rgb 2]/65535.0*255)]
104    .blueScale set $bval
105}
106
107# ----------------------------------------------------------------------
108# This procedure is invoked whenever an RGB slider changes to
109# update the color samples in this display.
110# ----------------------------------------------------------------------
111proc adjust_color {args} {
112    set rval [.redScale get]
113    .redSample configure -background [format "#%.2x0000" $rval]
114    set gval [.greenScale get]
115    .greenSample configure -background [format "#00%.2x00" $gval]
116    set bval [.blueScale get]
117    .blueSample configure -background [format "#0000%.2x" $bval]
118
119    .sample configure -background \
120        [format "#%.2x%.2x%.2x" $rval $gval $bval]
121    if {$rval+$gval+$bval < 1.5*255} {
122        .sample configure -foreground white
123    } else {
124        .sample configure -foreground black
125    }
126}
127
128table . .sample      0,0 -columnspan 2 -fill both -pady {0 4}
129table . .redScale    1,0 -fill both
130table . .redSample   1,1 -fill both
131table . .greenScale  2,0 -fill both
132table . .greenSample 2,1 -fill both
133table . .blueScale   3,0 -fill both
134table . .blueSample  3,1 -fill both
135