home *** CD-ROM | disk | FTP | other *** search
/ Ultra Pack / UltraComputing Partner Applications.iso / SunLabs / tclTK / src / tk4.0 / tests / canvas.test < prev    next >
Encoding:
Text File  |  1995-05-29  |  5.6 KB  |  180 lines
  1. # This file is a Tcl script to test out the procedures in tkCanvas.c,
  2. # which implements generic code for canvases.  It is organized in the
  3. # standard fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1995 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. # @(#) canvas.test 1.5 95/05/28 17:03:28
  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. # XXX - This test file is woefully incomplete.  At present, only a
  23. # few of the features are tested.
  24.  
  25. canvas .c
  26. pack .c
  27. update
  28. set i 1
  29. foreach test {
  30.     {-background #ff0000 #ff0000 non-existent
  31.         {unknown color name "non-existent"}}
  32.     {-bg #ff0000 #ff0000 non-existent {unknown color name "non-existent"}}
  33.     {-bd 4 4 badValue {bad screen distance "badValue"}}
  34.     {-borderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  35.     {-closeenough 24 24.0 bogus {expected floating-point number but got "bogus"}}
  36.     {-confine true 1 silly {expected boolean value but got "silly"}}
  37.     {-cursor arrow arrow badValue {bad cursor spec "badValue"}}
  38.     {-height 2.1 2 x42 {bad screen distance "x42"}}
  39.     {-highlightbackground #112233 #112233 ugly {unknown color name "ugly"}}
  40.     {-highlightcolor #110022 #110022 bogus {unknown color name "bogus"}}
  41.     {-highlightthickness 18 18 badValue {bad screen distance "badValue"}}
  42.     {-insertbackground #110022 #110022 bogus {unknown color name "bogus"}}
  43.     {-insertborderwidth 1.3 1 2.6x {bad screen distance "2.6x"}}
  44.     {-insertofftime 100 100 3.2 {expected integer but got "3.2"}}
  45.     {-insertontime 100 100 3.2 {expected integer but got "3.2"}}
  46.     {-insertwidth 1.3 1 6x {bad screen distance "6x"}}
  47.     {-relief groove groove 1.5 {bad relief type "1.5":  must be flat, groove, raised, ridge, or sunken}}
  48.     {-selectbackground #110022 #110022 bogus {unknown color name "bogus"}}
  49.     {-selectborderwidth 1.3 1 badValue {bad screen distance "badValue"}}
  50.     {-selectforeground #654321 #654321 bogus {unknown color name "bogus"}}
  51.     {-takefocus "any string" "any string" {} {}}
  52.     {-width 402 402 xyz {bad screen distance "xyz"}}
  53.     {-xscrollcommand {Some command} {Some command} {} {}}
  54.     {-yscrollcommand {Another command} {Another command} {} {}}
  55. } {
  56.     set name [lindex $test 0]
  57.     test canvas-1.$i {configuration options} {
  58.     .c configure $name [lindex $test 1]
  59.     lindex [.c configure $name] 4
  60.     } [lindex $test 2]
  61.     incr i
  62.     if {[lindex $test 3] != ""} {
  63.     test canvas-1.$i {configuration options} {
  64.         list [catch {.c configure $name [lindex $test 3]} msg] $msg
  65.     } [list 1 [lindex $test 4]]
  66.     }
  67.     .c configure $name [lindex [.c configure $name] 3]
  68.     incr i
  69. }
  70.  
  71.  
  72. catch {destroy .c}
  73. canvas .c -width 60 -height 40 -scrollregion {0 0 200 150} -bd 0 \
  74.     -highlightthickness 0
  75. pack .c
  76. update
  77. test canvas-2.1 {CanvasWidgetCmd, xview option} {
  78.     .c configure -xscrollincrement 40 -yscrollincrement 5
  79.     .c xview moveto 0
  80.     update
  81.     set x [list [.c xview]]
  82.     .c xview scroll 2 units
  83.     update
  84.     lappend x [.c xview]
  85. } {{0 0.3} {0.4 0.7}}
  86. test canvas-2.2 {CanvasWidgetCmd, xview option} {
  87.     .c configure -xscrollincrement 0 -yscrollincrement 5
  88.     .c xview moveto 0.6
  89.     update
  90.     set x [list [.c xview]]
  91.     .c xview scroll 2 units
  92.     update
  93.     lappend x [.c xview]
  94. } {{0.6 0.9} {0.66 0.96}}
  95.  
  96. catch {destroy .c}
  97. canvas .c -width 60 -height 40 -scrollregion {0 0 200 80} \
  98.     -borderwidth 0 -highlightthickness 0
  99. pack .c
  100. update
  101. test canvas-3.1 {CanvasWidgetCmd, yview option} {
  102.     .c configure -xscrollincrement 40 -yscrollincrement 5
  103.     .c yview moveto 0
  104.     update
  105.     set x [list [.c yview]]
  106.     .c yview scroll 3 units
  107.     update
  108.     lappend x [.c yview]
  109. } {{0 0.5} {0.1875 0.6875}}
  110. test canvas-3.2 {CanvasWidgetCmd, yview option} {
  111.     .c configure -xscrollincrement 40 -yscrollincrement 0
  112.     .c yview moveto 0
  113.     update
  114.     set x [list [.c yview]]
  115.     .c yview scroll 2 units
  116.     update
  117.     lappend x [.c yview]
  118. } {{0 0.5} {0.1 0.6}}
  119.  
  120. test canvas-4.1 {ButtonEventProc procedure} {
  121.     eval destroy [winfo children .]
  122.     canvas .c1 -bg #543210
  123.     rename .c1 .c2
  124.     set x {}
  125.     lappend x [winfo children .]
  126.     lappend x [.c2 cget -bg]
  127.     destroy .c1
  128.     lappend x [info command .c*] [winfo children .]
  129. } {.c1 #543210 {} {}}
  130.  
  131. test canvas-5.1 {ButtonCmdDeletedProc procedure} {
  132.     eval destroy [winfo children .]
  133.     canvas .c1
  134.     rename .c1 {}
  135.     list [info command .c*] [winfo children .]
  136. } {{} {}}
  137.  
  138. catch {destroy .c}
  139. canvas .c -width 100 -height 50 -scrollregion {-200 -100 305 102} \
  140.     -borderwidth 2 -highlightthickness 3
  141. pack .c
  142. update
  143. test canvas-6.1 {CanvasSetOrigin procedure} {
  144.     .c configure -xscrollincrement 0 -yscrollincrement 0
  145.     .c xview moveto 0
  146.     .c yview moveto 0
  147.     update
  148.     list [.c canvasx 0] [.c canvasy 0]
  149. } {-205.0 -105.0}
  150. test canvas-6.2 {CanvasSetOrigin procedure} {
  151.     .c configure -xscrollincrement 20 -yscrollincrement 10
  152.     set x ""
  153.     foreach i {.08 .10 .48 .50} {
  154.     .c xview moveto $i
  155.     update
  156.     lappend x [.c canvasx 0]
  157.     }
  158.     set x
  159. } {-165.0 -145.0 35.0 55.0}
  160. test canvas-6.3 {CanvasSetOrigin procedure} {
  161.     .c configure -xscrollincrement 20 -yscrollincrement 10
  162.     set x ""
  163.     foreach i {.06 .08 .70 .72} {
  164.     .c yview moveto $i
  165.     update
  166.     lappend x [.c canvasy 0]
  167.     }
  168.     set x
  169. } {-95.0 -85.0 35.0 45.0}
  170. test canvas-6.4 {CanvasSetOrigin procedure} {
  171.     .c configure -xscrollincrement 20 -yscrollincrement 10
  172.     .c xview moveto 1.0
  173.     .c canvasx 0
  174. } {215.0}
  175. test canvas-6.5 {CanvasSetOrigin procedure} {
  176.     .c configure -xscrollincrement 20 -yscrollincrement 10
  177.     .c yview moveto 1.0
  178.     .c canvasy 0
  179. } {55.0}
  180.