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 # RCS: @(#) $Id: square,v 1.3 2003/09/30 14:54:30 dkf Exp $
  15
  16 package require Tk              ;# We use Tk generally, and...
  17 package require Tktest          ;# ... we use the square widget too.
  18
  19 square .s
  20 pack .s -expand yes -fill both
  21 wm minsize . 1 1
  22
  23 bind .s <1> {center %x %y}
  24 bind .s <B1-Motion> {center %x %y}
  25 bind .s a animate
  26 focus .s
  27
  28 # The procedure below centers the square on a given position.
  29
  30 proc center {x y} {
  31     set a [.s size]
  32     .s position [expr $x-($a/2)] [expr $y-($a/2)]
  33 }
  34
  35 # The procedures below provide a simple form of animation where
  36 # the box changes size in a pulsing pattern: larger, smaller, larger,
  37 # and so on.
  38
  39 set inc 0
  40 proc animate {} {
  41     global inc
  42     if {$inc == 0} {
  43         set inc 3
  44         timer
  45     } else {
  46         set inc 0
  47     }
  48 }
  49
  50 proc timer {} {
  51     global inc
  52     set s [.s size]
  53     if {$inc == 0} return
  54     if {$s >= 40} {set inc -3}
  55     if {$s <= 10} {set inc 3}
  56     .s size [expr {$s+$inc}]
  57     after 30 timer
  58 }
  59
  60 # Local Variables:
  61 # mode: tcl
  62 # End: