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