#!/bin/sh ./myblt

source bltDemo.tcl

#
# 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
option add *Frame.borderWidth 	2

set visual [winfo screenvisual .] 
if { $visual == "staticgray"  || $visual == "grayscale" } {
    set activeBg black
    set normalBg white
    set bitmapFg black
    set bitmapBg white
    option add *top.background 		white
} else {
    set activeBg red
    set normalBg springgreen
    set bitmapFg blue
    set bitmapBg green
    option add *Button.background       khaki2
    option add *Button.activeBackground khaki1
    option add *Frame.background        khaki2
    option add *bottom.tile		textureBg
#    option add *Button.tile		textureBg

    option add *releaseButton.background 		limegreen
    option add *releaseButton.activeBackground 	springgreen
    option add *releaseButton.foreground 		black

    option add *holdButton.background 		red
    option add *holdButton.activeBackground	pink
    option add *holdButton.foreground 		black
    option add *top.background 		springgreen
}

#
# Instance specific widget options
#
option add *top.relief 		sunken
option add *top.background 	$normalBg
option add *testButton.text 	"Test"
option add *quitButton.text 	"Quit"
option add *newButton.text 	"New button"
option add *holdButton.text 	"Hold"
option add *releaseButton.text 	"Release"
option add *buttonLabel.text	"Buttons"
option add *entryLabel.text	"Entries"
option add *scaleLabel.text	"Scales"
option add *textLabel.text	"Text"

if { $tk_version >= 4.0 } {
    proc LoseFocus {} { 
	focus -force . 
    }
    proc KeepRaised w {
	
	# We have to do it this way because of Tk insists upon
	# propagating events from toplevels to their children.
	# This seems like way too much of hack just to handle 
	# keyboard accelerators.
	
	bind keep-raised <Visibility> { 
	    winop raise %W 
	}
	bindtags $w keep-raised
    }
    set file bitmaps/corrugated_metal.gif
    image create photo textureBg -file $file
} else {
    proc LoseFocus {} { 
	focus none 
    }
    proc KeepRaised w {
	bind w <Visibility> { 
	    winop raise %W 
	}
    }
}

#
# 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 *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
#
label .buttonLabel
button .testButton -command { 
    puts stdout "Not busy." 
}
button .quitButton -command { exit }
entry .entry 
scale .scale
text .text -width 20 -height 4


#
# The following buttons sit in the lower frame to control the demo
#
button .newButton -command {
    global numWin
    incr numWin
    set name button#${numWin}
    button .top.$name -text "$name" \
	-command [list puts stdout "I am $name"]
    table .top \
	.top.$name $numWin+3,0 -padx 10 -pady 10
}

button .holdButton -command {
    busy .top 
    LoseFocus
    global cnt activeBg
    if { $cnt < 0 } {
	.top configure -bg $activeBg
	set cnt 0
	Animate .top
    }
}
button .releaseButton -command {
    catch {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
#
table .top \
    .testButton 0,0 \
    .scale 1,0 \
    .entry 0,1 \
    .text 1,1 -fill both \
    .quitButton 2,0 -cspan 2

table .bottom \
    .newButton 0,0 \
    .holdButton 1,0 \
    .releaseButton 2,0  

table configure .top \
    .testButton .scale .entry .quitButton -padx 10 -pady 10
table configure .bottom \
    .newButton .holdButton .releaseButton -padx 10 -pady 10

#
# Finally, realize and map the top level window
#
table . \
    .top 0,0  \
    .bottom 1,0 

table configure . .bottom -fill both

#
# 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
	busy configure $w -cursor [list $src $mask $bitmapFg $bitmapBg]
	incr cnt
	if { $cnt > 4 } {
	    set cnt 0
	}
	after 75 Animate $w
    } else {
	busy configure $w -cursor watch
    }
}

#
# For testing purposes allow the top level window to be resized 
#
wm min . 0 0

#
# Force the demo to stay raised
#
KeepRaised .


