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