Commit | Line | Data |
---|---|---|
920dae64 AT |
1 | #!/bin/sh |
2 | # the next line restarts using wish \ | |
3 | exec wish8.4 "$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 | } |