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

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

通讯编程

开发平台：

Visual C++

visual.test：源码内容
  1. # This file is a Tcl script to test the visual- and colormap-handling
  2. # procedures in the file tkVisual.c.  It is organized in the standard
  3. # fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1994 The Regents of the University of California.
  6. # Copyright (c) 1994-1995 Sun Microsystems, Inc.
  7. # Copyright (c) 1998-1999 by Scriptics Corporation.
  8. # All rights reserved.
  9. #
  10. # RCS: @(#) $Id: visual.test,v 1.6 2002/07/14 05:48:46 dgp Exp $
  12. package require tcltest 2.1
  13. namespace import -force tcltest::configure
  14. namespace import -force tcltest::testsDirectory
  15. configure -testdir [file join [pwd] [file dirname [info script]]]
  16. configure -loadfile [file join [testsDirectory] constraints.tcl]
  17. tcltest::loadTestedCommands
  19. update
  21. # eatColors --
  22. # Creates a toplevel window and allocates enough colors in it to
  23. # use up all the slots in the colormap.
  24. #
  25. # Arguments:
  26. # w - Name of toplevel window to create.
  28. proc eatColors {w} {
  29.     catch {destroy $w}
  30.     toplevel $w
  31.     wm geom $w +0+0
  32.     canvas $w.c -width 400 -height 200 -bd 0
  33.     pack $w.c
  34.     for {set y 0} {$y < 8} {incr y} {
  35. for {set x 0} {$x < 40} {incr x} {
  36.     set color [format #%02x%02x%02x [expr $x*6] [expr $y*30] 0]
  37.     $w.c create rectangle [expr 10*$x] [expr 20*$y] 
  38.     [expr 10*$x + 10] [expr 20*$y + 20] -outline {} 
  39.     -fill $color
  40. }
  41.     }
  42.     update
  43. }
  45. # colorsFree --
  46. #
  47. # Returns 1 if there appear to be free colormap entries in a window,
  48. # 0 otherwise.
  49. #
  50. # Arguments:
  51. # w - Name of window in which to check.
  52. # red, green, blue - Intensities to use in a trial color allocation
  53. # to see if there are colormap entries free.
  55. proc colorsFree {w {red 31} {green 245} {blue 192}} {
  56.     set vals [winfo rgb $w [format #%02x%02x%02x $red $green $blue]]
  57.     expr ([lindex $vals 0]/256 == $red) && ([lindex $vals 1]/256 == $green) 
  58.     && ([lindex $vals 2]/256 == $blue)
  59. }
  61. # If more than one visual type is available for the screen, pick one
  62. # that is *not* the default.
  64. set default "[winfo visual .] [winfo depth .]"
  65. set avail [winfo visualsavailable .]
  66. set other {}
  67. if {[llength $avail] > 1} {
  68.     foreach visual $avail {
  69. if {$visual != $default} {
  70.     set other $visual
  71.     break
  72. }
  73.     }
  74. }
  76. test visual-1.1 {Tk_GetVisual, copying from other window} {
  77.     list [catch {toplevel .t -visual .foo.bar} msg] $msg
  78. } {1 {bad window path name ".foo.bar"}}
  79. if {$other != ""} {
  80.     test visual-1.2 {Tk_GetVisual, copying from other window} {nonPortable} {
  81. catch {destroy .t1}
  82. catch {destroy .t2}
  83. toplevel .t1 -width 250 -height 100 -visual $other
  84. wm geom .t1 +0+0
  85. toplevel .t2 -width 200 -height 80 -visual .t1
  86. wm geom .t2 +5+5
  87. concat "[winfo visual .t2] [winfo depth .t2]"
  88.     } $other
  89.     test visual-1.3 {Tk_GetVisual, copying from other window} {
  90. catch {destroy .t1}
  91. catch {destroy .t2}
  92. toplevel .t1 -width 250 -height 100 -visual $other
  93. wm geom .t1 +0+0
  94. toplevel .t2 -width 200 -height 80 -visual .
  95. wm geom .t2 +5+5
  96. concat "[winfo visual .t2] [winfo depth .t2]"
  97.     } $default
  99.     # Make sure reference count is incremented when copying visual (the
  100.     # following test will cause the colormap to be freed prematurely if
  101.     # the reference count isn't incremented).
  102.     test visual-1.4 {Tk_GetVisual, colormap reference count} {
  103. catch {destroy .t1}
  104. catch {destroy .t2}
  105. toplevel .t1 -width 250 -height 100 -visual $other
  106. wm geom .t1 +0+0
  107. set result [list [catch {toplevel .t2 -gorp 80 -visual .t1} msg] $msg]
  108. update
  109. set result
  110.     } {1 {unknown option "-gorp"}}
  111. }
  112. test visual-1.5 {Tk_GetVisual, default colormap} {
  113.     catch {destroy .t1}
  114.     toplevel .t1 -width 250 -height 100 -visual default
  115.     wm geometry .t1 +0+0
  116.     update
  117.     concat "[winfo visual .t1] [winfo depth .t1]"
  118. } $default
  120. set i 1
  121. foreach visual $avail {
  122.     test visual-2.$i {Tk_GetVisual, different visual types} {nonPortable} {
  123. catch {destroy .t1}
  124. toplevel .t1 -width 250 -height 100 -visual $visual
  125. wm geometry .t1 +0+0
  126. update
  127. concat "[winfo visual .t1] [winfo depth .t1]"
  128.     } $visual
  129.     incr i
  130. }
  132. test visual-3.1 {Tk_GetVisual, parsing visual string} {
  133.     catch {destroy .t1}
  134.     toplevel .t1 -width 250 -height 100 
  135.     -visual "[winfo visual .][winfo depth .]"
  136.     wm geometry .t1 +0+0
  137.     update
  138.     concat "[winfo visual .t1] [winfo depth .t1]"
  139. } $default
  140. test visual-3.2 {Tk_GetVisual, parsing visual string} {
  141.     catch {destroy .t1}
  142.     list [catch {
  143. toplevel .t1 -width 250 -height 100 -visual goop20
  144. wm geometry .t1 +0+0
  145.     } msg] $msg
  146. } {1 {unknown or ambiguous visual name "goop20": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
  147. test visual-3.3 {Tk_GetVisual, parsing visual string} {
  148.     catch {destroy .t1}
  149.     list [catch {
  150. toplevel .t1 -width 250 -height 100 -visual d
  151. wm geometry .t1 +0+0
  152.     } msg] $msg
  153. } {1 {unknown or ambiguous visual name "d": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
  154. test visual-3.4 {Tk_GetVisual, parsing visual string} {
  155.     catch {destroy .t1}
  156.     list [catch {
  157. toplevel .t1 -width 250 -height 100 -visual static
  158. wm geometry .t1 +0+0
  159.     } msg] $msg
  160. } {1 {unknown or ambiguous visual name "static": class must be best, directcolor, grayscale, greyscale, pseudocolor, staticcolor, staticgray, staticgrey, truecolor, or default}}
  161. test visual-3.5 {Tk_GetVisual, parsing visual string} {
  162.     catch {destroy .t1}
  163.     list [catch {
  164. toplevel .t1 -width 250 -height 100 -visual "pseudocolor 48x"
  165. wm geometry .t1 +0+0
  166.     } msg] $msg
  167. } {1 {expected integer but got "48x"}}
  169. if {$other != ""} {
  170.     catch {destroy .t1}
  171.     catch {destroy .t2}
  172.     catch {destroy .t3}
  173.     toplevel .t1 -width 250 -height 100 -visual $other
  174.     wm geom .t1 +0+0
  175.     toplevel .t2 -width 200 -height 80 -visual [winfo visual .]
  176.     wm geom .t2 +5+5
  177.     toplevel .t3 -width 150 -height 250 -visual [winfo visual .t1]
  178.     wm geom .t3 +10+10
  179.     test visual-4.1 {Tk_GetVisual, numerical visual id} nonPortable {
  180. list [winfo visualid .t2] [winfo visualid .t3]
  181.     } [list [winfo visualid .] [winfo visualid .t1]]
  182.     destroy .t1 .t2 .t3
  183. }
  184. test visual-4.2 {Tk_GetVisual, numerical visual id} {
  185.     catch {destroy .t1}
  186.     list [catch {toplevel .t1 -visual 12xyz} msg] $msg
  187. } {1 {bad X identifier for visual: 12xyz"}}
  188. test visual-4.3 {Tk_GetVisual, numerical visual id} {
  189.     catch {destroy .t1}
  190.     list [catch {toplevel .t1 -visual 1291673} msg] $msg
  191. } {1 {couldn't find an appropriate visual}}
  193. if ![string match *pseudocolor* $avail] {
  194.     test visual-5.1 {Tk_GetVisual, no matching visual} {
  195. catch {destroy .t1}
  196. list [catch {
  197.     toplevel .t1 -width 250 -height 100 -visual "pseudocolor 8"
  198.     wm geometry .t1 +0+0
  199. } msg] $msg
  200.     } {1 {couldn't find an appropriate visual}}
  201. }
  203. if {[string match *pseudocolor* $avail] && ([llength $avail] > 1)} {
  204.     test visual-6.1 {Tk_GetVisual, no matching visual} {nonPortable} {
  205. catch {destroy .t1}
  206. toplevel .t1 -width 250 -height 100 -visual "best"
  207. wm geometry .t1 +0+0
  208. update
  209. winfo visual .t1
  210.     } {pseudocolor}
  211. }
  213. # These tests are non-portable due to variations in how many colors
  214. # are already in use on the screen.
  216. if {([winfo visual .] == "pseudocolor") && ([winfo depth .] == 8)} {
  217.     eatColors .t1
  218.     test visual-7.1 {Tk_GetColormap, "new"} {nonPortable} {
  219. toplevel .t2 -width 30 -height 20
  220. wm geom .t2 +0+0
  221. update
  222. colorsFree .t2
  223.     } {0}
  224.     test visual-7.2 {Tk_GetColormap, "new"} {nonPortable} {
  225. catch {destroy .t2}
  226. toplevel .t2 -width 30 -height 20 -colormap new
  227. wm geom .t2 +0+0
  228. update
  229. colorsFree .t2
  230.     } {1}
  231.     test visual-7.3 {Tk_GetColormap, copy from other window} {nonPortable} {
  232. catch {destroy .t2}
  233. toplevel .t3 -width 400 -height 50 -colormap new
  234. wm geom .t3 +0+0
  235. catch {destroy .t2}
  236. toplevel .t2 -width 30 -height 20 -colormap .t3
  237. wm geom .t2 +0+0
  238. update
  239. destroy .t3
  240. colorsFree .t2
  241.     } {1}
  242.     test visual-7.4 {Tk_GetColormap, copy from other window} {nonPortable} {
  243. catch {destroy .t2}
  244. toplevel .t3 -width 400 -height 50 -colormap new
  245. wm geom .t3 +0+0
  246. catch {destroy .t2}
  247. toplevel .t2 -width 30 -height 20 -colormap .
  248. wm geom .t2 +0+0
  249. update
  250. destroy .t3
  251. colorsFree .t2
  252.     } {0}
  253.     test visual-7.5 {Tk_GetColormap, copy from other window} {nonPortable} {
  254. catch {destroy .t1}
  255. list [catch {toplevel .t1 -width 400 -height 50 
  256. -colormap .choke.lots} msg] $msg
  257.     } {1 {bad window path name ".choke.lots"}}
  258.     if {$other != {}} {
  259. test visual-7.6 {Tk_GetColormap, copy from other window} {nonPortable} {
  260.     catch {destroy .t1}
  261.     catch {destroy .t2}
  262.     toplevel .t1 -width 300 -height 150 -visual $other
  263.     wm geometry .t1 +0+0
  264.     list [catch {toplevel .t2 -width 400 -height 50 
  265.     -colormap .t1} msg] $msg
  266. } {1 {can't use colormap for .t1: incompatible visuals}}
  267.     }
  268.     catch {destroy .t1}
  269.     catch {destroy .t2}
  270. }
  272. test visual-8.1 {Tk_FreeColormap procedure} {
  273.     deleteWindows
  274.     toplevel .t1 -width 300 -height 180 -colormap new
  275.     wm geometry .t1 +0+0
  276.     foreach i {.t2 .t3 .t4} {
  277. toplevel $i -width 250 -height 150 -colormap .t1
  278. wm geometry $i +0+0
  279.     }
  280.     destroy .t1
  281.     destroy .t3
  282.     destroy .t4
  283.     update
  284. } {}
  285. if {$other != {}} {
  286.     test visual-8.2 {Tk_FreeColormap procedure} {
  287. deleteWindows
  288. toplevel .t1 -width 300 -height 180 -visual $other
  289. wm geometry .t1 +0+0
  290. foreach i {.t2 .t3 .t4} {
  291.     toplevel $i -width 250 -height 150 -visual $other
  292.     wm geometry $i +0+0
  293. }
  294. destroy .t2
  295. destroy .t3
  296. destroy .t4
  297. update
  298.     } {}
  299. }
  301. deleteWindows
  302. rename eatColors {}
  303. rename colorsFree {}
  305. # cleanup
  306. ::tcltest::cleanupTests
  307. return