1# This file creates a visual test for arcs.  It is part of the Tk
2# visual test suite, which is invoked via the "visual" script.
3#
4# RCS: @(#) $Id$
5
6catch {destroy .t}
7toplevel .t
8wm title .t "Visual Tests for Canvas Arcs"
9wm iconname .t "Arcs"
10wm geom .t +0+0
11wm minsize .t 1 1
12
13canvas .t.c -width 650 -height 600 -relief raised
14pack .t.c -expand yes -fill both
15button .t.quit -text Quit -command {destroy .t}
16pack .t.quit -side bottom -pady 3 -ipadx 4 -ipady 2
17
18puts "depth is [winfo depth .t]"
19if {[winfo depth .t] > 1} {
20    set fill1 aquamarine3
21    set fill2 aquamarine3
22    set fill3 IndianRed1
23    set outline2 IndianRed3
24} else {
25    set fill1 black
26    set fill2 white
27    set fill3 Black
28    set outline2 white
29}
30set outline black
31
32.t.c create arc 20 20 220 120 -start 30 -extent 270 -outline $fill1 -width 14 \
33	-style arc
34.t.c create arc 260 20 460 120 -start 30 -extent 270 -fill $fill2 -width 14 \
35	-style chord -outline $outline
36.t.c create arc 500 20 620 160 -start 30 -extent 270 -fill {} -width 14 \
37	-style chord -outline $outline -outlinestipple gray50
38.t.c create arc 20 260 140 460 -start 45 -extent 90 -fill $fill2 -width 14 \
39	-style pieslice -outline $outline
40.t.c create arc 180 260 300 460 -start 45 -extent 90 -fill {} -width 14 \
41	-style pieslice -outline $outline
42.t.c create arc 340 260 460 460 -start 30 -extent 150 -fill $fill2 -width 14 \
43	-style chord -outline $outline -stipple gray50 -outlinestipple gray25
44.t.c create arc 500 260 620 460 -start 30 -extent 150 -fill {} -width 14 \
45	-style chord -outline $outline
46.t.c create arc 20 450 140 570 -start 135 -extent 270 -fill $fill1 -width 14 \
47	-style pieslice -outline {}
48.t.c create arc 180 450 300 570 -start 30 -extent -90 -fill $fill1 -width 14 \
49	-style pieslice -outline {}
50.t.c create arc 340 450 460 570 -start 320 -extent 270 -fill $fill1 -width 14 \
51	-style chord -outline {}
52.t.c create arc 500 450 620 570 -start 350 -extent -110 -fill $fill1 -width 14 \
53	-style chord -outline {}
54.t.c addtag arc withtag all
55.t.c addtag circle withtag [.t.c create oval 320 200 340 220 -fill MistyRose3]
56
57.t.c bind arc <Any-Enter> {
58    set prevFill [lindex [.t.c itemconf current -fill] 4]
59    set prevOutline [lindex [.t.c itemconf current -outline] 4]
60    if {($prevFill != "") || ($prevOutline == "")} {
61	.t.c itemconf current -fill $fill3
62    }
63    if {$prevOutline != ""} {
64	.t.c itemconf current -outline $outline2
65    }
66}
67.t.c bind arc <Any-Leave> {.t.c itemconf current -fill $prevFill -outline $prevOutline}
68
69bind .t.c <1> {markarea %x %y}
70bind .t.c <B1-Motion> {strokearea %x %y}
71
72proc markarea {x y} {
73    global areaX1 areaY1
74    set areaX1 $x
75    set areaY1 $y
76}
77
78proc strokearea {x y} {
79    global areaX1 areaY1 areaX2 areaY2
80    if {($areaX1 != $x) && ($areaY1 != $y)} {
81	.t.c delete area
82	.t.c addtag area withtag [.t.c create rect $areaX1 $areaY1 $x $y \
83		-outline black]
84	set areaX2 $x
85	set areaY2 $y
86    }
87}
88
89bind .t.c <Control-f> {
90    puts stdout "Enclosed: [.t.c find enclosed $areaX1 $areaY1 $areaX2 $areaY2]"
91    puts stdout "Overlapping: [.t.c find overl $areaX1 $areaY1 $areaX2 $areaY2]"
92}
93
94bind .t.c <3> {puts stdout "%x %y"}
95
96# The code below allows the circle to be move by shift-dragging.
97
98bind .t.c <Shift-1> {
99    set curx %x
100    set cury %y
101}
102
103bind .t.c <Shift-B1-Motion> {
104    .t.c move circle [expr %x-$curx] [expr %y-$cury]
105    set curx %x
106    set cury %y
107}
108
109# The binding below flashes the closest item to the mouse.
110
111bind .t.c <Control-c> {
112    set closest [.t.c find closest %x %y]
113    set oldfill [lindex [.t.c itemconf $closest -fill] 4]
114    .t.c itemconf $closest -fill IndianRed1
115    after 200 [list .t.c itemconfig $closest -fill $oldfill]
116}
117
118proc c {option value} {.t.c itemconf 2 $option $value}
119
120bind .t.c a {
121    set go 1
122    set i 1
123    while {$go} {
124	if {$i >= 50} {
125	    set delta -5
126	}
127	if {$i <= 5} {
128	    set delta 5
129	}
130	incr i $delta
131	c -start $i
132	c -extent [expr 360-2*$i]
133	after 20
134	update
135    }
136}
137
138bind .t.c b {set go 0}
139
140bind .t.c <Control-x> {.t.c delete current}
141
142
143
144
145
146
147
148
149
150
151
152
153
154