开通博客赚积分
发布资源赚积分
分类

源码开发语言/平台
当前位置：首页 > 源码/资料 > Windows编程 > 通讯编程 > 查看源码
canvRect.test
资源名称：ns-allinone-2.33.tar.gz　[点击查看]
上传用户：rrhhcc
上传日期：2015-12-11
资源大小：54129k
文件大小：12k
源码类别：

通讯编程

开发平台：

Visual C++

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