#!../bltwish

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
  	# raise %W 
	}
	bindtags $w keep-raised
    }
    set file ./images/chalk.gif
    image create photo textureBg -file $file
} else {
    proc LoseFocus {} { 
	focus none 
    }
    proc KeepRaised w {
	bind w <Visibility> { 
	winop raise %W
	#	    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

#
# 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 .top configure -bg blue]
    table .top \
	.top.$name $numWin+3,0 -padx 10 -pady 10
}

button .holdButton -command {
    if { [busy isbusy .top] == "" } {
        global activeBg
	.top configure -bg $activeBg
    }
    busy .top 
    LoseFocus
}
button .releaseButton -command {
    if { [busy isbusy .top] == ".top" } {
        busy release .top
    }
    global normalBg
    .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

# Initialize a list of bitmap file names which make up the animated 
# fish cursor. The bitmap mask files have a "m" appended to them.

set bitmapList { 
  fc_left fc_left1 fc_mid fc_right1 fc_right 
}

#
# 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 StartAnimation { widget count } {
    global bitmapList
    set name [lindex $bitmapList $count]
    set cursor [list @bitmaps/$name bitmaps/${name}m blue green ]
    catch { busy configure $widget -cursor $cursor }

    incr count
    if { $count >= [llength $bitmapList] } {
	set count 0
    }
    global afterId
    set afterId($widget) [after 125 StartAnimation $widget $count]
}

proc StopAnimation { widget } {    
    global afterId
    after cancel $afterId($widget)
}

proc TranslateBusy { window } {
    set widget [string trimright $window "_Busy"]
    if { $widget != "." } {
        set widget [string trimright $widget "."]
    }
    return $widget
}


bind Busy <Map> { 
    StartAnimation [TranslateBusy %W] 0
}

bind Busy <Unmap> { 
    StopAnimation  [TranslateBusy %W] 
}

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

#
# Force the demo to stay raised
#
KeepRaised .


