Il CD di internet/CD.iso/SOURCE/TCL/BLT/_BLT.TAR/usr/lib/blt/demos/palette

Text File | 1994-01-10 | 10.7 KB | 355 lines

#!../blt_wish -f

if [file exists ../library] {
    set blt_library ../library
}

# ----------------------------------------------------------------------
#  PURPOSE:  color palette (demo for drag&drop facilities)
#
#   AUTHOR:  Michael J. McLennan       Phone: [phone]
#            AT&T Bell Laboratories   E-mail: aluxpo![e-mail]
#
#     SCCS:  %W% (%G%)
# ----------------------------------------------------------------------
#            Copyright (c) 1993  AT&T  All Rights Reserved
# ======================================================================

if {![file exists $blt_library/dd_protocols]} {
    puts stderr "\n================== INSTALLATION ERROR ==================="
    puts stderr "== Cannot find \"dd_protocols\" directory for drag&drop. =="
    puts stderr "== Recompile blt_wish, or set BLT_LIBRARY environment  =="
    puts stderr "== variable to path containing BLT library.            =="
    puts stderr "========================================================="
    exit 1
}
lappend auto_path $blt_library/dd_protocols

# ----------------------------------------------------------------------
# Routines for packaging token windows...
# ----------------------------------------------------------------------
proc package_color {color win} {
    if {[winfo children $win] == ""} {
    label $win.label -text "Color"
    pack append $win $win.label top
    }
    set rgb [winfo rgb . $color]
    set r [expr [lindex $rgb 0]/256]
    set g [expr [lindex $rgb 1]/256]
    set b [expr [lindex $rgb 2]/256]

    if {[expr $r+$g+$b] > 384} {
    $win.label config -background $color -foreground black
    } else {
    $win.label config -background $color -foreground white
    }
    return $color
}

proc package_number {num win} {
    if {[winfo children $win] == ""} {
    label $win.label -text ""
    pack append $win $win.label top
    }
    expr $num*1
    $win.label config -text "Number: $num"
    return $num
}

proc package_text {text win} {
    if {[winfo children $win] == ""} {
    label $win.label -text "" -width 30
    pack append $win $win.label top
    }
    $win.label config -text "Text: $text"
    return $text
}

# ----------------------------------------------------------------------
# Actions to handle color data...
# ----------------------------------------------------------------------
proc set_color {args} {
    global DragDrop
    set rgb [winfo rgb . $DragDrop(color)]

    if {$args == "red" || $args == ""} {
    set_red [expr [lindex $rgb 0]/256]
    }
    if {$args == "green" || $args == ""} {
    set_green [expr [lindex $rgb 1]/256]
    }
    if {$args == "blue" || $args == ""} {
    set_blue  [expr [lindex $rgb 2]/256]
    }
}

proc bg_color {win} {
    global DragDrop
    set rgb [winfo rgb . $DragDrop(color)]

    set newR [expr [lindex $rgb 0]/256]
    set newG [expr [lindex $rgb 1]/256]
    set newB [expr [lindex $rgb 2]/256]

    set actR [expr $newR-20]
    set actG [expr $newG-20]
    set actB [expr $newB-20]

    set ncolor #[dec_to_hex $newR][dec_to_hex $newG][dec_to_hex $newB]
    set acolor #[dec_to_hex $actR][dec_to_hex $actG][dec_to_hex $actB]

    if {![string match *sample* $win] && $win != "." } {
    catch "$win config -background $ncolor"
    catch "$win config -activebackground $acolor"
    }
    foreach child [winfo children $win] {
    bg_color $child
    }
}

