1# Command covered: 'canvas create geomap_place' 2# 3# This script file tests the commands in the tkgeomap package. See the 4# tclgeomap man page for a description of the package. See the tcltest 5# man page for a description of Tcl's testing proc's. 6# 7# Copyright (c) 2004 Gordon D. Carrie. All rights reserved. 8# 9# Licensed under the Open Software License version 2.1 10# 11# Please address questions and feedback to user0@tkgeomap.org 12# 13# @(#) $Id: tk_geomap_place.test,v 1.7 2007/01/23 15:59:02 tkgeomap Exp $ 14 15if {[lsearch [namespace children] ::tcltest] == -1} { 16 package require tcltest 17 namespace import ::tcltest::* 18} 19 20package require tkgeomap 2 21 22test tk_geomap_place-1.1 {Geoplace with dot, text, and bitmap} { 23 geomap::place new testplace {5.0 -5.0} 24 set W 800 25 set H 600 26 set W2 [expr {$W / 2}] 27 set H2 [expr {$H / 2}] 28 canvas .c -width $W -height $H -background Black 29 pack .c 30 update 31 set proj [geomap::projection Mercator 0.0] 32 .c create geomap_place $W2 $H2 -place testplace -projection $proj \ 33 -scale [::geomap::cartg 1:240000000] -tags place -dotcolor green \ 34 -textcolor Yellow -bitmapcolor Red 35 .c create text $W2 [expr {$H2 + 40}] -text "Place with dot" -fill Yellow \ 36 -tags label 37 update 38 after 1000 39 .c itemconfigure place -dotsize 2c 40 .c itemconfigure label -text "Place with bigger dot" 41 update 42 after 1000 43 .c itemconfigure place -dotsize 0.1c 44 .c itemconfigure place -text "Hello" 45 .c itemconfigure label -text "Place with dot says hello" 46 update 47 after 1000 48 .c itemconfigure place -bitmap hourglass 49 .c itemconfigure label -text "Hello place with bitmap" 50 update 51 after 1000 52 .c itemconfigure place -bitmap warning 53 .c itemconfigure label -text "Hello place with another bitmap" 54 update 55 after 1000 56 .c itemconfigure place -text "" 57 .c itemconfigure label -text "No text" 58 update 59 after 1000 60 .c itemconfigure place -bitmap "" 61 .c itemconfigure label -text "No bitmap" 62 update 63 after 1000 64 .c itemconfigure place -place "" 65 .c itemconfigure label -text "Place should be gone" 66 update 67 after 1000 68 rename testplace {} 69 rename $proj {} 70 destroy .c 71} {} 72 73test tk_geomap_place-1.2 {Text anchors} { 74 geomap::place new testplace {0.0 0.0} 75 set W 800 76 set H 600 77 set W2 [expr {$W / 2}] 78 set H2 [expr {$H / 2}] 79 canvas .c -width $W -height $H 80 pack .c 81 set proj [geomap::projection Mercator 0.0] 82 .c create geomap_place $W2 $H2 -place testplace \ 83 -projection $proj -scale [::geomap::cartg 1:90000000] -tags place 84 .c itemconfigure place -text " 85Now is the time 86for the quick brown fox 87to come to the aid 88of the lazy dog. 89" 90 .c create text $W2 [expr {$H2 + 80}] -text "Default anchor" -tags label 91 update 92 after 1000 93 foreach anchor {n nw w sw s se e ne c} { 94 .c itemconfigure place -anchor $anchor 95 .c itemconfigure label -text "$anchor anchor" 96 update 97 after 1000 98 } 99 rename testplace {} 100 rename $proj {} 101 destroy .c 102} {} 103 104test tk_geomap_place-1.3 {Geoplace moves around} { 105 geomap::place new testplace {0.0 0.0} 106 set W 800 107 set H 600 108 set W2 [expr {$W / 2}] 109 set H2 [expr {$H / 2}] 110 canvas .c -width $W -height $H 111 pack .c 112 set proj [geomap::projection Mercator 0.0] 113 .c create geomap_place $W2 $H2 -place testplace -text "testplace" \ 114 -anchor n -projection $proj -scale [::geomap::cartg 1:90000000] \ 115 -tags place 116 update 117 after 1000 118 testplace set {10.0 10.0} 119 update 120 after 1000 121 testplace set {20.0 0.0} 122 update 123 after 1000 124 rename testplace {} 125 rename $proj {} 126 destroy .c 127} {} 128 129test tk_geomap_place-1.4 {Geoplace item displays different places} { 130 geomap::place new place1 {0.0 0.0} 131 geomap::place new place2 {0.0 10.0} 132 geomap::place new place3 {10.0 0.0} 133 set W 800 134 set H 600 135 set W2 [expr {$W / 2}] 136 set H2 [expr {$H / 2}] 137 set proj [geomap::projection Mercator 0.0] 138 canvas .c -width $W -height $H 139 pack .c 140 update 141 .c create geomap_place $W2 $H2 -anchor n \ 142 -projection $proj -scale [::geomap::cartg 1:90000000] -tags place 143 foreach place {place1 place2 place3} { 144 .c itemconfigure place -place $place -text $place 145 update 146 after 1000 147 } 148 rename place1 {} 149 rename place2 {} 150 rename place3 {} 151 rename $proj {} 152 destroy .c 153} {} 154 155test tk_geomap_place-1.5 {Geoplace item displays arrows} { 156 geomap::place new place1 {0.0 0.0} 157 set W 800 158 set H 600 159 set W2 [expr {$W / 2}] 160 set H2 [expr {$H / 2}] 161 set proj [geomap::projection Mercator 0.0] 162 canvas .c -width $W -height $H 163 pack .c 164 .c create text 20 20 -anchor nw -tags lbl 165 .c create geomap_place $W2 $H2 -place place1 \ 166 -projection $proj -scale [::geomap::cartg 1:90000000] \ 167 -dotsize 0 -anchor n -tags place 168 set arrows { 169 { 0.0 12 0.5} 170 { 30.0 12 0.5} 171 { 45.0 12 0.5} 172 { 90.0 12 0.5} 173 {135.0 12 0.5} 174 {180.0 12 0.5} 175 {225.0 12 0.5} 176 {270.0 12 0.5} 177 {315.0 12 0.5} 178 { 45.0 12 1.0} 179 { 45.0 12 2.0} 180 { 30.0 9 0.5} 181 { 30.0 6 0.5} 182 } 183 set fmt {Arrow azimuth = %.1f 184 Shaft length = %d pixels 185 Tip = %.1f of shaft.} 186 foreach arrow $arrows { 187 .c itemconfigure place -arrow $arrow 188 .c itemconfigure lbl -text [eval format \$fmt $arrow] 189 update 190 after 2000 191 } 192} {} 193 194cleanupTests 195