1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
|
package require BLT
set dest [image create picture -width 900 -height 600]
source ./data/usmap.tcl
set count 0
array set colors {
0 red
1 green2
2 dodgerblue
3 cyan
4 orange
5 purple
6 brown
7 violet
8 limegreen
9 lightblue
10 yellow
11 pink
12 khaki
13 grey
14 navyblue
}
blt::vector all
blt::vector x
blt::vector y
set subset *
label .l -image $dest
$dest blank white
set bg [image create picture -file images/blt98.gif]
$dest copy $bg -to [list 0 0 [image width $dest] [image height $dest]]
pack .l
proc CompareRegions { name1 name2 } {
global us_regions
foreach { x1 y1 } $us_regions($name1) break
foreach { x2 y2 } $us_regions($name2) break
if { $x1 < $x2 } {
return 1
}
if { $x1 > $x2 } {
return -1
}
if { $y1 < $y2 } {
return 1
}
if { $y1 > $y2 } {
return -1
}
return 0
}
set cnum -1
set regions [array names us_regions $subset]
foreach region [lsort -command CompareRegions $regions] {
set coords $us_regions($region)
incr cnum
if { $cnum == 14 } {
set cnum 0
}
all set $coords
# all split x y
# set min [blt::vector expr min(x)]
# x expr { (x-$min)*3.0 + 10 }
# set min [blt::vector expr min(y)]
# y expr { (y-$min)*3.0 + 10 }
# all merge x y
all expr { all * 3.0 }
set coords [all values]
$dest draw polygon -coords $coords -color $colors($cnum) \
-antialiased 1 -shadow 1
#$dest draw line -coords $coords -color black
# foreach {rx ry} $coords {
# $dest draw rectangle [expr int($rx-2)] [expr int($ry-2)] -width [expr int($rx+2)] -height [expr int($ry+2)] -color red
# }
incr count
}
#$dest draw rectangle 200 200 -width 300 -height 300 -color green -shadow 0 \
-radius 10 -alpha 100
#$dest draw rectangle 200 200 -width 400 -height 300 -color blue -linewidth 29 \
-radius 19 -shadow 0 -antialiased 0 -alpha 180
$dest draw circle 200 200 100 -color yellow -shadow 0 \
-antialiased 1 -linewidth 10
#$dest draw line -coords "200 200 500 200" -color black
|
