$APE::Tk::TractSelector::VERSION = '1.0';

package APE::Tk::TractSelector;

use Tk::widgets qw/Listbox Button Font/;
use base qw/Tk::Derived Tk::DialogBox/;
use strict;
use warnings;
use Carp;

use APE::AtomicProcessEngine;

use constant TRUE  => 1;
use constant FALSE => 0;

Construct Tk::Widget 'TractSelector';


########################################################################
## Standard Tk mega widget method for creating this mega widget and 
## initialising the super class widget.
########################################################################
sub ClassInit {
    my ($class,$mw) = @_;
    $class->SUPER::ClassInit($mw);
}


########################################################################
## Standard Tk mega widget method for defining mega widget
## characteristics and capturing arguments unknown to Tk.
########################################################################
sub Populate {
    my ($self,$args) = @_;
    
    $self->{_roleType} = delete $args->{-roleType};

    my %apeArgs = (topLevelProcessId => 5001,
		   populateDepth     => 1);

    $apeArgs{roleType} = $self->{_roleType} if $self->{_roleType};

    ## Use the top level processes passed in or get our own.
    $self->{_tlApe} = delete $args->{-atomicProcessEngine} ||
	eval { my $user = new User(noPopulate=>TRUE); 
	       new APE::AtomicProcessEngine(%apeArgs); };
    croak "ERROR: $@" if $@;

 
    ## Get a list of the top level processes.
    $self->{_tlProcessList} = $self->{_tlApe}->getSubProcessList ||
	croak "ERROR: AtomicProcessEngine object has no sub processes";

    ## Have we been sent a list of already loaded APE processes? If we
    ## have then we need to sort them depending on whether we're
    ## loading or unloading.
    if($args->{-loadedApeHash}) {
	$self->{_loadedApeHash} = delete $args->{-loadedApeHash};
	$self->_sortApes($self->{_isLoading} = delete $args->{-isLoading});
    }else{ $self->{_isLoading} = TRUE; }

    ## Define the default buttons - this also stops the introduction
    ## of other buttons.
    my $startBttnText = ($self->{_isLoading} ? "Load" : "Unload");
    $args->{-buttons} = [$startBttnText,'Cancel'];
    $args->{-default_button} = $startBttnText;

    $self->SUPER::Populate($args);
    $self->{_logo}       = $self->Photo(-file=>Tk::findINC("APE/Tk/Images/ape_logo.gif"));
    $self->{_smallFont}  = $self->Font(-family=>'Helvetica',-size=>10);
    $self->{_mediumFont} = $self->Font(-family=>'Helvetica',-size=>14);
    $self->{_largeFont}  = $self->Font(-family=>'Helvetica',-size=>20);
    $self->_createFrame;
    $self->_createTractListbox;
    $self->_populateTractList;
}


########################################################################
## Method to sort the APE objects so that, when loading new tracts, only
## non loaded tracts appear for selection and when unloading tract, only 
## tracts that are currently loaded appear for selection.
########################################################################
sub _sortApes {
    my ($self,$isLoading) = @_;
    my @processList=();
    foreach my $process (@{$self->{_tlProcessList}}) {
	if(exists($self->{_loadedApeHash}{$process->getProcessId})) {
	    push(@processList,$process) if !$isLoading;
	}else{
	    push(@processList,$process) if $isLoading;
	}
    }
    $self->{_tlProcessList} = \@processList;
}


########################################################################
## Method to create the main frame inside the DialogBox base class
## widget.  All other widgets are packed into this frame.
########################################################################
sub _createFrame {
    my $self = shift;
    $self->{_mainFrame} = $self->add('Frame');
    $self->{_mainFrame}->pack(-fill=>'both',-expand=>1);
    $self->_createTitleFrame;
    $self->_createDataFrame;
    $self->_createBttns;
}


