OpenCores
URL https://opencores.org/ocsvn/or1k/or1k/trunk

Subversion Repositories or1k

[/] [or1k/] [tags/] [start/] [insight/] [tk/] [tests/] [canvRect.test] - Blame information for rev 1780

Go to most recent revision | Details | Compare with Previous | View Log

Line No. Rev Author Line
1 578 markom 
# This file is a Tcl script to test out the procedures in tkRectOval.c,
2 
# which implement canvas "rectangle" and "oval" items.  It is organized
3 
# in the standard fashion for Tcl tests.
4 
#
5 
# Copyright (c) 1994-1996 Sun Microsystems, Inc.
6 
#
7 
# See the file "license.terms" for information on usage and redistribution
8 
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
9 
#
10 
# RCS: @(#) $Id: canvRect.test,v 1.1.1.1 2002-01-16 10:25:58 markom Exp $
11 
 
12 
if {[info procs test] != "test"} {
13 
    source defs
14 
}
15 
 
16 
foreach i [winfo children .] {
17 
    destroy $i
18 
}
19 
wm geometry . {}
20 
raise .
21 
 
22 
canvas .c -width 400 -height 300 -bd 2 -relief sunken
23 
pack .c
24 
bind .c <1> {
25 
    puts "button down at (%x,%y)"
26 
}
27 
update
28 
 