proc fg_color {win} {
    global DragDrop
    set rgb [winfo rgb . $DragDrop(color)]

    set newR [expr [lindex $rgb 0]/256]
    set newG [expr [lindex $rgb 1]/256]
    set newB [expr [lindex $rgb 2]/256]

    set actR [expr $newR-20]
    set actG [expr $newG-20]
    set actB [expr $newB-20]

    set ncolor #[dec_to_hex $newR][dec_to_hex $newG][dec_to_hex $newB]
    set acolor #[dec_to_hex $actR][dec_to_hex $actG][dec_to_hex $actB]

    if {![string match *sample* $win]} {
    catch "$win config -foreground $ncolor"
    catch "$win config -activeforeground $acolor"
    }
    foreach child [winfo children $win] {
    fg_color $child
    }
}

# ----------------------------------------------------------------------
# Setting color samples...
# ----------------------------------------------------------------------
set Red 0
set Green 0
set Blue 0

proc update_main_sample {} {
    global Red Green Blue
    set color #[dec_to_hex $Red][dec_to_hex $Green][dec_to_hex $Blue]

    if {[expr $Red+$Green+$Blue] > 384} {
    .sample config -background $color -foreground black
    } else {
    .sample config -background $color -foreground white
    }
}

proc set_red {val} {
    global Red
    set Red $val

    .red.cntl set $Red
    .red.sample config -background #[dec_to_hex $Red]0000
    update_main_sample
}

proc set_green {val} {
    global Green
    set Green $val

    .green.cntl set $Green
    .green.sample config -background #00[dec_to_hex $Green]00
    update_main_sample
}

proc set_blue {val} {
    global Blue
    set Blue $val

    .blue.cntl set $Blue
    .blue.sample config -background #0000[dec_to_hex $Blue]
    update_main_sample
}

# ----------------------------------------------------------------------
# Mapping numbers to colors...
# ----------------------------------------------------------------------
set dec_to_hex_map(0) 0
set dec_to_hex_map(1) 1
set dec_to_hex_map(2) 2
set dec_to_hex_map(3) 3
set dec_to_hex_map(4) 4
set dec_to_hex_map(5) 5
set dec_to_hex_map(6) 6
set dec_to_hex_map(7) 7
set dec_to_hex_map(8) 8
set dec_to_hex_map(9) 9
set dec_to_hex_map(10) a
set dec_to_hex_map(11) b
set dec_to_hex_map(12) c
set dec_to_hex_map(13) d
set dec_to_hex_map(14) e
set dec_to_hex_map(15) f

proc dec_to_hex {val} {
    global dec_to_hex_map

    if {$val < 0} {set val 0}
    if {$val > 255} {set val 255}

    set dig1 [expr $val/16]
    set dig2 [expr $val-$dig1*16]
    return $dec_to_hex_map($dig1)$dec_to_hex_map($dig2)
}

# ----------------------------------------------------------------------
# Main application window...
# ----------------------------------------------------------------------
label .sample -text "Color" -borderwidth 3 -relief raised

