1# textImage.test -- test images embedded in text widgets 2# 3# This file contains a collection of tests for one or more of the Tcl 4# built-in commands. Sourcing this file into Tcl runs the tests and 5# generates output for errors. No output means no errors were found. 6# 7# Copyright (c) 1998-1999 by Scriptics Corporation. 8# All rights reserved. 9# 10# RCS: @(#) $Id: textImage.test,v 1.5 2002/07/13 20:28:35 dgp Exp $ 11 12package require tcltest 2.1 13namespace import -force tcltest::configure 14namespace import -force tcltest::testsDirectory 15configure -testdir [file join [pwd] [file dirname [info script]]] 16configure -loadfile [file join [testsDirectory] constraints.tcl] 17tcltest::loadTestedCommands 18 19# One time setup. Create a font to insure the tests are font metric invariant. 20 21catch {destroy .t} 22font create test_font -family courier -size 14 23text .t -font test_font 24destroy .t 25 26test textImage-1.1 {basic argument checking} { 27 catch {destroy .t} 28 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 29 pack .t 30 list [catch {.t image} msg] $msg 31} {1 {wrong # args: should be ".t image option ?arg arg ...?"}} 32 33test textImage-1.2 {basic argument checking} { 34 catch {destroy .t} 35 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 36 pack .t 37 list [catch {.t image c} msg] $msg 38} {1 {bad image option "c": must be cget, configure, create, or names}} 39 40test textImage-1.3 {cget argument checking} { 41 catch {destroy .t} 42 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 43 pack .t 44 list [catch {.t image cget} msg] $msg 45} {1 {wrong # args: should be ".t image cget index option"}} 46 47test textImage-1.4 {cget argument checking} { 48 catch {destroy .t} 49 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 50 pack .t 51 list [catch {.t image cget blurf -flurp} msg] $msg 52} {1 {bad text index "blurf"}} 53 54test textImage-1.5 {cget argument checking} { 55 catch {destroy .t} 56 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 57 pack .t 58 list [catch {.t image cget 1.1 -flurp} msg] $msg 59} {1 {no embedded image at index "1.1"}} 60 61test textImage-1.6 {configure argument checking} { 62 catch {destroy .t} 63 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 64 pack .t 65 list [catch {.t image configure } msg] $msg 66} {1 {wrong # args: should be ".t image configure index ?option value ...?"}} 67 68test textImage-1.7 {configure argument checking} { 69 catch {destroy .t} 70 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 71 pack .t 72 list [catch {.t image configure blurf } msg] $msg 73} {1 {bad text index "blurf"}} 74 75test textImage-1.8 {configure argument checking} { 76 catch {destroy .t} 77 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 78 pack .t 79 list [catch {.t image configure 1.1 } msg] $msg 80} {1 {no embedded image at index "1.1"}} 81 82test textImage-1.9 {create argument checking} { 83 catch {destroy .t} 84 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 85 pack .t 86 list [catch {.t image create} msg] $msg 87} {1 {wrong # args: should be ".t image create index ?option value ...?"}} 88 89test textImage-1.10 {create argument checking} { 90 catch {destroy .t} 91 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 92 pack .t 93 list [catch {.t image create blurf } msg] $msg 94} {1 {bad text index "blurf"}} 95 96test textImage-1.11 {basic argument checking} { 97 catch { 98 image create photo small -width 5 -height 5 99 small put red -to 0 0 4 4 100 } 101 catch {destroy .t} 102 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 103 pack .t 104 list [catch {.t image create 1000.1000 -image small} msg] $msg 105} {0 small} 106 107test textImage-1.12 {names argument checking} { 108 catch {destroy .t} 109 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 110 pack .t 111 list [catch {.t image names dates places} msg] $msg 112} {1 {wrong # args: should be ".t image names"}} 113 114 115test textImage-1.13 {names argument checking} { 116 catch { 117 image create photo small -width 5 -height 5 118 small put red -to 0 0 4 4 119 } 120 catch {destroy .t} 121 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 122 pack .t 123 set result "" 124 lappend result [.t image names] 125 .t image create insert -image small 126 lappend result [.t image names] 127 .t image create insert -image small 128 lappend result [.t image names] 129 .t image create insert -image small -name little 130 lappend result [.t image names] 131} {{} small {small#1 small} {small#1 small little}} 132 133test textImage-1.14 {basic argument checking} { 134 catch {destroy .t} 135 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 136 pack .t 137 list [catch {.t image huh} msg] $msg 138} {1 {bad image option "huh": must be cget, configure, create, or names}} 139 140test textImage-1.15 {align argument checking} { 141 catch { 142 image create photo small -width 5 -height 5 143 small put red -to 0 0 4 4 144 } 145 catch {destroy .t} 146 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 147 pack .t 148 list [catch {.t image create end -image small -align wrong} msg] $msg 149} {1 {bad alignment "wrong": must be baseline, bottom, center, or top}} 150 151test textImage-1.16 {configure} { 152 catch { 153 image create photo small -width 5 -height 5 154 small put red -to 0 0 4 4 155 } 156 catch {destroy .t} 157 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 158 pack .t 159 .t image create end -image small 160 .t image configure small 161} {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} 162 163test textImage-1.17 {basic cget options} { 164 catch { 165 image create photo small -width 5 -height 5 166 small put red -to 0 0 4 4 167 } 168 catch {destroy .t} 169 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 170 pack .t 171 .t image create end -image small 172 set result "" 173 foreach i {align padx pady image name} { 174 lappend result $i:[.t image cget small -$i] 175 } 176 set result 177} {align:center padx:0 pady:0 image:small name:} 178 179test textImage-1.18 {basic configure options} { 180 catch { 181 image create photo small -width 5 -height 5 182 small put red -to 0 0 4 4 183 image create photo large -width 50 -height 50 184 large put green -to 0 0 50 50 185 } 186 catch {destroy .t} 187 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 188 pack .t 189 .t image create end -image small 190 set result "" 191 foreach {option value} {align top padx 5 pady 7 image large name none} { 192 .t image configure small -$option $value 193 } 194 update 195 .t image configure small 196} {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} 197 198test textImage-1.19 {basic image naming} { 199 catch { 200 image create photo small -width 5 -height 5 201 small put red -to 0 0 4 4 202 } 203 catch {destroy .t} 204 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 205 pack .t 206 .t image create end -image small 207 .t image create end -image small -name small 208 .t image create end -image small -name small#6342 209 .t image create end -image small -name small 210 lsort [.t image names] 211} {small small#1 small#6342 small#6343} 212 213test textImage-2.1 {debug} { 214 catch { 215 image create photo small -width 5 -height 5 216 small put red -to 0 0 4 4 217 } 218 catch {destroy .t} 219 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 220 pack .t 221 .t debug 1 222 .t insert end front 223 .t image create end -image small 224 .t insert end back 225 .t delete small 226 .t image names 227 .t debug 0 228} {} 229 230test textImage-3.1 {image change propagation} { 231 catch { 232 image create photo vary -width 5 -height 5 233 small put red -to 0 0 4 4 234 } 235 catch {destroy .t} 236 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 237 pack .t 238 .t image create end -image vary -align top 239 update 240 set result "" 241 lappend result base:[.t bbox vary] 242 foreach i {10 20 40} { 243 vary configure -width $i -height $i 244 update 245 lappend result $i:[.t bbox vary] 246 } 247 set result 248} {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} 249 250test textImage-3.2 {delayed image management} { 251 catch { 252 image create photo small -width 5 -height 5 253 small put red -to 0 0 4 4 254 } 255 catch {destroy .t} 256 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 257 pack .t 258 .t image create end -name test 259 update 260 set result "" 261 lappend result [.t bbox test] 262 .t image configure test -image small -align top 263 update 264 lappend result [.t bbox test] 265} {{} {0 0 5 5}} 266 267# some temporary random tests 268 269test textImage-4.1 {alignment checking - except baseline} { 270 catch { 271 image create photo small -width 5 -height 5 272 small put red -to 0 0 4 4 273 image create photo large -width 50 -height 50 274 large put green -to 0 0 50 50 275 } 276 catch {destroy .t} 277 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 278 pack .t 279 .t image create end -image large 280 .t image create end -image small 281 .t insert end test 282 update 283 set result "" 284 lappend result default:[.t bbox small] 285 foreach i {top bottom center} { 286 .t image configure small -align $i 287 update 288 lappend result [.t image cget small -align]:[.t bbox small] 289 } 290 set result 291} {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} 292 293test textImage-4.2 {alignment checking - baseline} { 294 catch { 295 image create photo small -width 5 -height 5 296 small put red -to 0 0 4 4 297 image create photo large -width 50 -height 50 298 large put green -to 0 0 50 50 299 } 300 catch {destroy .t} 301 font create test_font2 -size 5 302 text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 303 pack .t 304 .t image create end -image large 305 .t image create end -image small -align baseline 306 .t insert end test 307 set result "" 308 foreach size {10 15 20 30} { 309 font configure test_font2 -size $size 310 array set Metrics [font metrics test_font2] 311 update 312 foreach {x y w h} [.t bbox small] {} 313 set norm [expr { 314 (([image height large] - $Metrics(-linespace))/2 315 + $Metrics(-ascent) - [image height small] - $y) 316 }] 317 lappend result "$size $norm" 318 } 319 font delete test_font2 320 unset Metrics 321 set result 322} {{10 0} {15 0} {20 0} {30 0}} 323 324test textImage-4.3 {alignment and padding checking} {fonts} { 325 catch { 326 image create photo small -width 5 -height 5 327 small put red -to 0 0 4 4 328 image create photo large -width 50 -height 50 329 large put green -to 0 0 50 50 330 } 331 catch {destroy .t} 332 text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 333 pack .t 334 .t image create end -image large 335 .t image create end -image small -padx 5 -pady 10 336 .t insert end test 337 update 338 set result "" 339 lappend result default:[.t bbox small] 340 foreach i {top bottom center baseline} { 341 .t image configure small -align $i 342 update 343 lappend result $i:[.t bbox small] 344 } 345 set result 346} {{default:55 22 5 5} {top:55 10 5 5} {bottom:55 35 5 5} {center:55 22 5 5} {baseline:55 22 5 5}} 347# cleanup 348 349catch {destroy .t} 350foreach image [image names] {image delete $image} 351font delete test_font 352 353# cleanup 354::tcltest::cleanupTests 355return 356 357 358 359 360 361 362 363 364 365 366 367 368 369