# ======================================================================

  namespace eval color {
    variable MAX_INTENSITY 65535
  }

# ======================================================================

# shadow:dark --

# Compute the dark shadow color for a 3d border.

# Cut 40% from each of the color components. If the background is
# already very dark, make the dark color a little lighter than the
# background by increasing each color component 1/4th of the way to
# MAX_INTENSITY.

# This adapted from tk8.4.0/unix/tkUnix3d.c

proc color::shadow:dark {R G B} {

# ----------------------------------------------------------------------

  variable MAX_INTENSITY

# ----------------------------------------------------------------------

  if { [expr {($R*0.5*$R) + ($G*1.0*$G) + ($B*0.28*$B)}] <
       [expr {$MAX_INTENSITY*0.05*$MAX_INTENSITY}] } {
    set r [expr {($MAX_INTENSITY + 3*$R)/4}]
    set g [expr {($MAX_INTENSITY + 3*$G)/4}]
    set b [expr {($MAX_INTENSITY + 3*$B)/4}]
  } else {
    set r [expr {(60 * $R)/100}]
    set g [expr {(60 * $G)/100}]
    set b [expr {(60 * $B)/100}]
  }

# ----------------------------------------------------------------------

  return [format #%04X%04X%04X $r $g $b]

}

# ======================================================================

# shadow:light --

# Compute the light shadow color for a 3d border.

# Boost each component by 40% or half-way to white, whichever is greater
# (the first approach works better for unsaturated colors, the second
# for saturated ones). If the background is already very bright, instead
# choose a slightly darker color for the light shadow by reducing each
# color component by 10%.

# This adapted from tk8.4.0/unix/tkUnix3d.c

proc color::shadow:light {R G B} {

# ----------------------------------------------------------------------

  variable MAX_INTENSITY

# ----------------------------------------------------------------------

  if { $G > [expr {$MAX_INTENSITY*0.95}] } {
    set r [expr {(90 * $R)/100}]
    set g [expr {(90 * $G)/100}]
    set b [expr {(90 * $B)/100}]
  } else {
    set tmp1 [expr {(14 * $R)/10}]

    if { $tmp1 > $MAX_INTENSITY } { set tmp1 $MAX_INTENSITY }

    set tmp2 [expr {($MAX_INTENSITY + $R)/2}]
    set r    [expr {($tmp1 > $tmp2) ? $tmp1 : $tmp2}]
    set tmp1 [expr {(14 * $G)/10}]

    if { $tmp1 > $MAX_INTENSITY } { set tmp1 $MAX_INTENSITY }

    set tmp2 [expr {($MAX_INTENSITY + $G)/2}]
    set g    [expr {($tmp1 > $tmp2) ? $tmp1 : $tmp2}]
    set tmp1 [expr {(14 * $B)/10}]

    if { $tmp1 > $MAX_INTENSITY } { set tmp1 $MAX_INTENSITY }

    set tmp2 [expr {($MAX_INTENSITY + $B)/2}]
    set b    [expr {($tmp1 > $tmp2) ? $tmp1 : $tmp2}]
  }

# ----------------------------------------------------------------------

  return [format #%04X%04X%04X $r $g $b]

}

# ======================================================================

# demo code
proc rect {c x1 y1 x2 y2 bd color} {

  set dark  [eval color::shadow:dark  [winfo rgb $c $color]]
  set light [eval color::shadow:light [winfo rgb $c $color]]
  puts "dark  $color = \[$dark\]"
  puts "light $color = \[$light\]"

  $c create polygon \
    $x1 $y1 \
    $x2 $y1 \
    [expr $x2 - $bd] [expr $y1 + $bd] \
    [expr $x1 + $bd] [expr $y1 + $bd] \
    [expr $x1 + $bd] [expr $y2 - $bd] \
    $x1 $y2 \
    -fill    $light \
    -outline $light

  $c create polygon \
    $x2 $y1 \
    $x2 $y2 \
    $x1 $y2 \
    [expr $x1 + $bd] [expr $y2 - $bd] \
    [expr $x2 - $bd] [expr $y2 - $bd] \
    [expr $x2 - $bd] [expr $y1 + $bd] \
    -fill    $dark \
    -outline $dark

  $c create rectangle \
    [expr $x1 + $bd] [expr $y1 + $bd] \
    [expr $x2 - $bd] [expr $y2 - $bd] \
    -fill    $color \
    -outline $color

  return

}

  button .b -text "Hello World" -bg red -fg white -bd 10
  canvas .c

  pack .b
  pack .c -expand 1 -fill both

  update idletasks

  rect .c 10 10 \
    [expr [winfo reqwidth  .b] + 10] \
    [expr [winfo reqheight .b] + 10] \
    10 red

# ======================================================================