+++ /dev/null
-#!../src/bltwish
-if {[lindex $argv end] != "spawn"} {
- exec [info nameofexecutable] [info script] spawn &
-}
-
-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
OSDN Git Service
