Embossed Text with Tk

The Tclet below demonstrates some of Tk's capabilities in dealing with structured graphics. Each text line is an item, and it responds differently to mouse actions. Try entering each text item with the mouse, and try dragging it with the left mouse button pressed.
Source

Here is the source (all ~180 lines) of this Tclet:
font create ourFont -family Times -size 24 -weight bold
set c [canvas .c -background white -bd 1 -relief sunken -highlightthickness 0]
pack $c -fill both -expand 1

set ::DELAY 100
set ::AID   {}

proc raised {c text tc rc x y n tag} {
    set x1 [expr {$x + 1}]
    set y1 [expr {$y + 1}]
    set x0 [expr {$x - 1}]
    set y0 [expr {$y - 1}]
    
    for {set i 0} {$i < $n} {incr i} {
	$c create text $x1 $y1 -text $text -font ourFont \
	    -anchor center -fill $rc -tags [list bottom $tag]
	incr x1
	incr y1
    }
    $c create text $x0 $y0 -text $text -font ourFont \
	-anchor center -fill white -tags [list top $tag]
    $c create text $x $y -text $text -font ourFont \
	-anchor center -fill $tc -tags [list text $tag]
}

proc sunken {c text tc sc x y n tag} {
    set x1 [expr {$x + 1}]
    set y1 [expr {$y + 1}]
    set x0 [expr {$x - 1}]
    set y0 [expr {$y - 1}]
    
    for {set i 0} {$i < $n} {incr i} {
	$c create text $x1 $y1 -text $text -font ourFont \
	    -anchor center -fill white -tags [list bottom $tag]
	incr x1
	incr y1
    }
    $c create text $x0 $y0 -text $text -font ourFont \
	-anchor center -fill $tc -tags [list top $tag]
    $c create text $x $y -text $text -font ourFont \
	-anchor center -fill $sc -tags [list bottom $tag]
}

proc impressed {c text tc x y tag} {
    set x1 [expr {$x + 1}]
    set y1 [expr {$y + 1}]
    set x0 [expr {$x - 1}]
    set y0 [expr {$y - 1}]
    
    $c create text $x1 $y1 -text $text -font ourFont \
	-anchor center -fill white -tags [list bottom $tag]
    $c create text $x0 $y0 -text $text -font ourFont \
	-anchor center -fill black -tags [list top $tag]
    $c create text $x $y -text $text -font ourFont \
	-anchor center -fill $tc -tags [list text $tag]
}

proc shadowed {c text tc sc x y off tag} {
    set x2 [expr {$x + $off}]
    set y2 [expr {$y + $off}]
    $c create text $x2 $y2 -text $text -font ourFont \
	-anchor center -fill $sc -tags [list top $tag]
    $c create text $x $y -text $text -font ourFont \
	-anchor center -fill $tc -tags [list text $tag]
}
proc startdrag {x y} {
    global startx starty
    set startx $x
    set starty $y
}
proc movedrag {w x y tag} {
    global startx starty
    set dx [expr {$x - $startx}]
    set dy [expr {$y - $starty}]
    $w move $tag $dx $dy
    set startx $x
    set starty $y
}
proc raising {c text tc sc x y tag} {
    set x2 [expr {$x + 1}]
    set y2 [expr {$y + 1}]
    $c create text $x2 $y2 -text $text -font ourFont \
	-anchor center -fill $sc -tags [list top $tag ${tag}shadow]
    $c create text $x $y -text $text -font ourFont \
	-anchor center -fill $tc -tags [list text $tag ${tag}front]
}
proc raise {c count limit tag} {
    if {$count > $limit} {
	return
    }
    incr count
    set grey grey[expr {$count * 9}]
    $c itemconfigure ${tag}shadow -fill $grey
    $c move ${tag}front -1 -1
    after cancel $::AID
    set ::AID [after $::DELAY [list raise $c $count $limit $tag]]
}
proc lower {c count limit tag} {
    if {$count > $limit} {
	$c itemconfigure ${tag}shadow -fill black
	return
    }
    incr count
    set grey grey[expr {(10 - $count) * 9}]
    $c itemconfigure ${tag}shadow -fill $grey
    $c move ${tag}front 1 1
    after cancel $::AID
    set ::AID [after $::DELAY [list lower $c $count $limit $tag]]
}
proc fading {c text tc x y tag} {
    $c create text $x $y -text $text -font ourFont \
	-anchor center -fill $tc -tags [list top $tag]
}
proc fade {c tag cur limit} {
    if {$cur > $limit} {
	$c itemconfigure $tag -fill grey$limit
	return
    }
    $c itemconfigure $tag -fill grey$cur
    incr cur 4
    after cancel $::AID
    set ::AID [after $::DELAY [list fade $c $tag $cur $limit]]
}
proc unfade {c tag cur} {
    if {$cur < 0} {
	return
    }
    $c itemconfigure $tag -fill grey$cur
    incr cur -4
    after cancel $::AID
    set ::AID [after $::DELAY [list unfade $c $tag $cur]]
}

.c bind raised <Button-1> {
    .c raise raised
    startdrag %x %y
}
.c bind raised <B1-Motion> "movedrag %W %x %y raised"

.c bind sunken <Button-1> {
    .c lower sunken
    startdrag %x %y
}
.c bind sunken <B1-Motion> "movedrag %W %x %y sunken"

.c bind shadowed <Button-1> {
    .c raise shadowed
    startdrag %x %y
}
.c bind shadowed <B1-Motion> "movedrag %W %x %y shadowed"

.c bind impressed <Button-1> {
    .c lower impressed
    startdrag %x %y
}
.c bind impressed <B1-Motion> "movedrag %W %x %y impressed"

.c bind raising <Enter> "raise .c 0 9 raising"
.c bind raising <Leave> "lower .c 0 9 raising"

.c bind raising <Button-1> {
    .c raise raising
    startdrag %x %y
}
.c bind raising <B1-Motion> "movedrag %W %x %y raising"

.c bind fading <Enter> [list fade .c fading 0 100]
.c bind fading <Leave> [list unfade .c fading 100]

.c bind fading <Button-1> {
    .c lower fading
    startdrag %x %y
}
.c bind fading <B1-Motion> [list movedrag %W %x %y fading]

raised .c "Raised text" green gray40 250 50 8 raised
sunken .c "Sunken text" grey20 grey80 250 150 3 sunken
shadowed .c "Shadowed, floating text." black grey40 250 250 10 shadowed
impressed .c "Impressed text." black 150 100 impressed
fading .c "Mouse sensitive text" black 250 300 fading
raising .c "Mouse sensitive text" black grey40 250 350 raising