summaryrefslogtreecommitdiffstats
path: root/library/demos/square
blob: b7dd78fa0aea29f6d18f6ac6a2f35ab2de837bcf (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
#!/bin/sh
# the next line restarts using wish \
exec wish "$0" "$@"

# square --
# This script generates a demo application containing only a "square"
# widget.  It's only usable in the "tktest" application or if Tk has
# been compiled with tkSquare.c. This demo arranges the following
# bindings for the widget:
# 
# Button-1 press/drag:		moves square to mouse
# "a":				toggle size animation on/off

package require Tk		;# We use Tk generally, and...
package require Tktest		;# ... we use the square widget too.

square .s
pack .s -expand yes -fill both
wm minsize . 1 1

bind .s <1> {center %x %y}
bind .s <B1-Motion> {center %x %y}
bind .s a animate
focus .s

# The procedure below centers the square on a given position.

proc center {x y} {
    set a [.s size]
    .s position [expr $x-($a/2)] [expr $y-($a/2)]
}

# The procedures below provide a simple form of animation where
# the box changes size in a pulsing pattern: larger, smaller, larger,
# and so on.

set inc 0
proc animate {} {
    global inc
    if {$inc == 0} {
	set inc 3
	timer
    } else {
	set inc 0
    }
}

proc timer {} {
    global inc
    set s [.s size]
    if {$inc == 0} return
    if {$s >= 40} {set inc -3}
    if {$s <= 10} {set inc 3}
    .s size [expr {$s+$inc}]
    after 30 timer
}

# Local Variables:
# mode: tcl
# End: