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
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
|
package require BLT
set afterId -1
set dashOffset 0
set nextColor -1
set autocolors {
#DCFFD8
#FFD0D0
#D4D5FF
#FFFFC9
#D6FBFF
#EDD3FF
#E7FFCF
#FFEAC3
#D9E5FF
#C4FFE0
#FFD5ED
#FFDBA8
#B5CFFF
#FF7684
#85FF9B
#CEFFF8
#FFDFD0
#D0FFCF
#AFFFFF
#FFFFC2
#FFE0F4
#D8E9FF
#ECD5FF
#D2FFCA
#FFF9C4
#EFFFD8
}
set bg1 grey90
set bg2 [blt::paintbrush create color -color blue -opacity 30]
set bg3 [blt::paintbrush create linear -jitter 3 \
-colorscale linear \
-from w \
-to e \
-high grey90 -low grey98]
proc NextColor {} {
global nextColor autocolors
incr nextColor
if { $nextColor >= [llength $autocolors] } {
set nextColor 0
}
return [lindex $autocolors $nextColor]
}
proc MarchingAnts { canvas id } {
global afterId dashOffset
incr dashOffset
$canvas itemconfigure $id -activedashoffset $dashOffset
set afterId [after 100 [list MarchingAnts $canvas $id]]
}
proc Activate { canvas id } {
global afterId dashOffset
$canvas itemconfigure $id -state active -activebg [NextColor]
set dashOffset -1
after cancel $afterId
MarchingAnts $canvas $id
}
proc Deactivate { canvas id } {
global afterId bg1
$canvas itemconfigure $id -state normal -bg $bg1
after cancel $afterId
}
blt::scrollset .ss \
-xscrollbar .ss.xs \
-yscrollbar .ss.ys \
-window .ss.c
blt::tk::scrollbar .ss.ys
blt::tk::scrollbar .ss.xs
canvas .ss.c -bg white
blt::table . \
0,0 .ss -fill both
.ss.c create rectangle 100 100 300 200 -fill lightblue3 -tags "r" -width 0
.ss.c create text 200 150 -anchor c -text "This is a test" -fill blue -font "Arial 10"
set id [.ss.c create label 200 300 \
-text "Hello, World" \
-text "This is a test" \
-bg $bg1 \
-scaletofit 0 \
-activebg red3 -activelinewidth 2 -activedashes 4 \
-linewidth 1 \
-anchor c \
-textanchor c \
-font "Arial 10" \
-rotate 0 \
-width 200 \
-height 100]
blt::table . \
0,0 .ss -fill both
.ss.c bind $id <Enter> [list Activate .ss.c $id]
.ss.c bind $id <Leave> [list Deactivate .ss.c $id]
set x2 [expr [winfo reqwidth .ss.c] - 10]
set y2 [expr [winfo reqheight .ss.c] - 10]
#.ss.c configure -scrollregion [list 0 0 $x2 $y2]
bind .ss.c <4> {
set cx [expr [winfo width .ss.c] / 2]
set cy [expr [winfo height .ss.c] / 2]
.ss.c scale all $cx $cy 1.1 1.1
}
bind .ss.c <5> {
set cx [expr [winfo width .ss.c] / 2]
set cy [expr [winfo height .ss.c] / 2]
.ss.c scale all $cx $cy 0.9 0.9
}
bind .ss.c <KeyPress-Up> {
set cx [expr [winfo width .ss.c] / 2]
set cy [expr [winfo height .ss.c] / 2]
.ss.c scale all $cx $cy 1.1 1.1
}
bind .ss.c <KeyPress-Down> {
set cx [expr [winfo width .ss.c] / 2]
set cy [expr [winfo height .ss.c] / 2]
.ss.c scale all $cx $cy 0.9 0.9
}
focus .ss.c
if 1 {
after 2000 { set done 1 }
tkwait variable done
.ss.c postscript -file /tmp/junk.ps
exit 0
}
|