blt_drag&drop source .sample config \
    -packagecmd {package_color #[dec_to_hex $Red][dec_to_hex $Green][dec_to_hex $Blue]}
blt_drag&drop source .sample handler color dd_send_color
blt_drag&drop target .sample handler color set_color

message .explanation -font -Adobe-times-medium-r-normal--*-120* -aspect 200 \
    -text "Press the third mouse button over a slider or a color sample and drag the token window around.  When the token becomes raised, it is over a target window.  Release the mouse button to drop the token and transfer information.  If the transfer fails, a \"no\" symbol is drawn on the token window.\n\nTry the following:\n- Drop a number from one slider onto another\n- Drop a color sample onto the Foreground/Background targets\n- Drop one of the slider color samples onto the main sample\n- Drop tokens from one palette application onto another"

#
# Color value entry...
#
frame .value -borderwidth 3
label .value.l -text "Color Value:"
entry .value.e -borderwidth 2 -relief sunken -bg white
pack append .value \
    .value.l left \
    .value.e {left expand fillx}

blt_drag&drop source .value.e config \
    -packagecmd {package_color [.value.e get]}
blt_drag&drop source .value.e handler color dd_send_color

blt_drag&drop target .value.e handler \
    number {.value.e delete 0 end; .value.e insert 0 $DragDrop(number)} \
    color  {.value.e delete 0 end; .value.e insert 0 $DragDrop(color)}

bind .value.e <Key-Return> {set DragDrop(color) [.value.e get]; set_color}

#
# Red slider...
#
frame .red -borderwidth 3 -relief raised
scale .red.cntl -label "Red" -orient horizontal -from 0 -to 255 \
    -command set_red
frame .red.sample -geometry 20x20 -borderwidth 3 -relief raised
pack append .red \
    .red.cntl {left expand fillx} \
    .red.sample {right filly}

blt_drag&drop source .red.sample config \
    -packagecmd {package_color #[dec_to_hex $Red]0000}
blt_drag&drop source .red.sample handler color dd_send_color

blt_drag&drop target .red.sample handler \
    number {set_red $DragDrop(number)} \
    color  {set_color red}

blt_drag&drop source .red.cntl config \
    -packagecmd {package_number [.red.cntl get]}
blt_drag&drop source .red.cntl handler number dd_send_number

blt_drag&drop target .red.cntl handler \
    number {set_red $DragDrop(number)} \
    color  {set_color red}

#
# Green slider...
#
frame .green -borderwidth 3 -relief raised
scale .green.cntl -label "Green" -orient horizontal -from 0 -to 255 \
    -command set_green
frame .green.sample -geometry 20x20 -borderwidth 3 -relief raised
pack append .green \
    .green.cntl {left expand fillx} \
    .green.sample {right filly}

blt_drag&drop source .green.sample config \
    -packagecmd {package_color #00[dec_to_hex $Green]00}
blt_drag&drop source .green.sample handler color dd_send_color

blt_drag&drop target .green.sample handler \
    number {set_green $DragDrop(number)} \
    color  {set_color green}

blt_drag&drop source .green.cntl config \
    -packagecmd {package_number [.green.cntl get]}
blt_drag&drop source .green.cntl handler number dd_send_number

blt_drag&drop target .green.cntl handler \
    number {set_green $DragDrop(number)} \
    color  {set_color green}

#
# Blue slider...
#
frame .blue -borderwidth 3 -relief raised
scale .blue.cntl -label "Blue" -orient horizontal -from 0 -to 255 \
    -command set_blue
frame .blue.sample -geometry 20x20 -borderwidth 3 -relief raised
pack append .blue \
    .blue.cntl {left expand fillx} \
    .blue.sample {right filly}

blt_drag&drop source .blue.sample config \
    -packagecmd {package_color #0000[dec_to_hex $Blue]}
blt_drag&drop source .blue.sample handler color dd_send_color

blt_drag&drop target .blue.sample handler \
    number {set_blue $DragDrop(number)} \
    color  {set_color blue}

blt_drag&drop source .blue.cntl config \
    -packagecmd {package_number [.blue.cntl get]}
blt_drag&drop source .blue.cntl handler number dd_send_number

blt_drag&drop target .blue.cntl handler \
    number {set_blue $DragDrop(number)} \
    color {set_color blue}

#
# Foreground/Background color inputs...
#
frame .inputs
label .inputs.bg -text "Background" -borderwidth 3 -relief sunken
label .inputs.fg -text "Foreground" -borderwidth 3 -relief sunken
button .inputs.quit -text "Quit" -borderwidth 3 -command "exit"

blt_drag&drop target .inputs.bg handler color "bg_color ."
blt_drag&drop target .inputs.fg handler color "fg_color ."

pack append .inputs \
    .inputs.fg {left padx 5 pady 5} \
    .inputs.bg {left padx 5 pady 5} \
    .inputs.quit {right padx 5 pady 5}

pack append . \
    .sample {top expand fillx filly} \
    .explanation {top expand fillx filly} \
    .value {top fillx} \
    .red {top fill} \
    .green {top fill} \
    .blue {top fill} \
    .inputs {top fillx}

wm minsize . 200 200
wm maxsize . 1000 1000

set_red 0
set_green 0
set_blue 0