home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 7 / Apprentice-Release7.iso / Source Code / C / Applications / Tcl-Tk 8.0 / Pre-installed version / tk8.0 / tests / canvText.test < prev    next >
Encoding:
Text File  |  1997-08-15  |  15.4 KB  |  493 lines  |  [TEXT/ALFA]
  1. # This file is a Tcl script to test out the procedures in tkCanvText.c,
  2. # which implement canvas "text" items.  It is organized in the standard
  3. # fashion for Tcl tests.
  4. #
  5. # Copyright (c) 1996-1997 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. # SCCS: @(#) canvText.test 1.8 97/06/24 13:34:16
  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. update
  25.  
  26. set i 1
  27. .c create text 20 20 -tag test
  28.  
  29. set font "-adobe-times-medium-r-normal--*-200-*-*-*-*-*-*"
  30. set ay [font metrics $font -linespace]
  31. set ax [font measure $font 0]
  32.  
  33.  
  34. foreach test {
  35.     {-anchor nw nw xyz {bad anchor position "xyz": must be n, ne, e, se, s, sw, w, nw, or center}}
  36.     {-fill #ff0000 #ff0000 xyz {unknown color name "xyz"}}
  37.     {-font {Times 40} {Times 40} {} {font "" doesn't exist}}
  38.     {-justify left left xyz {bad justification "xyz": must be left, right, or center}}
  39.     {-stipple gray50 gray50 xyz {bitmap "xyz" not defined}}
  40.     {-tags {test a b c} {test a b c} {} {}}
  41.     {-text xyz xyz {} {}}
  42.     {-width 6 6 xyz {bad screen distance "xyz"}}
  43. } {
  44.     set name [lindex $test 0]
  45.     test canvText-1.$i {configuration options} {
  46.     .c itemconfigure test $name [lindex $test 1]
  47.     list [lindex [.c itemconfigure test $name] 4] [.c itemcget test $name]
  48.     } [list [lindex $test 2] [lindex $test 2]]
  49.     incr i
  50.     if {[lindex $test 3] != ""} {
  51.     test canvText-1.$i {configuration options} {
  52.         list [catch {.c itemconfigure test $name [lindex $test 3]} msg] $msg
  53.     } [list 1 [lindex $test 4]]
  54.     }
  55.     incr i
  56. }
  57. test canvText-1.$i {configuration options} {
  58.     .c itemconfigure test -tags {test xyz}
  59.     .c itemcget xyz -tags
  60. } {test xyz}
  61.  
  62. .c delete test
  63. .c create text 20 20 -tag test
  64.  
  65. test canvText-2.1 {CreateText procedure: args} {
  66.     list [catch {.c create text} msg] $msg
  67. } {1 {wrong # args: should be ".c create text x y ?options?"}}
  68. test canvText-2.2 {CreateText procedure: args} {
  69.     list [catch {.c create text xyz 0} msg] $msg
  70. } {1 {bad screen distance "xyz"}}
  71. test canvText-2.3 {CreateText procedure: args} {
  72.     list [catch {.c create text 0 xyz} msg] $msg
  73. } {1 {bad screen distance "xyz"}}
  74. test canvText-2.4 {CreateText procedure: args} {
  75.     list [catch {.c create text 0 0 -xyz xyz} msg] $msg
  76. } {1 {unknown option "-xyz"}}
  77. test canvText-2.5 {CreateText procedure} {
  78.     .c create text 0 0 -tags x
  79.     set x [.c coords x]
  80.     .c delete x
  81.     set x
  82. } {0.0 0.0}
  83.  
  84. focus -force .c
  85. .c focus test
  86. .c coords test 0 0
  87. update
  88.  
  89. test canvText-3.1 {TextCoords procedure} {
  90.     .c coords test
  91. } {0.0 0.0}
  92. test canvText-3.2 {TextCoords procedure} {
  93.     list [catch {.c coords test xyz 0} msg] $msg
  94. } {1 {bad screen distance "xyz"}}
  95. test canvText-3.3 {TextCoords procedure} {
  96.     list [catch {.c coords test 0 xyz} msg] $msg
  97. } {1 {bad screen distance "xyz"}}
  98. test canvText-3.4 {TextCoords procedure} {
  99.     .c coords test 10 10
  100.     set result {}
  101.     foreach element [.c coords test] {
  102.     lappend result [format %.1f $element]
  103.     }
  104.     set result
  105. } {10.0 10.0}
  106. test canvText-3.5 {TextCoords procedure} {
  107.     list [catch {.c coords test 10} msg] $msg
  108. } {1 {wrong # coordinates: expected 0 or 2, got 1}}
  109. test canvText-3.6 {TextCoords procedure} {
  110.     list [catch {.c coords test 10 10 10} msg] $msg
  111. } {1 {wrong # coordinates: expected 0 or 2, got 3}}
  112.  
  113. test canvText-4.1 {ConfigureText procedure} {
  114.     list [catch {.c itemconfig test -fill xyz} msg] $msg
  115. } {1 {unknown color name "xyz"}}
  116. test canvText-4.2 {ConfigureText procedure} {
  117.     .c itemconfig test -fill blue
  118.     .c itemcget test -fill
  119. } {blue}
  120. test canvText-4.3 {ConfigureText procedure: construct font gcs} {
  121.     .c itemconfig test -font "times 20" -fill black -stipple gray50
  122.     list [.c itemcget test -font] [.c itemcget test -fill] [.c itemcget test -stipple]
  123. } {{times 20} black gray50}
  124. test canvText-4.4 {ConfigureText procedure: construct cursor gc} {
  125.     .c itemconfig test -text "abcdefg"
  126.     .c select from test 2
  127.     .c select to test 4
  128.     .c icursor test 3
  129.  
  130.     # Both black -> cursor becomes white.
  131.     .c config -insertbackground black
  132.     .c config -selectbackground black
  133.     .c itemconfig test -just left
  134.     update
  135.  
  136.     # Both same color (and not black) -> cursor becomes black.
  137.     .c config -insertbackground red
  138.     .c config -selectbackground red
  139.     .c itemconfig test -just left
  140.     update
  141. } {}
  142. test canvText-4.5 {ConfigureText procedure: adjust selection} {
  143.     set x {}
  144.     .c itemconfig test -text "abcdefghi"
  145.     .c select from test 2
  146.     .c select to test 6
  147.     lappend x [selection get]
  148.     .c dchars test 1 end
  149.     lappend x [catch {selection get}]
  150.     .c insert test end "bcdefghi"
  151.     .c select from test 2
  152.     .c select to test 6
  153.     lappend x [selection get]
  154.     .c dchars test 4 end
  155.     lappend x [selection get]
  156.     .c insert test end "efghi"
  157.     .c select from test 6
  158.     .c select to test 2
  159.     lappend x [selection get]
  160.     .c dchars test 4 end
  161.     lappend x [selection get]
  162. } {cdefg 1 cdefg cd cdef cd}
  163. test canvText-4.6 {ConfigureText procedure: adjust cursor} {
  164.     .c itemconfig test -text "abcdefghi"
  165.     set x {}
  166.     .c icursor test 6
  167.     .c dchars test 4 end
  168.     .c index test insert
  169. } {4}
  170.  
  171. test canvText-5.1 {ConfigureText procedure: adjust cursor} {
  172.     .c create text 10 10 -tag x -fill blue -font "times 40" -stipple gray50 -text "xyz"
  173.     .c delete x
  174. } {}
  175.  
  176. test canvText-6.1 {ComputeTextBbox procedure} {fonts} {
  177.     .c itemconfig test -font $font -text 0
  178.     .c coords test 0 0
  179.     set x {}
  180.     lappend x [.c itemconfig test -anchor n; .c bbox test]
  181.     lappend x [.c itemconfig test -anchor nw; .c bbox test]
  182.     lappend x [.c itemconfig test -anchor w; .c bbox test]
  183.     lappend x [.c itemconfig test -anchor sw; .c bbox test]
  184.     lappend x [.c itemconfig test -anchor s; .c bbox test]
  185.     lappend x [.c itemconfig test -anchor se; .c bbox test]
  186.     lappend x [.c itemconfig test -anchor e; .c bbox test]
  187.     lappend x [.c itemconfig test -anchor ne; .c bbox test]
  188.     lappend x [.c itemconfig test -anchor center; .c bbox test]
  189. } "{[expr -$ax/2-1] 0 [expr $ax/2+1] $ay}\
  190. {-1 0 [expr $ax+1] $ay}\
  191. {-1 [expr -$ay/2] [expr $ax+1] [expr $ay/2]}\
  192. {-1 -$ay [expr $ax+1] 0}\
  193. {[expr -$ax/2-1] -$ay [expr $ax/2+1] 0}\
  194. {[expr -$ax-1] -$ay 1 0}\
  195. {[expr -$ax-1] [expr -$ay/2] 1 [expr $ay/2]}\
  196. {[expr -$ax-1] 0 1 $ay}\
  197. {[expr -$ax/2-1] [expr -$ay/2] [expr $ax/2+1] [expr $ay/2]}"
  198.  
  199. focus .c
  200. .c focus test
  201. .c itemconfig test -text "abcd\nefghi\njklmnopq"
  202. test canvText-7.1 {DisplayText procedure: stippling} {
  203.     .c itemconfig test -stipple gray50
  204.     update
  205.     .c itemconfig test -stipple {}
  206.     update
  207. } {}
  208. test canvText-7.2 {DisplayText procedure: draw selection} {
  209.     .c select from test 0
  210.     .c select to test end
  211.     update
  212.     selection get
  213. } "abcd\nefghi\njklmnopq"
  214. test canvText-7.3 {DisplayText procedure: selection} {
  215.     .c select from test 0
  216.     .c select to test end
  217.     update
  218.     selection get
  219. } "abcd\nefghi\njklmnopq"
  220. test canvText-7.4 {DisplayText procedure: one line selection} {
  221.     .c select from test 2
  222.     .c select to test 3
  223.     update
  224. } {}
  225. test canvText-7.5 {DisplayText procedure: multi-line selection} {
  226.     .c select from test 2
  227.     .c select to test 12
  228.     update
  229. } {}
  230. test canvText-7.6 {DisplayText procedure: draw cursor} {
  231.     .c icursor test 3
  232.     update
  233. } {}
  234. test canvText-7.7 {DisplayText procedure: selected text different color} {
  235.     .c config -selectforeground blue
  236.     .c itemconfig test -anchor n
  237.     update
  238. } {}
  239. test canvText-7.8 {DisplayText procedure: not selected} {
  240.     .c select clear
  241.     update
  242. } {}
  243.  
  244. test canvText-8.1 {TextInsert procedure: 0 length insert} {
  245.     .c insert test end {}
  246. } {}
  247. test canvText-8.2 {TextInsert procedure: before beginning/after end} {
  248.     # Can't test this because GetTextIndex filters out those numbers.
  249. } {}
  250. test canvText-8.3 {TextInsert procedure: inserting in a selected item} {
  251.     .c itemconfig test -text "abcdefg"
  252.     .c select from test 2
  253.     .c select to test 4
  254.     .c insert test 1 "xyz"
  255.     .c itemcget test -text
  256. } {axyzbcdefg}
  257. test canvText-8.4 {TextInsert procedure: inserting before selection} {
  258.     .c itemconfig test -text "abcdefg"
  259.     .c select from test 2
  260.     .c select to test 4
  261.     .c insert test 1 "xyz"
  262.     list [.c index test sel.first] [.c index test sel.last]
  263. } {5 7}
  264. test canvText-8.5 {TextInsert procedure: inserting in selection} {
  265.     .c itemconfig test -text "abcdefg"
  266.     .c select from test 2
  267.     .c select to test 4
  268.     .c insert test 3 "xyz"
  269.     list [.c index test sel.first] [.c index test sel.last]
  270. } {2 7}
  271. test canvText-8.6 {TextInsert procedure: inserting after selection} {
  272.     .c itemconfig test -text "abcdefg"
  273.     .c select from test 2
  274.     .c select to test 4
  275.     .c insert test 5 "xyz"
  276.     list [.c index test sel.first] [.c index test sel.last]
  277. } {2 4}
  278. test canvText-8.7 {TextInsert procedure: inserting in unselected item} {
  279.     .c itemconfig test -text "abcdefg"
  280.     .c select clear
  281.     .c insert test 5 "xyz"
  282.     .c itemcget test -text
  283. } {abcdexyzfg}
  284. test canvText-8.8 {TextInsert procedure: inserting before cursor} {
  285.     .c itemconfig test -text "abcdefg"
  286.     .c icursor test 3
  287.     .c insert test 2 "xyz"
  288.     .c index test insert
  289. } {6}
  290. test canvText-8.9 {TextInsert procedure: inserting after cursor} {
  291.     .c itemconfig test -text "abcdefg"
  292.     .c icursor test 3
  293.     .c insert test 4 "xyz"
  294.     .c index test insert
  295. } {3}
  296.  
  297. test canvText-9.1 {TextInsert procedure: before beginning/after end} {
  298.     # Can't test this because GetTextIndex filters out those numbers.
  299. } {}
  300. test canvText-9.2 {TextInsert procedure: start > end} {
  301.     .c itemconfig test -text "abcdefg"
  302.     .c dchars test 4 2
  303.     .c itemcget test -text
  304. } {abcdefg}
  305. test canvText-9.3 {TextInsert procedure: deleting from a selected item} {
  306.     .c itemconfig test -text "abcdefg"
  307.     .c select from test 2
  308.     .c select to test 4
  309.     .c dchars test 3 5
  310.     .c itemcget test -text
  311. } {abcg}
  312. test canvText-9.4 {TextInsert procedure: deleting before start} {
  313.     .c itemconfig test -text "abcdefghijk"
  314.     .c select from test 4
  315.     .c select to test 8
  316.     .c dchars test 1 1
  317.     list [.c index test sel.first] [.c index test sel.last]
  318. } {3 7}
  319. test canvText-9.5 {TextInsert procedure: keep start > first char deleted} {
  320.     .c itemconfig test -text "abcdefghijk"
  321.     .c select from test 4
  322.     .c select to test 8
  323.     .c dchars test 2 6
  324.     list [.c index test sel.first] [.c index test sel.last]
  325. } {2 3}
  326. test canvText-9.6 {TextInsert procedure: deleting inside selection} {
  327.     .c itemconfig test -text "abcdefghijk"
  328.     .c select from test 4
  329.     .c select to test 8
  330.     .c dchars test 6 6
  331.     list [.c index test sel.first] [.c index test sel.last]
  332. } {4 7}
  333. test canvText-9.7 {TextInsert procedure: keep end > first char deleted} {
  334.     .c itemconfig test -text "abcdefghijk"
  335.     .c select from test 4
  336.     .c select to test 8
  337.     .c dchars test 6 10
  338.     list [.c index test sel.first] [.c index test sel.last]
  339. } {4 5}
  340. test canvText-9.8 {TextInsert procedure: selectFirst > selectLast: deselect} {
  341.     .c itemconfig test -text "abcdefghijk"
  342.     .c select from test 4
  343.     .c select to test 8
  344.     .c dchars test 3 10
  345.     list [catch {.c index test sel.first} msg] $msg
  346. } {1 {selection isn't in item}}
  347. test canvText-9.9 {TextInsert procedure: selectFirst <= selectLast} {
  348.     .c itemconfig test -text "abcdefghijk"
  349.     .c select from test 4
  350.     .c select to test 8
  351.     .c dchars test 4 7
  352.     list [.c index test sel.first] [.c index test sel.last]
  353. } {4 4}
  354. test canvText-9.10 {TextInsert procedure: move anchor} {
  355.     .c itemconfig test -text "abcdefghijk"
  356.     .c select from test 6
  357.     .c select to test 8
  358.     .c dchars test 2 4
  359.     .c select to test 1
  360.     list [.c index test sel.first] [.c index test sel.last]
  361. } {1 2}
  362. test canvText-9.11 {TextInsert procedure: keep anchor >= first} {
  363.     .c itemconfig test -text "abcdefghijk"
  364.     .c select from test 6
  365.     .c select to test 8
  366.     .c dchars test 5 7
  367.     .c select to test 1
  368.     list [.c index test sel.first] [.c index test sel.last]
  369. } {1 4}
  370. test canvText-9.12 {TextInsert procedure: anchor doesn't move} {
  371.     .c itemconfig test -text "abcdefghijk"
  372.     .c select from test 2
  373.     .c select to test 5
  374.     .c dchars test 6 8
  375.     .c select to test 8
  376.     list [.c index test sel.first] [.c index test sel.last]
  377. } {2 8}
  378. test canvText-9.13 {TextInsert procedure: move cursor} {
  379.     .c itemconfig test -text "abcdefghijk"
  380.     .c icursor test 6
  381.     .c dchars test 2 4
  382.     .c index test insert
  383. } {3}
  384. test canvText-9.14 {TextInsert procedure: keep cursor >= first} {
  385.     .c itemconfig test -text "abcdefghijk"
  386.     .c icursor test 6
  387.     .c dchars test 2 10
  388.     .c index test insert
  389. } {2}
  390. test canvText-9.15 {TextInsert procedure: cursor doesn't move} {
  391.     .c itemconfig test -text "abcdefghijk"
  392.     .c icursor test 5
  393.     .c dchars test 7 9
  394.     .c index test insert
  395. } {5}
  396.     
  397. test canvText-10.1 {TextToPoint procedure} {
  398.     .c coords test 0 0
  399.     .c itemconfig test -text 0 -anchor center
  400.     .c index test @0,0
  401. } {0}
  402.  
  403. test canvText-11.1 {TextToArea procedure} {
  404.     .c coords test 0 0
  405.     .c itemconfig test -text 0 -anchor center
  406.     .c find overlapping 0 0 1 1
  407. } [.c find withtag test]
  408. test canvText-11.2 {TextToArea procedure} {
  409.     .c coords test 0 0
  410.     .c itemconfig test -text 0 -anchor center
  411.     .c find overlapping 1000 1000 1001 1001
  412. } {}
  413.  
  414. test canvText-12.1 {ScaleText procedure} {
  415.     .c coords test 100 100
  416.     .c scale all 50 50 2 2
  417.     .c coords test
  418. } {150.0 150.0}
  419.  
  420. test canvText-13.1 {TranslateText procedure} {
  421.     .c coords test 100 100
  422.     .c move all 10 10
  423.     .c coords test
  424. } {110.0 110.0}
  425.     
  426. .c itemconfig test -text "abcdefghijklmno" -anchor nw
  427. .c select from test 5
  428. .c select to test 8
  429. .c icursor test 12
  430. .c coords test 0 0
  431. test canvText-14.1 {GetTextIndex procedure} {
  432.     list [.c index test end] [.c index test insert] \
  433.     [.c index test sel.first] [.c index test sel.last] \
  434.     [.c index test @0,0] \
  435.     [.c index test -1] [.c index test 10] [.c index test 100]
  436. } {15 12 5 8 0 0 10 15}
  437. test canvText-14.2 {GetTextIndex procedure: select error} {
  438.     .c select clear
  439.     list [catch {.c index test sel.first} msg] $msg
  440. } {1 {selection isn't in item}}
  441. test canvText-14.3 {GetTextIndex procedure: select error} {
  442.     .c select clear
  443.     list [catch {.c index test sel.last} msg] $msg
  444. } {1 {selection isn't in item}}
  445. test canvText-14.4 {GetTextIndex procedure: select error} {
  446.     .c select clear
  447.     list [catch {.c index test sel.} msg] $msg
  448. } {1 {bad index "sel."}}
  449. test canvText-14.5 {GetTextIndex procedure: bad int or unknown index} {
  450.     list [catch {.c index test xyz} msg] $msg
  451. } {1 {bad index "xyz"}}
  452.  
  453. test canvText-15.1 {SetTextCursor procedure} {
  454.     .c itemconfig -text "abcdefg"
  455.     .c icursor test 3
  456.     .c index test insert
  457. } {3}
  458.  
  459. test canvText-16.1 {GetSelText procedure} {
  460.     .c itemconfig test -text "abcdefghijklmno" -anchor nw
  461.     .c select from test 5
  462.     .c select to test 8
  463.     selection get
  464. } {fghi}
  465.  
  466. set font {Courier 12 italic}
  467. set ax [font measure $font 0]
  468. set ay [font metrics $font -linespace]
  469.  
  470. test canvText-17.1 {TextToPostscript procedure} {
  471.     .c delete all
  472.     .c config -height 300 -highlightthickness 0 -bd 0
  473.     update
  474.     .c create text 100 100 -tags test 
  475.     .c itemconfig test -font $font -text "00000000" -width [expr 3*$ax]
  476.     .c itemconfig test -anchor n -fill black
  477.     set x [.c postscript]
  478.     set x [string range $x [string first "/Courier-Oblique" $x] end]
  479. } "/Courier-Oblique findfont [font actual $font -size] scalefont ISOEncode setfont
  480. 0.000 0.000 0.000 setrgbcolor AdjustColor
  481. 100 200 \[
  482. (000)
  483. (000)
  484. (00)
  485. ] $ay -0.5 0 0 false DrawText
  486. grestore
  487. restore showpage
  488.  
  489. %%Trailer
  490. end
  491. %%EOF
  492. "
  493.