##########################################
##########################################
##					##
##	WaitBox - a reusable Tk-widget	##
##		  Wait Dialog		##
##					##
##	Version 1.2			##
##					##
##	Brent B. Powers	(B2Pi)		##
##	Merrill Lynch			##
##	powers@swaps-comm.ml.com	##
##					##
##					##
##########################################
##########################################

###############################################################################
###############################################################################
## WaitBox
##    Object Oriented Wait Dialog for TkPerl
##    (Apologies to John Stoffel and Stephen O. Lidie)
##

## Changes:
## Ver 1.1 Changed show to Show, unshow to unShow, and general
##         cleanup for perl5.002 gamma
## Ver 1.2 Changed to general distribution, add VERSION and Version

###############################################
###############################################
## This version hacked to hell by Dave :-) DN1
###############################################
###############################################

package Tk::WaitBox;
use strict;
require Tk::Toplevel;

@Tk::WaitBox::ISA = qw (Tk::Toplevel);

Tk::Widget->Construct('WaitBox');

$Tk::WaitBox::VERSION = '1.2';

### A couple of convenience variables
#my(@wd_fullpack) = (-expand => 1, -fill => 'both');
my(@wd_fullpack) = ();

my(@wd_packtop) = (-side => 'top');
my(@wd_packleft) = (-side => 'left');


sub Populate {
    ### Wait box constructor.  Uses new inherited from base class
    my($cw, @args) = @_;

    $cw->SUPER::Populate(@args);

    ## Create the toplevel window
    $cw->withdraw;
    $cw->protocol('WM_DELETE_WINDOW' => sub {});
    $cw->transient($cw->toplevel);

    ### Set up the status
    $cw->{'Shown'} = 0;

    ### Set up the cancel button and text
    $cw->{'cancelroutine'} = undef if !defined($cw->{'cancelroutine'});
    $cw->{'canceltext'} = 'Cancel' if !defined($cw->{'canceltext'});

    ### OK, create the dialog
    ### Start with the upper frame (which contains two messages)
    ## And maybe more....
    my($wdtop) = $cw->Frame;
    $wdtop->pack(@wd_fullpack, @wd_packtop);

    my($fm) = $wdtop->Frame();
    $fm->pack(@wd_packleft, @wd_fullpack);

    my($bitmap) = $fm->Label(Name => 'bitmap');
    $bitmap->pack(@wd_packleft, -ipadx => 36, @wd_fullpack);

    ## Text Frame

    #$fm = $wdtop->Frame(-borderwidth => 2, -relief => 'raised');
    #my($fm) = $wdtop->Frame(-borderwidth => 2, -relief => 'raised');

    #$fm->pack(@wd_packleft, -ipadx => 20, @wd_fullpack);

    my($txt1) = $fm->Label(-wraplength => '3i', -justify => 'center',
    			     -textvariable => \$cw->{Configure}{-txt1});
    #$txt1->pack(@wd_packtop, -pady => 3, @wd_fullpack);


    ### Eventually, I want to create a user configurable frame
    ### in between the two frames
    my($uframe) = $fm->Frame;
    $uframe->pack(@wd_packtop);
    $cw->Advertise(uframe => $uframe);

    $cw->{Configure}{-txt2} = "Please Wait"
	    unless defined($cw->{Configure}{-txt2});

    my($txt2) = $fm->Label(-textvariable => \$cw->{Configure}{-txt2});
    #$txt2->pack(@wd_packtop, @wd_fullpack, -pady => 9);

    ### We'll let the cancel frame and button wait until Show time

    ### Set up configuration
    $cw->ConfigSpecs(-bitmap	=> [$bitmap, undef, undef, 'hourglass'],
		     -foreground=> [[$txt1,$txt2], 'foreground','Foreground','black'],
		     -background=> ['DESCENDANTS', 'background', 'Background',undef],
		     -font	=> [$txt1,'font','Font','-Adobe-Helvetica-Bold-R-Normal--*-180-*'],
		     -canceltext=> ['PASSIVE', undef, undef, 'Cancel'],
		     -cancelroutine=> ['PASSIVE', undef, undef, undef],
		     -txt1	=> ['PASSIVE', undef, undef, undef],
		     -txt2	=> ['PASSIVE',undef,undef,undef],
		     -resizeable => ['PASSIVE',undef,undef,1]);
}

sub Version {return $Tk::WaitBox::VERSION;}

sub Show {
    ## Do last minute configuration and Show the dialog
    my($wd, @args) = @_;

    if ( defined($wd->{Configure}{-cancelroutine}) &&
	!defined($wd->{'CanFrame'})) {

	my($canFrame) = $wd->Frame (-background => $wd->cget('-background'));
	$wd->{'CanFrame'} = $canFrame;
	#$canFrame->pack(-side => 'top', @wd_packtop, -fill => 'both');
	$canFrame->pack(-side => 'right', -fill => 'both');

	$canFrame->configure(-cursor => 'top_left_arrow');
	$canFrame->Button(-text => $wd->{Configure}{-canceltext},
			  #-font => '-*-*-*-*-*-*-13-*-*-*-*-*-*-*',
			   -font => '-*-clean-*-r-*-*-14-*-*-*-*-*-*-*',
			  -command => $wd->{Configure}{-cancelroutine})

#		->pack(-padx => 5, -pady => 5,
#		       -ipadx => 5, -ipady => 5);
	    ->pack();

    }

    ## Grab the input queue and focus
    $wd->parent->configure(-cursor => 'watch');
    $wd->configure(-cursor => 'watch');
    $wd->update;

    my($x) = int( ($wd->screenwidth
		 - $wd->reqwidth)/2
		 - $wd->vrootx);

    my($y) = int( ($wd->screenheight
		 - $wd->reqheight)/2
		 - $wd->vrooty);

    $wd->geometry("+$x+$y");

    $wd->{'Shown'} = 1;

    $wd->deiconify;
    $wd->tkwait('visibility', $wd);

    $wd->grab();
    $wd->focus();
    $wd->update;

    return $wd;

}

sub unShow {
    my($wd) = @_;

    return if !$wd->{'Shown'};
    $wd->{'CanFrame'}->destroy if (defined($wd->{'CanFrame'}));
    $wd->{'CanFrame'} = undef;
    $wd->parent->configure(-cursor => 'top_left_arrow');

    $wd->grab('release');
    $wd->withdraw;
    $wd->parent->update;
    $wd->{'Shown'} = 0;
}

1;
