I386LINUX/util/I386LINUX/lib/blt2.4/demos/dragdrop1.tcl

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