29 
set i 1
30 
.c create rectangle 20 20 80 80 -tag test
31 
foreach test {
32 
    {-fill #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
33 
    {-outline #123456 #123456 bad_color {unknown color name "bad_color"}}
34 
    {-stipple gray50 gray50 bogus {bitmap "bogus" not defined}}
35 
    {-tags {test a b c} {test a b c} {} {}}
36 
    {-width 6 6 abc {bad screen distance "abc"}}
37 
} {
38 
    set name [lindex $test 0]
39 
    test canvRect-1.$i {configuration options} {
40 
        .c itemconfigure test $name [lindex $test 1]
41 
        list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
42 
    } [list [lindex $test 2] [lindex $test 2]]
43 
    incr i
44 
    if {[lindex $test 3] != ""} {
45 
        test canvRect-1.$i {configuration options} {
46 
            list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
47 
        } [list 1 [lindex $test 4]]
48 
    }
49 
    incr i
50 
}
51 
test canvRect-1.$i {configuration options} {
52 
    .c itemconfigure test -tags {test xyz}
53 
    .c itemcget xyz -tags
54 
} {test xyz}
55 
 
56 
test canvRect-2.1 {CreateRectOval procedure} {
57 
    list [catch {.c create rect} msg] $msg
58 
} {1 {wrong # args: should be ".c create rectangle x1 y1 x2 y2 ?options?"}}
59 
test canvRect-2.2 {CreateRectOval procedure} {
60 
    list [catch {.c create oval x y z} msg] $msg
61 
} {1 {wrong # args: should be ".c create oval x1 y1 x2 y2 ?options?"}}
62 
test canvRect-2.3 {CreateRectOval procedure} {
63 
    list [catch {.c create rectangle x 2 3 4} msg] $msg
64 
} {1 {bad screen distance "x"}}
65 
test canvRect-2.4 {CreateRectOval procedure} {
66 
    list [catch {.c create rectangle 1 y 3 4} msg] $msg
67 
} {1 {bad screen distance "y"}}
68 
test canvRect-2.5 {CreateRectOval procedure} {
69 
    list [catch {.c create rectangle 1 2 z 4} msg] $msg
70 
} {1 {bad screen distance "z"}}
71 
test canvRect-2.6 {CreateRectOval procedure} {
72 
    list [catch {.c create rectangle 1 2 3 q} msg] $msg
73 
} {1 {bad screen distance "q"}}
74 
test canvRect-2.7 {CreateRectOval procedure} {
75 
    .c create rectangle 1 2 3 4 -tags x
76 
    set result {}
77 
    foreach element [.c coords x] {
78 
        lappend result [format %.1f $element]
79 
    }
80 
    set result
81 
} {1.0 2.0 3.0 4.0}
82 
test canvRect-2.8 {CreateRectOval procedure} {
83 
    list [catch {.c create rectangle 1 2 3 4 -gorp foo} msg] $msg
84 
} {1 {unknown option "-gorp"}}
85 
 
86 
.c delete withtag all
87 
.c create rectangle 10 20 30 40 -tags x
88 
test canvRect-3.1 {RectOvalCoords procedure} {
89 
    set result {}
90 
    foreach element [.c coords x] {
91 
        lappend result [format %.1f $element]
92 
    }
93 
    set result
94 
} {10.0 20.0 30.0 40.0}
95 
test canvRect-3.2 {RectOvalCoords procedure} {
96 
    list [catch {.c coords x a 2 3 4} msg] $msg
97 
} {1 {bad screen distance "a"}}
98 
test canvRect-3.3 {RectOvalCoords procedure} {
99 
    list [catch {.c coords x 1 b 3 4} msg] $msg
100 
} {1 {bad screen distance "b"}}
101 
test canvRect-3.4 {RectOvalCoords procedure} {
102 
    list [catch {.c coords x 1 2 c 4} msg] $msg
103 
} {1 {bad screen distance "c"}}
104 
test canvRect-3.5 {RectOvalCoords procedure} {
105 
    list [catch {.c coords x 1 2 3 d} msg] $msg
106 
} {1 {bad screen distance "d"}}
107 
test canvRect-3.6 {RectOvalCoords procedure} {nonPortable} {
108 
    # Non-portable due to rounding differences.
109 
    .c coords x 10 25 15 40
110 
    .c bbox x
111 
} {9 24 16 41}
112 
test canvRect-3.7 {RectOvalCoords procedure} {
113 
    list [catch {.c coords x 1 2 3 4 5} msg] $msg
114 
} {1 {wrong # coordinates: expected 0 or 4, got 5}}
115 
 
116 
.c delete withtag all
117 
.c create rectangle 10 20 30 40 -tags x -width 1
118 
test canvRect-4.1 {ConfigureRectOval procedure} {
119 
    list [catch {.c itemconfigure x -width abc} msg] $msg \
120 
            [.c itemcget x -width]
121 
} {1 {bad screen distance "abc"} 1}
122 
test canvRect-4.2 {ConfigureRectOval procedure} {
123 
    .c itemconfigure x -width -5
124 
    .c itemcget x -width
125 
} {1}
126 
test canvRect-4.3 {ConfigureRectOval procedure} {nonPortable} {
127 
    # Non-portable due to rounding differences.
128 
    .c itemconfigure x -width 10
129 
    .c bbox x
130 
} {5 15 35 45}
131 
# I can't come up with any good tests for DeleteRectOval.
132 
 
133 
.c delete withtag all
134 
.c create rectangle 10 20 30 40 -tags x -width 1 -outline {}
135 
test canvRect-5.1 {ComputeRectOvalBbox procedure} {nonPortable} {
136 
    # Non-portable due to rounding differences:
137 
    .c coords x 20 15 10 5
138 
    .c bbox x
139 
} {10 5 20 15}
140 
test canvRect-5.2 {ComputeRectOvalBbox procedure} {nonPortable} {
141 
    # Non-portable due to rounding differences:
142 
    .c coords x 10 20 30 10
143 
    .c itemconfigure x -width 1 -outline red
144 
    .c bbox x
145 
} {9 9 31 21}
146 
test canvRect-5.3 {ComputeRectOvalBbox procedure} {nonPortable} {
147 
    # Non-portable due to rounding differences:
148 
    .c coords x 10 20 30 10
149 
    .c itemconfigure x -width 2 -outline red
150 
    .c bbox x
151 
} {9 9 31 21}
152 
test canvRect-5.4 {ComputeRectOvalBbox procedure} {nonPortable} {
153 
    # Non-portable due to rounding differences:
154 
    .c coords x 10 20 30 10
155 
    .c itemconfigure x -width 3 -outline red
156 
    .c bbox x
157 
} {8 8 32 22}
158 
 
159 
# I can't come up with any good tests for DisplayRectOval.
160 
 
161 
.c delete withtag all
162 
set x  [.c create rectangle 10 20 30 35 -tags x -fill green]
163 
set y [.c create rectangle 15 25 25 30  -tags y -fill red]
164 
test canvRect-6.1 {RectToPoint procedure} {
165 
    .c itemconfigure y -outline {}
166 
    list [.c find closest 14.9 28] [.c find closest 15.1 28] \
167 
            [.c find closest 24.9 28] [.c find closest 25.1 28]
168 
} "$x $y $y $x"
169 
test canvRect-6.2 {RectToPoint procedure} {
170 
    .c itemconfigure y -outline {}
171 
    list [.c find closest 20 24.9] [.c find closest 20 25.1] \
172 
            [.c find closest 20 29.9]  [.c find closest 20 30.1]
173 
} "$x $y $y $x"
174 
test canvRect-6.3 {RectToPoint procedure} {
175 
    .c itemconfigure y -width 1 -outline black
176 
    list [.c find closest 14.4 28] [.c find closest 14.6 28] \
177 
            [.c find closest 25.4 28] [.c find closest 25.6 28]
178 
} "$x $y $y $x"
179 
test canvRect-6.4 {RectToPoint procedure} {
180 
    .c itemconfigure  y -width 1 -outline black
181 
    list [.c find closest 20 24.4] [.c find closest 20 24.6] \
182 
            [.c find closest 20 30.4] [.c find closest 20 30.6]
183 
} "$x $y $y $x"
184 
.c itemconfigure x -fill {} -outline black -width 3
185 
.c itemconfigure y -outline {}
186 
test canvRect-6.5 {RectToPoint procedure} {
187 
    list [.c find closest 13.2 28] [.c find closest 13.3 28] \
188 
            [.c find closest 26.7 28] [.c find closest 26.8 28]
189 
} "$x $y $y $x"
190 
test canvRect-6.6 {RectToPoint procedure} {
191 
    list [.c find closest 20 23.2] [.c find closest 20 23.3] \
192 
            [.c find closest 20 31.7] [.c find closest 20 31.8]
193 
} "$x $y $y $x"
194 
.c delete withtag all
195 
set x [.c create rectangle 10 20 30 40 -outline {} -fill black]
196 
set y [.c create rectangle 40 40 50 50 -outline {} -fill black]
197 
test canvRect-6.7 {RectToPoint procedure} {
198 
    list [.c find closest 35 35] [.c find closest 36 36] \
199 
            [.c find closest 37 37] [.c find closest 38 38]
200 
} "$x $y $y $y"
201 
 
202 
.c delete withtag all
203 
set x  [.c create rectangle 10 20 30 35 -fill green -outline {}]
204 
set y [.c create rectangle 40 45 60 70 -fill red -outline black -width 3]
205 
set z [.c create rectangle 100 150 120 170 -fill {} -outline black -width 3]
206 
test canvRect-7.1 {RectToArea procedure} {
207 
    list [.c find overlapping 20 50 38 60] \
208 
            [.c find overlapping 20 50 39 60] \
209 
            [.c find overlapping 20 50 70 60] \
210 
            [.c find overlapping 61 50 70 60] \
211 
            [.c find overlapping 62 50 70 60]
212 
} "{} $y $y $y {}"
213 
test canvRect-7.2 {RectToArea procedure} {
214 
    list [.c find overlapping 45 20 55 43] \
215 
            [.c find overlapping 45 20 55 44] \
216 
            [.c find overlapping 45 20 55 80] \
217 
            [.c find overlapping 45 71 55 80] \
218 
            [.c find overlapping 45 72 55 80]
219 
} "{} $y $y $y {}"
220 
test canvRect-7.3 {RectToArea procedure} {
221 
    list [.c find overlapping 5 25 9.9 30] [.c find overlapping 5 25 10.1 30]
222 
} "{} $x"
223 
test canvRect-7.4 {RectToArea procedure} {
224 
    list [.c find overlapping 102 152 118 168] \
225 
            [.c find overlapping 101 152 118 168] \
226 
            [.c find overlapping 102 151 118 168] \
227 
            [.c find overlapping 102 152 119 168] \
228 
            [.c find overlapping 102 152 118 169]
229 
} "{} $z $z $z $z"
230 
test canvRect-7.5 {RectToArea procedure} {
231 
    list [.c find enclosed 20 40 38 80] \
232 
            [.c find enclosed 20 40 39 80] \
233 
            [.c find enclosed 20 40 70 80] \
234 
            [.c find enclosed 61 40 70 80] \
235 
            [.c find enclosed 62 40 70 80]
236 
} "{} {} $y {} {}"
237 
test canvRect-7.6 {RectToArea procedure} {
238 
    list [.c find enclosed 20 20 65 43] \
239 
            [.c find enclosed 20 20 65 44] \
240 
            [.c find enclosed 20 20 65 80] \
241 
            [.c find enclosed 20 71 65 80] \
242 
            [.c find enclosed 20 72 65 80]
243 
} "{} {} $y {} {}"
244 
 
245 
.c delete withtag all
246 
set x  [.c create oval 50 100 200 150 -fill green -outline {}]
247 
set y [.c create oval 50 100 200 150 -fill red -outline black -width 3]
248 
set z [.c create oval 50 100 200 150 -fill {} -outline black -width 3]
249 
test canvRect-8.1 {OvalToArea procedure} {
250 
    list [.c find overlapping 20 120 48 130] \
251 
            [.c find overlapping 20 120 49 130] \
252 
            [.c find overlapping 20 120 50.2 130] \
253 
            [.c find overlapping 20 120 300 130] \
254 
            [.c find overlapping 60 120 190 130] \
255 
            [.c find overlapping 199.9 120 300 130] \
256 
            [.c find overlapping 201 120 300 130] \
257 
            [.c find overlapping 202 120 300 130]
258 
} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}"
259 
test canvRect-8.2 {OvalToArea procedure} {
260 
    list [.c find overlapping 100 50 150 98] \
261 
            [.c find overlapping 100 50 150 99] \
262 
            [.c find overlapping 100 50 150 100.1] \
263 
            [.c find overlapping 100 50 150 200] \
264 
            [.c find overlapping 100 110 150 140] \
265 
            [.c find overlapping 100 149.9 150 200] \
266 
            [.c find overlapping 100 151 150 200] \
267 
            [.c find overlapping 100 152 150 200]
268 
} "{} {$y $z} {$x $y $z} {$x $y $z} {$x $y} {$x $y $z} {$y $z} {}"
269 
test canvRect-8.3 {OvalToArea procedure} {
270 
    list [.c find overlapping 176 104 177 105] \
271 
            [.c find overlapping 187 116 188 117] \
272 
            [.c find overlapping 192 142 193 143] \
273 
            [.c find overlapping 180 138 181 139] \
274 
            [.c find overlapping 61 142 62 143] \
275 
            [.c find overlapping 65 137 66 136] \
276 
            [.c find overlapping 62 108 63 109] \
277 
            [.c find overlapping 68 115 69 116]
278 
} "{} {$x $y} {} {$x $y} {} {$x $y} {} {$x $y}"
279 
 
280 
test canvRect-9.1 {ScaleRectOval procedure} {
281 
    .c delete withtag all
282 
    .c create rect 100 300 200 350 -tags x
283 
    .c scale x 50 100 2 4
284 
    .c coords x
285 
} {150.0 900.0 350.0 1100.0}
286 
 
287 
test canvRect-10.1 {TranslateRectOval procedure} {
288 
    .c delete withtag all
289 
    .c create rect 100 300 200 350 -tags x
290 
    .c move x 100 -10
291 
    .c coords x
292 
} {200.0 290.0 300.0 340.0}
293 
 
294 
# This test is non-portable because different color information
295 
# will get generated on different displays (e.g. mono displays
296 
# vs. color).
297 
test canvRect-11.1 {RectOvalToPostscript procedure} {nonPortable win32sCrash macCrash} {
298 
    # Crashes on Mac because the XGetImage() call isn't implemented, causing a
299 
    # dereference of NULL.
300 
 
301 
    .c configure -bd 0 -highlightthickness 0
302 
    .c delete withtag all
303 
    .c create rect 50 60 90 80 -fill black -stipple gray50 -outline {}
304 
    .c create oval 100 150 200 200 -fill {} -outline #ff0000 -width 5
305 
    update
306 
    set x [.c postscript]
307 
    string range $x [string first "-200 -150 translate" $x] end
308 
} {-200 -150 translate
309 
 
310 
gsave
311 
50 240 moveto 40 0 rlineto 0 -20 rlineto -40 0 rlineto closepath
312 
0.000 0.000 0.000 setrgbcolor AdjustColor
313 
clip 16 16 <5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555aaaa5555
314 
aaaa> StippleFill
315 
grestore
316 
gsave
317 
matrix currentmatrix
318 
150 125 translate 50 25 scale 1 0 moveto 0 0 1 0 360 arc
319 
setmatrix
320 
5 setlinewidth 0 setlinejoin 2 setlinecap
321 
1.000 0.000 0.000 setrgbcolor AdjustColor
322 
stroke
323 
grestore
324 
restore showpage
325 
 
326 
%%Trailer
327 
end
328 
%%EOF
329 
}

powered by: WebSVN 2.1.0

© copyright 1999-2024 OpenCores.org, equivalent to Oliscience, all rights reserved. OpenCores®, registered trademark.