1#!/usr/local/bin/bltwish
2
3package require BLT
4# --------------------------------------------------------------------------
5# Starting with Tcl 8.x, the BLT commands are stored in their own
6# namespace called "blt".  The idea is to prevent name clashes with
7# Tcl commands and variables from other packages, such as a "table"
8# command in two different packages.
9#
10# You can access the BLT commands in a couple of ways.  You can prefix
11# all the BLT commands with the namespace qualifier "blt::"
12#
13#    blt::graph .g
14#    blt::table . .g -resize both
15#
16# or you can import all the command into the global namespace.
17#
18#    namespace import blt::*
19#    graph .g
20#    table . .g -resize both
21#
22# --------------------------------------------------------------------------
23
24if { $tcl_version >= 8.0 } {
25    namespace import blt::*
26    namespace import -force blt::tile::*
27}
28
29source scripts/demo.tcl
30
31bitmap define blt.0 {{40 40} {
32    00 00 00 00 00 00 fc 07 00 00 00 04 08 00 00 00 04 04 00 00 00 e4 03 00
33    00 00 64 fe 07 00 00 64 02 04 00 00 e4 03 04 00 00 64 7e 02 00 00 64 1a
34    02 00 00 e4 1b 01 00 00 04 1a 01 00 00 04 1a 01 00 00 fc 1b 02 00 00 0c
35    1a 02 00 00 0c 02 04 00 00 0c 02 f4 03 80 ed fe 07 04 e0 0c 00 20 09 10
36    0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
37    50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
38    2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
39    43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
40    fe ff 00 00 00 00 00 00}
41}
42
43bitmap define blt.1 {{40 40} {
44    00 00 00 00 00 00 fc 07 00 00 00 04 08 00 00 00 04 04 00 00 00 e4 ff 0f
45    00 00 64 06 08 00 00 64 06 08 00 00 e4 ff 04 00 00 64 36 04 00 00 64 36
46    02 00 00 e4 37 02 00 00 04 34 02 00 00 04 34 04 00 00 fc 35 04 00 00 0c
47    04 08 00 00 0c 04 08 00 00 0c fc ef 03 80 ed 01 00 04 e0 0c 00 20 09 10
48    0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
49    50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
50    2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
51    43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
52    fe ff 00 00 00 00 00 00}
53}
54
55bitmap define blt.2 {{40 40} {
56    00 00 00 00 00 00 fc 0f 00 00 00 04 10 00 00 00 04 10 00 00 00 e4 fb 3f
57    00 00 64 0e 20 00 00 64 0e 20 00 00 e4 fb 13 00 00 64 ce 10 00 00 64 ce
58    08 00 00 e4 cb 08 00 00 04 c8 08 00 00 04 c8 10 00 00 fc cf 10 00 00 0c
59    08 20 00 00 0c 08 20 00 00 0c f8 bf 03 80 ed 03 00 04 e0 0c 00 20 09 10
60    0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
61    50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
62    2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
63    43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
64    fe ff 00 00 00 00 00 00}
65}
66
67bitmap define blt.3 {{40 40} {
68    00 00 00 00 00 00 fc 0f 00 00 00 04 f0 ff 00 00 04 00 80 00 00 e4 03 80
69    00 00 64 d6 4f 00 00 64 16 43 00 00 e4 13 23 00 00 64 16 23 00 00 64 16
70    23 00 00 e4 13 43 00 00 04 70 43 00 00 04 00 80 00 00 fc 0f 80 00 00 0c
71    f0 ff 00 00 0c 00 00 00 00 0c f8 ff 03 80 ed 07 00 04 e0 0c 00 20 09 10
72    0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
73    50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
74    2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
75    43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
76    fe ff 00 00 00 00 00 00}
77}
78
79bitmap define blt.4 {{40 40} {
80    00 00 00 00 00 00 fc ff ff 03 00 04 00 00 02 00 04 00 00 02 00 e4 33 3f
81    01 00 64 36 0c 01 00 64 36 8c 00 00 e4 33 8c 00 00 64 36 8c 00 00 64 36
82    0c 01 00 e4 f3 0d 01 00 04 00 00 02 00 04 00 00 02 00 fc ff ff 03 00 0c
83    00 00 00 00 0c 00 00 00 00 0c f8 ff 03 80 ed 07 00 04 e0 0c 00 20 09 10
84    0c 00 00 12 10 0c 00 00 10 30 00 00 00 19 d0 03 00 00 14 b0 fe ff ff 1b
85    50 55 55 55 0d e8 aa aa aa 16 e4 ff ff ff 2f f4 ff ff ff 27 d8 ae aa bd
86    2d 6c 5f d5 67 1b bc f3 7f d0 36 f8 01 10 cc 1f e0 45 8e 92 0f b0 32 41
87    43 0b d0 cf 3c 7c 0d b0 aa c2 ab 0a 60 55 55 55 05 c0 ff ab aa 03 00 00
88    fe ff 00 00 00 00 00 00}
89}
90
91#set program /usr/local/bin/bltwish
92set program [info nameofexecutable]
93if { [info exists tcl_platform ] } {
94    puts stderr $tcl_platform(platform)
95    if { $tcl_platform(platform) == "windows" } {
96        set shells [glob C:/Program\ Files/Tcl/bin/tclsh8*.exe ]
97  	set program [lindex $shells 0]
98    }
99}
100if { ![file executable $program] } {
101    error "Can't execute $program"
102}
103set command [list $program scripts/bgtest.tcl]
104set animate(index) -1
105set animate(interval) 200
106#set animate(colors) { #ff8813 #ffaa13 #ffcc13 #ffff13 #ffcc13 #ffaa13 #ff8813 }
107bitmap define blt.5 [bitmap data blt.3]
108bitmap define blt.6 [bitmap data blt.2]
109bitmap define blt.7 [bitmap data blt.1]
110
111proc Animate {} {
112    global animate
113    if { [info commands .logo] != ".logo" } {
114	set animate(index) 0
115	return
116    }
117    if { $animate(index) >= 0 } {
118	.logo configure -bitmap blt.$animate(index)
119	incr animate(index)
120	if { $animate(index) >= 7 } {
121	    set animate(index) 0
122	}
123	after $animate(interval) Animate
124    }
125}
126
127
128proc InsertText { string tag } {
129    .text insert end "$tag: " "" $string $tag
130    set textlen [expr int([.text index end])]
131    scan [.vscroll get] "%s %s %s %s" total window first last
132    if { $textlen > $total } {
133	.text yview [expr $textlen-$window]
134    }
135    update idletasks
136    update
137}
138
139proc DisplayOutput { data } {
140    InsertText "$data\n" stdout
141}
142
143proc DisplayErrors { data } {
144    InsertText "$data\n" stderr
145}
146
147set length 80
148
149option add *text.yScrollCommand { .vscroll set }
150option add *text.relief sunken
151option add *text.width 20
152option add *text.height 10
153option add *text.height 10
154option add *text.borderWidth 2
155option add *vscroll.command { .text yview }
156option add *vscroll.minSlider 4p
157option add *stop.command { set results {} }
158option add *stop.text { stop }
159option add *logo.relief sunken
160option add *logo.padX 4
161option add *title.text "Catching stdout and stderr"
162option add *title.font -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-*
163
164set visual [winfo screenvisual .]
165if { [string match *color $visual] } {
166    option add *text.background white
167    option add *text.foreground blue
168    option add *stop.background yellow
169    option add *stop.activeBackground yellow2
170    option add *stop.foreground navyblue
171    option add *start.activeBackground green2
172    option add *start.background green
173    option add *start.foreground navyblue
174    option add *logo.background beige
175    option add *logo.foreground brown
176}
177
178proc Start { command } {
179    global results animate
180    .text delete 1.0 end
181    if { $animate(index) < 0 } {
182        set results {}
183        set animate(index) 0
184        eval "bgexec results -error barney -output fred -killsignal SIGINT \
185	    -onoutput DisplayOutput -onerror DisplayErrors -linebuffered no \
186		$command &"
187        Animate
188    }
189}
190
191proc Stop { } {
192    global results animate
193    set results {}
194    set animate(index) -1
195}
196
197# Create widgets
198text .text
199.text tag configure stdout -font { Courier-Bold 14 } -foreground green2
200.text tag configure stderr -font  { Courier 14 } -foreground red2
201
202scrollbar .vscroll
203button .start -text "Start" -command [list Start $command]
204button .stop -text "Stop" -command Stop
205label .logo  -bitmap blt.0
206label .title
207
208# Layout widgets in table
209table . \
210    .title      0,0 -columnspan 4 \
211    .text 	1,0 -columnspan 3 \
212    .vscroll 	1,3 -fill y \
213    .logo 	2,0 -anchor w -padx 10 -reqheight .6i -pady 4 \
214    .start 	2,1 \
215    .stop 	2,2
216
217set buttonWidth 1i
218table configure . c1 c2 -width 1i
219table configure . c3 r0 r2 -resize none
220table configure . .start .stop -reqwidth $buttonWidth -anchor e
221table configure . .title .text -fill both
222
223wm min . 0 0
224
225
226