Engraved 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

pack [canvas .c -width 500 -height 400 -background grey75]



set font {-*-times-bold-r-normal-*-40-400-*-*-*-*-*-*}



proc raised {c text tc rc font x y n 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 $font \

#    -anchor center -fill grey40 -tags [list bottom $tag]

  for {set i 0} {$i < $n} {incr i} {

     $c create text $x1 $y1 -text $text -font $font \

        -anchor center -fill $rc -tags [list bottom $tag]

     incr x1

     incr y1

  }

  $c create text $x0 $y0 -text $text -font $font \

    -anchor center -fill white -tags [list top $tag]

  $c create text $x $y -text $text -font $font \

    -anchor center -fill $tc -tags [list text $tag]

}



proc sunken {c text tc sc font 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 $font \

      -anchor center -fill $sc -tags [list bottom $tag]

    incr x1

    incr y1

  }

  $c create text $x0 $y0 -text $text -font $font \

    -anchor center -fill grey30 -tags [list top $tag]

  $c create text $x $y -text $text -font $font \

    -anchor center -fill grey90 -tags [list bottom $tag]

}



proc impressed {c text tc font 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 $font \

    -anchor center -fill white -tags [list bottom $tag]

  $c create text $x0 $y0 -text $text -font $font \

    -anchor center -fill black -tags [list top $tag]

  $c create text $x $y -text $text -font $font \

    -anchor center -fill $tc -tags [list text $tag]

}



proc shadowed {c text tc sc font x y off tag} {

  set x2 [expr $x + $off]

  set y2 [expr $y + $off]

  $c create text $x2 $y2 -text $text -font $font \

    -anchor center -fill $sc -tags [list top $tag]

  $c create text $x $y -text $text -font $font \

    -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 font x y tag} {

  set x2 [expr $x + 1]

  set y2 [expr $y + 1]

  $c create text $x2 $y2 -text $text -font $font \

    -anchor center -fill $sc -tags [list top $tag ${tag}shadow]

  $c create text $x $y -text $text -font $font \

    -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 * 7]

   $c itemconfigure ${tag}shadow -fill $grey

   $c move ${tag}front -1 -1

   after 100 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) * 7]

   $c itemconfigure ${tag}shadow -fill $grey

   $c move ${tag}front 1 1

   after 100 lower $c $count $limit $tag

}

proc fading {c text tc font x y tag} {

  $c create text $x $y -text $text -font $font \

    -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 100 fade $c $tag $cur $limit

}

proc unfade {c tag cur} {

  if {$cur < 0} {

    return

  }

  $c itemconfigure $tag -fill grey$cur

  incr cur -4

  after 100 unfade $c $tag $cur

}



raised .c "Raised text" green gray40 $font 250 50 8 raised

sunken .c "Sunken text" grey80 grey70 $font 250 150 3 sunken

shadowed .c "Shadowed, floating text." white grey40 $font 250 250 10 shadowed

impressed .c "Impressed text." black $font 150 100 impressed

fading .c "Mouse sensitive text" black $font 250 300 fading

raising .c "Mouse sensitive text" white grey40 $font 250 350 raising



.c bind raised <Button-1> "startdrag %x %y"

.c bind raised <B1-Motion> "movedrag %W %x %y raised"



.c bind sunken <Button-1> "startdrag %x %y"

.c bind sunken <B1-Motion> "movedrag %W %x %y sunken"



.c bind shadowed <Button-1> "startdrag %x %y"

.c bind shadowed <B1-Motion> "movedrag %W %x %y shadowed"



.c bind impressed <Button-1> "startdrag %x %y"

.c bind impressed <B1-Motion> "movedrag %W %x %y impressed"



.c bind raising <Enter> "raise .c 0 8 raising"

.c bind raising <Leave> "lower .c 0 8 raising"



.c bind raising <Button-1> "startdrag %x %y"

.c bind raising <B1-Motion> "movedrag %W %x %y raising"



.c bind fading <Enter> "fade .c fading 0 75"

.c bind fading <Leave> "unfade .c fading 75"



.c bind fading <Button-1> "startdrag %x %y"

.c bind fading <B1-Motion> "movedrag %W %x %y fading"