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
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
|
#!../src/bltwish
package require BLT
blt::bitmap define blt.0 {{40 40} {
00 00 00 00 00 00 fc 07 00 00 00 04 08 00 00 00 04 04 00 00 00 e4 03 00
00 00 64 fe 07 00 00 64 02 04 00 00 e4 03 04 00 00 64 7e 02 00 00 64 1a
02 00 00 e4 1b 01 00 00 04 1a 01 00 00 04 1a 01 00 00 fc 1b 02 00 00 0c
1a 02 00 00 0c 02 04 00 00 0c 02 f4 03 80 ed fe 07 04 e0 0c 00 20 09 10
0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
fe ff 00 00 00 00 00 00}
}
blt::bitmap define blt.1 {{40 40} {
00 00 00 00 00 00 fc 07 00 00 00 04 08 00 00 00 04 04 00 00 00 e4 ff 0f
00 00 64 06 08 00 00 64 06 08 00 00 e4 ff 04 00 00 64 36 04 00 00 64 36
02 00 00 e4 37 02 00 00 04 34 02 00 00 04 34 04 00 00 fc 35 04 00 00 0c
04 08 00 00 0c 04 08 00 00 0c fc ef 03 80 ed 01 00 04 e0 0c 00 20 09 10
0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
fe ff 00 00 00 00 00 00}
}
blt::bitmap define blt.2 {{40 40} {
00 00 00 00 00 00 fc 0f 00 00 00 04 10 00 00 00 04 10 00 00 00 e4 fb 3f
00 00 64 0e 20 00 00 64 0e 20 00 00 e4 fb 13 00 00 64 ce 10 00 00 64 ce
08 00 00 e4 cb 08 00 00 04 c8 08 00 00 04 c8 10 00 00 fc cf 10 00 00 0c
08 20 00 00 0c 08 20 00 00 0c f8 bf 03 80 ed 03 00 04 e0 0c 00 20 09 10
0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
fe ff 00 00 00 00 00 00}
}
blt::bitmap define blt.3 {{40 40} {
00 00 00 00 00 00 fc 0f 00 00 00 04 f0 ff 00 00 04 00 80 00 00 e4 03 80
00 00 64 d6 4f 00 00 64 16 43 00 00 e4 13 23 00 00 64 16 23 00 00 64 16
23 00 00 e4 13 43 00 00 04 70 43 00 00 04 00 80 00 00 fc 0f 80 00 00 0c
f0 ff 00 00 0c 00 00 00 00 0c f8 ff 03 80 ed 07 00 04 e0 0c 00 20 09 10
0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
fe ff 00 00 00 00 00 00}
}
blt::bitmap define blt.4 {{40 40} {
00 00 00 00 00 00 fc ff ff 03 00 04 00 00 02 00 04 00 00 02 00 e4 33 3f
01 00 64 36 0c 01 00 64 36 8c 00 00 e4 33 8c 00 00 64 36 8c 00 00 64 36
0c 01 00 e4 f3 0d 01 00 04 00 00 02 00 04 00 00 02 00 fc ff ff 03 00 0c
00 00 00 00 0c 00 00 00 00 0c f8 ff 03 80 ed 07 00 04 e0 0c 00 20 09 10
0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
fe ff 00 00 00 00 00 00}
}
set program tclsh
if { [info exists tcl_platform ] } {
puts stderr $tcl_platform(platform)
if { $tcl_platform(platform) == "windows" } {
set shells [glob C:/Program\ Files/Tcl/bin/tclsh8*.exe ]
set program [lindex $shells 0]
}
}
if { ![file executable $program] } {
# error "Can't execute $program"
}
set command [list $program scripts/bgtest.tcl]
set animate(index) -1
set animate(interval) 200
#set animate(colors) { #ff8813 #ffaa13 #ffcc13 #ffff13 #ffcc13 #ffaa13 #ff8813 }
blt::bitmap define blt.5 [blt::bitmap data blt.3]
blt::bitmap define blt.6 [blt::bitmap data blt.2]
blt::bitmap define blt.7 [blt::bitmap data blt.1]
proc Animate {} {
global animate
if { [info commands .logo] != ".logo" } {
set animate(index) 0
return
}
if { $animate(index) >= 0 } {
.logo configure -bitmap blt.$animate(index)
incr animate(index)
if { $animate(index) >= 7 } {
set animate(index) 0
}
after $animate(interval) Animate
}
}
proc InsertText { string tag } {
.text insert end "$tag: " "" $string $tag
set textlen [expr int([.text index end])]
scan [.vscroll get] "%s %s %s %s" total window first last
if { $textlen > $total } {
.text yview [expr $textlen-$window]
}
update idletasks
update
}
proc DisplayOutput { data } {
InsertText "$data\n" stdout
}
proc DisplayErrors { data } {
InsertText "$data\n" stderr
}
set length 80
option add *text.yScrollCommand { .vscroll set }
option add *text.relief sunken
option add *text.width 20
option add *text.height 10
option add *text.height 10
option add *text.borderWidth 2
option add *vscroll.command { .text yview }
option add *vscroll.minSlider 4p
option add *stop.command { set results {} }
option add *stop.text { stop }
option add *logo.relief sunken
option add *logo.padX 4
option add *title.text "Catching stdout and stderr"
option add *title.font -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-*
set visual [winfo screenvisual .]
if { [string match *color $visual] } {
option add *text.background white
option add *text.foreground blue
option add *stop.background yellow
option add *stop.activeBackground yellow2
option add *stop.foreground navyblue
option add *start.activeBackground green2
option add *start.background green
option add *start.foreground navyblue
option add *logo.background beige
option add *logo.foreground brown
}
proc Start { command } {
global results animate
.text delete 1.0 end
lappend switches \
-error barney \
-output fred \
-killsignal SIGINT \
-onoutput DisplayOutput \
-onerror DisplayErrors \
-linebuffered no
if { $tcl_platform(platform) != "windows" } {
lappend switches "-tty"
}
if { $animate(index) < 0 } {
set results {}
set animate(index) 0
eval "blt::bgexec results $switches $command &"
Animate
}
}
proc Stop { } {
global results animate
set results {}
set animate(index) -1
}
# Create widgets
text .text
.text tag configure stdout -font { Courier-Bold 14 } -foreground green2
.text tag configure stderr -font { Courier 14 } -foreground red2
scrollbar .vscroll
button .start -text "Start" -command [list Start $command]
button .stop -text "Stop" -command Stop
label .logo -bitmap blt.0
label .title
# Layout widgets in table
blt::table . \
.title 0,0 -columnspan 4 \
.text 1,0 -columnspan 3 \
.vscroll 1,3 -fill y \
.logo 2,0 -anchor w -padx 10 -reqheight .6i -pady 4 \
.start 2,1 \
.stop 2,2
set buttonWidth 1i
blt::table configure . c1 c2 -width 1i
blt::table configure . c3 r0 r2 -resize none
blt::table configure . .start .stop -reqwidth $buttonWidth -anchor e
blt::table configure . .title .text -fill both
wm min . 0 0
|
