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