#!../blt_wish -f if [file exists ../library] { set blt_library ../library } # # Script to test the "busy" command. # # # General widget class resource attributes # option add *Button.padX 10 option add *Button.padY 2 option add *Scale.relief sunken option add *Scale.orient horizontal option add *Entry.relief sunken set visual [winfo screenvisual .] if { $visual == "staticgray" || $visual == "grayscale" } { set activeBg black set normalBg white set bitmapFg black set bitmapBg white } else { set activeBg red set normalBg springgreen set bitmapFg blue set bitmapBg green } # # Instance specific widget options # option add Tk.top.relief sunken option add Tk.top.borderWidth 4 option add Tk.top.background $normalBg option add Tk.b1.text "Test" option add Tk.b2.text "Quit" option add Tk.b3.text "New button" option add Tk.b4.text "Hold" option add Tk.b4.background $activeBg option add Tk.b4.foreground $normalBg option add Tk.b5.text "Release" option add Tk.b5.background $normalBg option add Tk.b5.foreground $activeBg # # This never gets used; it's reset by the Animate proc. It's # here to just demonstrate how to set busy window options via # the host window path name # option add Tk.top.busyCursor bogosity # # Initialize a list bitmap file names which make up the animated # fish cursor. The bitmap mask files have a "m" appended to them. # set bitmaps { fc_left fc_left1 fc_mid fc_right1 fc_right } # # Counter for new buttons created by the "New button" button # set numWin 0 # # Current index into the bitmap list. Indicates the current cursor. # If -1, indicates to stop animating the cursor. # set cnt -1 # # Create two frames. The top frame will be the host window for the # busy window. It'll contain widgets to test the effectiveness of # the busy window. The bottom frame will contain buttons to # control the testing. # frame .top frame .bottom # # Create some widgets to test the busy window and its cursor # button .b1 -command { puts stdout "Not busy." } button .b2 -command { destroy . } entry .e1 scale .s1 # # The following buttons sit in the lower frame to control the demo # button .b3 -command { global numWin incr numWin set name button#${numWin} button .top.$name -text "$name" \ -command [list puts stdout "I am $name"] pack append .top .top.$name { expand padx 10 pady 10 } } button .b4 -command { blt_busy .top -in . focus none global cnt activeBg if { $cnt < 0 } { .top configure -bg $activeBg set cnt 0 Animate .top } } button .b5 -command { catch {blt_busy release .top} mesg global cnt normalBg set cnt -1 .top configure -bg $normalBg } # # Notice that the widgets packed in .top and .bottom are not their children # pack append .top \ .b1 { expand padx 10 pady 10 } \ .e1 { expand padx 10 pady 10 } \ .s1 { expand padx 10 pady 10 } \ .b2 { expand padx 10 pady 10 } pack append .bottom \ .b3 { expand padx 10 pady 10 } \ .b4 { expand padx 10 pady 10 } \ .b5 { expand padx 10 pady 10 } # # Finally, realize and map the top level window # pack append . .top { top expand } .bottom { fill expand } # # Simple cursor animation routine: Uses the "after" command to # circulate through a list of cursors every 0.075 seconds. The # first pass through the cursor list may appear sluggish because # the bitmaps have to be read from the disk. Tk's cursor cache # takes care of it afterwards. # proc Animate w { global cnt if { $cnt >= 0 } { global bitmaps bitmapFg bitmapBg set name [lindex $bitmaps $cnt] set src @bitmaps/${name} set mask bitmaps/${name}m blt_busy configure $w -cursor [list $src $mask $bitmapFg $bitmapBg] incr cnt if { $cnt > 4 } { set cnt 0 } after 75 Animate $w } else { blt_busy configure $w -cursor watch } } # # For testing purposes allow the top level window to be resized # wm min . 0 0 # # If the "raise" window command exists, force the demo to stay raised # if { [info commands "raise"] == "raise" } { bind . { raise %W } }