mingw/lib/tk8.5/demos/square

   1 #!/bin/sh
   2 # the next line restarts using wish \
   3 exec wish "$0" "$@"
   4
   5 # square --
   6 # This script generates a demo application containing only a "square"
   7 # widget.  It's only usable in the "tktest" application or if Tk has
   8 # been compiled with tkSquare.c. This demo arranges the following
   9 # bindings for the widget:
  10 #
  11 # Button-1 press/drag:          moves square to mouse
  12 # "a":                          toggle size animation on/off
  13
  14 package require Tk              ;# We use Tk generally, and...
  15 package require Tktest          ;# ... we use the square widget too.
  16
  17 square .s
  18 pack .s -expand yes -fill both
  19 wm minsize . 1 1
  20
  21 bind .s <1> {center %x %y}
  22 bind .s <B1-Motion> {center %x %y}
  23 bind .s a animate
  24 focus .s
  25
  26 # The procedure below centers the square on a given position.
  27
  28 proc center {x y} {
  29     set a [.s size]
  30     .s position [expr $x-($a/2)] [expr $y-($a/2)]
  31 }
  32
  33 # The procedures below provide a simple form of animation where
  34 # the box changes size in a pulsing pattern: larger, smaller, larger,
  35 # and so on.
  36
  37 set inc 0
  38 proc animate {} {
  39     global inc
  40     if {$inc == 0} {
  41         set inc 3
  42         timer
  43     } else {
  44         set inc 0
  45     }
  46 }
  47
  48 proc timer {} {
  49     global inc
  50     set s [.s size]
  51     if {$inc == 0} return
  52     if {$s >= 40} {set inc -3}
  53     if {$s <= 10} {set inc 3}
  54     .s size [expr {$s+$inc}]
  55     after 30 timer
  56 }
  57
  58 # Local Variables:
  59 # mode: tcl
  60 # End: