util/src/TclTk/blt2.5/demos/bgexec3.tcl

   1 #!../src/bltwish
   2
   3 package 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
  24 if { $tcl_version >= 8.0 } {
  25     namespace import blt::*
  26     namespace import -force blt::tile::*
  27 }
  28
  29 source scripts/demo.tcl
  30
  31 bitmap 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
  43 bitmap 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
  55 bitmap 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
  67 bitmap 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
  79 bitmap 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 ../src/bltwish
  92 set program [info nameofexecutable]
  93 if { [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 }
 100 if { ![file executable $program] } {
 101     error "Can't execute $program"
 102 }
 103 set command [list $program scripts/bgtest.tcl]
 104 set animate(index) -1
 105 set animate(interval) 200
 106 #set animate(colors) { #ff8813 #ffaa13 #ffcc13 #ffff13 #ffcc13 #ffaa13 #ff8813 }
 107 bitmap define blt.5 [bitmap data blt.3]
 108 bitmap define blt.6 [bitmap data blt.2]
 109 bitmap define blt.7 [bitmap data blt.1]
 110
 111 proc 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
 128 proc 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
 139 proc DisplayOutput { data } {
 140     InsertText "$data\n" stdout
 141 }
 142
 143 proc DisplayErrors { data } {
 144     InsertText "$data\n" stderr
 145 }
 146
 147 set length 80
 148
 149 option add *text.yScrollCommand { .vscroll set }
 150 option add *text.relief sunken
 151 option add *text.width 20
 152 option add *text.height 10
 153 option add *text.height 10
 154 option add *text.borderWidth 2
 155 option add *vscroll.command { .text yview }
 156 option add *vscroll.minSlider 4p
 157 option add *stop.command { set results {} }
 158 option add *stop.text { stop }
 159 option add *logo.relief sunken
 160 option add *logo.padX 4
 161 option add *title.text "Catching stdout and stderr"
 162 option add *title.font -*-Helvetica-Bold-R-*-*-14-*-*-*-*-*-*-*
 163
 164 set visual [winfo screenvisual .]
 165 if { [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
 178 proc 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
 191 proc Stop { } {
 192     global results animate
 193     set results {}
 194     set animate(index) -1
 195 }
 196
 197 # Create widgets
 198 text .text
 199 .text tag configure stdout -font { Courier-Bold 14 } -foreground green2
 200 .text tag configure stderr -font  { Courier 14 } -foreground red2
 201
 202 scrollbar .vscroll
 203 button .start -text "Start" -command [list Start $command]
 204 button .stop -text "Stop" -command Stop
 205 label .logo  -bitmap blt.0
 206 label .title
 207
 208 # Layout widgets in table
 209 table . \
 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
 217 set buttonWidth 1i
 218 table configure . c1 c2 -width 1i
 219 table configure . c3 r0 r2 -resize none
 220 table configure . .start .stop -reqwidth $buttonWidth -anchor e
 221 table configure . .title .text -fill both
 222
 223 wm min . 0 0
 224
 225