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
30source scripts/globe.tcl
31
32option add *HighlightThickness 0
33
34set program [info nameofexecutable]
35if { [info exists tcl_platform ] } {
36    puts stderr $tcl_platform(platform)
37    if { $tcl_platform(platform) == "windows" } {
38        set shells [glob C:/Program\ Files/Tcl/bin/tclsh8*.exe ]
39        set program [lindex $shells 0]
40    }
41}
42if { ![file executable $program] } {
43    error "Can't execute $program"
44}
45
46set command [list $program scripts/bgtest.tcl]
47
48array set animate {
49    index	-1
50    interval	200
51    colors	"#ff8813 #ffaa13 #ffcc13 #ffff13 #ffcc13 #ffaa13 #ff8813"
52    numBitmaps	30
53    prefix	globe
54}
55
56proc Animate {} {
57    global animate
58    if { [info commands .logo] != ".logo" } {
59	set animate(index) 0
60	return
61    }
62    if { $animate(index) >= 0 } {
63	.logo configure -bitmap $animate(prefix).$animate(index)
64	incr animate(index)
65	if { $animate(index) >= $animate(numBitmaps) } {
66	    set animate(index) 0
67	}
68	after $animate(interval) Animate
69    }
70}
71
72proc InsertText { string tag } {
73    .text insert end "$tag: " "" $string $tag
74    set textlen [expr int([.text index end])]
75    scan [.vscroll get] "%s %s %s %s" total window first last
76    if { $textlen > $total } {
77	.text yview [expr $textlen-$window]
78    }
79    update idletasks
80}
81
82proc DisplayOutput { name1 name2 how } {
83    upvar #0 $name1 arr
84
85    InsertText "$arr($name2)\n" stdout
86    set arr($name2) {}
87}
88
89proc DisplayErrors { name1 name2 how } {
90    upvar #0 $name1 arr
91
92    InsertText "$arr($name2)\n" stderr
93    set arr($name2) {}
94}
95
96
97option add *text.yScrollCommand { .vscroll set }
98option add *text.relief sunken
99option add *text.width 20
100option add *text.height 10
101option add *text.height 10
102option add *text.borderWidth 2
103option add *vscroll.command { .text yview }
104option add *vscroll.minSlider 4p
105option add *stop.command { set results {} }
106option add *stop.text { stop }
107option add *logo.padX 4
108option add *title.text "Catching stdout and stderr"
109option add *title.font -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-*
110
111set visual [winfo screenvisual .]
112if { [string match *color $visual] } {
113    option add *text.background white
114    option add *text.foreground blue
115    option add *stop.background yellow
116    option add *stop.activeBackground yellow2
117    option add *stop.foreground navyblue
118    option add *start.activeBackground green2
119    option add *start.background green
120    option add *start.foreground navyblue
121    option add *logo.background beige
122    option add *logo.foreground brown
123    option add *logo.foreground green4
124    option add *title.background lightblue
125    option add *logo.background lightblue
126}
127. configure -bg lightblue
128
129trace variable results(stdout) w DisplayOutput
130trace variable results(stderr) w DisplayErrors
131
132proc Start { command } {
133    global results animate
134    .text delete 1.0 end
135    if { $animate(index) < 0 } {
136        set results(status) {}
137	eval "bgexec results(status) -lasterror results(stderr) \
138		-lastoutput results(stdout) $command &"
139        set animate(index) 0
140        Animate
141    }
142}
143
144proc Stop { } {
145    global results animate
146    set results(status) {}
147    set animate(index) -1
148}
149
150# Create widgets
151text .text
152.text tag configure stdout -font -*-Helvetica-Bold-R-*-*-18-*-*-*-*-*-*-* \
153    -foreground green2
154.text tag configure stderr -font -*-Helvetica-Medium-O-*-*-18-*-*-*-*-*-*-* \
155    -foreground red2
156
157scrollbar .vscroll
158button .start -text "Start" -command [list Start $command]
159button .stop -text "Stop" -command Stop
160label .logo  -bitmap globe.0
161label .title
162
163# Layout widgets in table
164table . \
165    .title      0,0 -columnspan 4 \
166    .text 	1,0 -columnspan 3 \
167    .vscroll 	1,3 -fill y \
168    .logo 	2,0 -anchor w -padx 10 -reqheight .6i -pady 4 \
169    .start 	2,1 \
170    .stop 	2,2
171
172set buttonWidth 1i
173table configure . c1 c2 -width 1i
174table configure . c3 r0 r2 -resize none
175table configure . .start .stop -reqwidth $buttonWidth -anchor e
176table configure . .title .text -fill both
177
178wm min . 0 0
179
180
181