mingw/lib/tk8.4/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 # RCS: @(#) $Id: square,v 1.2 1998/09/14 18:23:30 stanton Exp $
  15
  16 square .s
  17 pack .s -expand yes -fill both
  18 wm minsize . 1 1
  19
  20 bind .s <1> {center %x %y}
  21 bind .s <B1-Motion> {center %x %y}
  22 bind .s a animate
  23 focus .s
  24
  25 # The procedure below centers the square on a given position.
  26
  27 proc center {x y} {
  28     set a [.s size]
  29     .s position [expr $x-($a/2)] [expr $y-($a/2)]
  30 }
  31
  32 # The procedures below provide a simple form of animation where
  33 # the box changes size in a pulsing pattern: larger, smaller, larger,
  34 # and so on.
  35
  36 set inc 0
  37 proc animate {} {
  38     global inc
  39     if {$inc == 0} {
  40         set inc 3
  41         timer
  42     } else {
  43         set inc 0
  44     }
  45 }
  46
  47 proc timer {} {
  48     global inc
  49     set s [.s size]
  50     if {$inc == 0} return
  51     if {$s >= 40} {set inc -3}
  52     if {$s <= 10} {set inc 3}
  53     .s size [expr {$s+$inc}]
  54     after 30 timer
  55 }