# textImage.test -- test images embedded in text widgets # # This file contains a collection of tests for one or more of the Tcl # built-in commands. Sourcing this file into Tcl runs the tests and # generates output for errors. No output means no errors were found. # # Copyright (c) 1998-1999 by Scriptics Corporation. # All rights reserved. # # RCS: @(#) $Id: textImage.test,v 1.1.1.1 2007/07/10 15:05:18 duncan Exp $ package require tcltest 2.1 namespace import -force tcltest::configure namespace import -force tcltest::testsDirectory configure -testdir [file join [pwd] [file dirname [info script]]] configure -loadfile [file join [testsDirectory] constraints.tcl] tcltest::loadTestedCommands # One time setup. Create a font to insure the tests are font metric invariant. catch {destroy .t} font create test_font -family courier -size 14 text .t -font test_font destroy .t test textImage-1.1 {basic argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image} msg] $msg } {1 {wrong # args: should be ".t image option ?arg arg ...?"}} test textImage-1.2 {basic argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image c} msg] $msg } {1 {bad image option "c": must be cget, configure, create, or names}} test textImage-1.3 {cget argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image cget} msg] $msg } {1 {wrong # args: should be ".t image cget index option"}} test textImage-1.4 {cget argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image cget blurf -flurp} msg] $msg } {1 {bad text index "blurf"}} test textImage-1.5 {cget argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image cget 1.1 -flurp} msg] $msg } {1 {no embedded image at index "1.1"}} test textImage-1.6 {configure argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image configure } msg] $msg } {1 {wrong # args: should be ".t image configure index ?option value ...?"}} test textImage-1.7 {configure argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image configure blurf } msg] $msg } {1 {bad text index "blurf"}} test textImage-1.8 {configure argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image configure 1.1 } msg] $msg } {1 {no embedded image at index "1.1"}} test textImage-1.9 {create argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create} msg] $msg } {1 {wrong # args: should be ".t image create index ?option value ...?"}} test textImage-1.10 {create argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create blurf } msg] $msg } {1 {bad text index "blurf"}} test textImage-1.11 {basic argument checking} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create 1000.1000 -image small} msg] $msg } {0 small} test textImage-1.12 {names argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image names dates places} msg] $msg } {1 {wrong # args: should be ".t image names"}} test textImage-1.13 {names argument checking} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t set result "" lappend result [.t image names] .t image create insert -image small lappend result [.t image names] .t image create insert -image small lappend result [.t image names] .t image create insert -image small -name little lappend result [.t image names] } {{} small {small#1 small} {small#1 small little}} test textImage-1.14 {basic argument checking} { catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image huh} msg] $msg } {1 {bad image option "huh": must be cget, configure, create, or names}} test textImage-1.15 {align argument checking} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t list [catch {.t image create end -image small -align wrong} msg] $msg } {1 {bad alignment "wrong": must be baseline, bottom, center, or top}} test textImage-1.16 {configure} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small .t image configure small } {{-align {} {} center center} {-padx {} {} 0 0} {-pady {} {} 0 0} {-image {} {} {} small} {-name {} {} {} {}}} test textImage-1.17 {basic cget options} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small set result "" foreach i {align padx pady image name} { lappend result $i:[.t image cget small -$i] } set result } {align:center padx:0 pady:0 image:small name:} test textImage-1.18 {basic configure options} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small set result "" foreach {option value} {align top padx 5 pady 7 image large name none} { .t image configure small -$option $value } update .t image configure small } {{-align {} {} center top} {-padx {} {} 0 5} {-pady {} {} 0 7} {-image {} {} {} large} {-name {} {} {} none}} test textImage-1.19 {basic image naming} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image small .t image create end -image small -name small .t image create end -image small -name small#6342 .t image create end -image small -name small lsort [.t image names] } {small small#1 small#6342 small#6343} test textImage-2.1 {debug} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t debug 1 .t insert end front .t image create end -image small .t insert end back .t delete small .t image names .t debug 0 } {} test textImage-3.1 {image change propagation} { catch { image create photo vary -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image vary -align top update set result "" lappend result base:[.t bbox vary] foreach i {10 20 40} { vary configure -width $i -height $i update lappend result $i:[.t bbox vary] } set result } {{base:0 0 5 5} {10:0 0 10 10} {20:0 0 20 20} {40:0 0 40 40}} test textImage-3.2 {delayed image management} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -name test update set result "" lappend result [.t bbox test] .t image configure test -image small -align top update lappend result [.t bbox test] } {{} {0 0 5 5}} # some temporary random tests test textImage-4.1 {alignment checking - except baseline} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small .t insert end test update set result "" lappend result default:[.t bbox small] foreach i {top bottom center} { .t image configure small -align $i update lappend result [.t image cget small -align]:[.t bbox small] } set result } {{default:50 22 5 5} {top:50 0 5 5} {bottom:50 45 5 5} {center:50 22 5 5}} test textImage-4.2 {alignment checking - baseline} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} font create test_font2 -size 5 text .t -font test_font2 -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -align baseline .t insert end test set result "" foreach size {10 15 20 30} { font configure test_font2 -size $size array set Metrics [font metrics test_font2] update foreach {x y w h} [.t bbox small] {} set norm [expr { (([image height large] - $Metrics(-linespace))/2 + $Metrics(-ascent) - [image height small] - $y) }] lappend result "$size $norm" } font delete test_font2 unset Metrics set result } {{10 0} {15 0} {20 0} {30 0}} test textImage-4.3 {alignment and padding checking} {fonts} { catch { image create photo small -width 5 -height 5 small put red -to 0 0 4 4 image create photo large -width 50 -height 50 large put green -to 0 0 50 50 } catch {destroy .t} text .t -font test_font -bd 0 -highlightthickness 0 -padx 0 -pady 0 pack .t .t image create end -image large .t image create end -image small -padx 5 -pady 10 .t insert end test update set result "" lappend result default:[.t bbox small] foreach i {top bottom center baseline} { .t image configure small -align $i update lappend result $i:[.t bbox small] } set result } {{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}} # cleanup catch {destroy .t} foreach image [image names] {image delete $image} font delete test_font # cleanup ::tcltest::cleanupTests return