########################################################################
## Method to create the title frame and to pack it with the title
## label/s.
########################################################################
sub _createTitleFrame {
    my $self = shift;
    my $width  = $self->{_logo}->width;
    my $height = $self->{_logo}->height;
    $self->{_titleFrame}  = $self->{_mainFrame}->Frame(-relief=>'ridge',-borderwidth=>1);
    $self->{_titleFrame}->Label(-text=>"Please select tracts to ".($self->{_isLoading} ? "load" : "unload"),
				-font=>$self->{_largeFont})->pack;
    $self->{_titleFrame}->Label(-text=>'Tracts may take a short time to load.',
				-font=>$self->{_smallFont})->pack(-pady=>2) if $self->{_isLoading};
    $self->{_titleFrame}  ->pack(-expand=>1,-pady=>5,-padx=>5,-fill=>'x');
}


########################################################################
## Method to create the data frame and to pack it with the button and 
## list frames.
########################################################################
sub _createDataFrame {
    my $self = shift;
    $self->{_dataFrame} = $self->{_mainFrame}->Frame;#(-relief=>'ridge',-borderwidth=>1);
    $self->{_dataFrame} ->pack(-expand=>1,-pady=>5,-padx=>5,-fill=>'both');
    $self->{_bttnFrame} = $self->{_dataFrame}->Frame->grid(-column=>0,-row=>0,-sticky=>'ns');
    $self->{_listFrame} = $self->{_dataFrame}->Frame->grid(-column=>1,-row=>0,-sticky=>'news');
}


########################################################################
## Method to create the button widgets and to pack them into the button
## frame.
########################################################################
sub _createBttns {
    my $self = shift;
    {
	no strict 'refs';
	my $row=0;
	my ($bttnText,$bttn);
	foreach('Select_All','Clear_All') {
	    my $anonSub = \&{"_".lc($_)};
	    $bttnText = $_;
	    $bttnText =~ s/_/ /;
	    $bttn = $self->{_bttnFrame}->Button(-text=>$bttnText,-width=>12);
	    $bttn->configure(-command=>[$anonSub,$self,$bttn]);
	    $bttn->grid(-column=>0,-row=>$row++,-pady=>1,-padx=>3);
	}
    }
}


########################################################################
## Method to create the listbox that will be used to display the
## process tracts to load and unload.
########################################################################
sub _createTractListbox {
    my $self = shift;
    $self->{_tractListbox} = 
	$self->{_listFrame}->Scrolled('Listbox',-scrollbars=>'osoe',-height=>4,-bg=>'white',
				      -selectmode=>'extended')
	->pack(-fill=>'x',-expand=>1);
}


########################################################################
## Method to populate the process tract listbox with the tracts that the
## user may select.
########################################################################
sub _populateTractList {
    my $self = shift;
    foreach my $process (@{$self->{_tlProcessList}}) {
	$self->{_tractListbox}->insert('end',$process->getDescription);
    }
    $self->{_tractListbox}->update('idletasks');
}


########################################################################
## Callback method called when the 'Select All' button is depressed.
## Selects all of the process tracts currently in the tract listbox.
########################################################################
sub _select_all {
    my ($self,$bttn) = @_;
    $self->{_tractListbox}->selectionSet(0,'end');
}


########################################################################
## Callback method called when the 'Clear All' button is depressed.
## Deselects all of the process tracts currently selected in the tract
## listbox.
########################################################################
sub _clear_all {
    my ($self,$bttn) = @_;
    $self->{_tractListbox}->selectionClear(0,'end');
}


########################################################################
## Over-riden method from the DialogBox base class. This method
## displays this TractSelector on the screen. When either of the
## buttons is depressed, the text of the button along with an array ref
## containing the selected process tracts is returned.
########################################################################
sub Show {
    my ($self,$grab) = @_;
    my $bttn = $self->SUPER::Show($grab);
    my @selectedProcessList=();
    my @selected = $self->{_tractListbox}->curselection;
    foreach(@selected) { push(@selectedProcessList,$self->{_tlProcessList}->[$_]); }
    return($bttn,\@selectedProcessList);
}
