#######################################################################
# This software has been created by Genome Research Limited (GRL).    # 
# GRL hereby grants permission to use, copy, modify and distribute    # 
# this software and its documentation for non-commercial purposes     # 
# without fee at the user's own risk on the basis set out below.      #
# GRL neither undertakes nor accepts any duty whether contractual or  # 
# otherwise in connection with the software, its use or the use of    # 
# any derivative, and makes no representations or warranties, express #
# or implied, concerning the software, its suitability, fitness for   #
# a particular purpose or non-infringement.                           #
# In no event shall the authors of the software or GRL be responsible # 
# or liable for any loss or damage whatsoever arising in any way      # 
# directly or indirectly out of the use of this software or its       # 
# derivatives, even if advised of the possibility of such damage.     #
# Our software can be freely distributed under the conditions set out # 
# above, and must contain this copyright notice.                      #
#######################################################################

require Exporter;

@gull_graphics::ISA = qw(Exporter);
@gull_graphics::EXPORT = qw(start_graphics);

use gull_graphic_obj;
use gull_graphics_sql;

package gull_graphics;


my $on;
my $on_left;
my $on_right;
my $canvas;

# $Id: gull_graphics.pm,v 1.2 1999/01/27 10:13:11 dn1 Exp $
# $Log: gull_graphics.pm,v $
# Revision 1.2  1999/01/27 10:13:11  dn1
# *** empty log message ***
#

# DN1
#####################################
# Graphics section for Clone/Project 
#####################################

sub start_graphics {
    my ($db, $mw, $hit, $call_prog) = @_;
    my $entrycolour = 'white';

#    my $capture = Data::Dumper::Dumper($hit);
#    warn $capture;
    
    ######################
    # Make a new toplevel
    ######################
    my $graphics = $mw->Toplevel;
    $graphics-> configure(cursor  => 'hand2');
    $graphics->wm('minsize', 820, 520); 
    $graphics->wm('maxsize', 820, 520);
    $graphics->packPropagate(0);
    
    # Title 
    my $this_contig;
    my $contigs;
    if ($call_prog eq 'gull'){
	$graphics->configure (-title => "Clone name $hit->{Clone_info}->{Clonename}");
	my $dbh = WrapDBI->connect("$db", {RaiseError => 1});
	# Find out the contig from the clonename
	$contigs = convert->clone2contig($dbh, $hit->{Clone_info}->{Clonename});
	# No point going on if there are no associated contigs
#	warn "***** @$contigs[0] \n";
	if (@$contigs[0] eq ''){
	    &main::popup ($graphics, "WARN", ["Sorry ! Cannot plot as there are no associated contigs for this hit.  \n"]);
	    $dbh->disconnect();
	    $graphics->destroy();
	    return();
	}	

	$dbh->disconnect;
    }
    
    # This contig info frame
    my $info_frame = $graphics->Frame();
    $info_frame->pack(side => 'top', fill => 'x');

    # Menubar frame
    my $menuBar1 = $graphics->Frame();
    $menuBar1->pack(side => 'top', fill => 'x');


    # Canvas frame
    my $canvas_frame = $graphics->Frame(-relief => 'groove', -borderwidth => '6' );
    $canvas_frame->pack(side => 'top', fill => 'both', -expand => 'yes');

    ################################################
    ################################################

    # A new frame for more contig info
    my $on_frame = $graphics->Frame();
    $on_frame->pack(side => 'bottom', fill => 'x');

    #########
    # Canvas
    #########
#    $canvas = $canvas_frame->Scrolled('Canvas', -scrollbars => 's');
#    $canvas->pack(-side => 'top', -fill => 'both', -expand => 'yes');
    #$topLevel->bind('<Configure>', sub { $self->resize(); });

    ##########################################################################
#    $canvas = $canvas_frame->Canvas(
#				   #-takefocus => 1,
#				   #-width => '5c',
#				   #-height => '5c',
#				   -relief => 'sunken',
#				   -bd => 2,
#				   #-scrollregion => ['0c', '0c', '50c', '0c']
#				   );
    ##########################################################################

#    my $w_vscroll = $canvas_frame->Scrollbar(-command => [$canvas => 'yview']);
#    my $w_hscroll = $canvas_frame->Scrollbar(-command => [$canvas => 'xview'], -orient => 'horiz');
#    $canvas->configure(-xscrollcommand => [$w_hscroll => 'set'],
#		       -yscrollcommand => [$w_vscroll => 'set']);
#    $w_vscroll->pack(-side => 'right', -fill => 'y');
#    $w_hscroll->pack(-side => 'bottom', -fill => 'x');
#
#    $canvas->pack(-fill => "both", -expand => 'yes' );
#    $canvas->pack();



#    $canvas->configure (-bg => 'white');

###########################################################################
###########################################################################

    
    $info_frame->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		       text => '      Species:')->pack(-side => 'left');
    my $species_label = $info_frame->Entry(
					   -state => 'disabled',
					   -width => 10,
					   -font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
					   -bg => $entrycolour,
					   -textvariable => \$hit->{Clone_info}->{Speciesname},
					   )->pack(side => 'top');
    $species_label->pack(-side => 'left');

    $info_frame->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		       text => ' Chromosome:')->pack(-side => 'left');
    my $chromo_label = $info_frame->Entry(
					       -state => 'disabled',
					       -width => 5,
					       -font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
					       -bg => $entrycolour,
					       -textvariable => \$hit->{Clone_info}->{Chromosome},
					       )->pack(side => 'top');
    $chromo_label->pack(-side => 'left');

    

    ##########################################################################
    $info_frame->Label(font => '*-times-bold-r-normal--*-180-*-*-p-*-*-*',
		       text => ' This Contig:')->pack(-side => 'left');
    my $contig = $info_frame->BrowseEntry(
					 -width => 12,
					 -variable => \$this_contig, 
					 -state => 'readonly'
					 )->pack(-side => 'left');
    # Populate the list
    my $next;
    foreach $next (@$contigs){
	$this_contig = @$contigs[0];
	$contig->insert('end', $next);
    }
    ##########################################################################

    #######################
    # Other contig section
    #######################

    $on_frame->Label(font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
		     text => 'This contig hits other contig:')->pack(-side => 'left');
    my $on_contig = $on_frame->Entry(
				     -state => 'disabled',
				     -width => 12,
				     -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
				     -bg => $entrycolour,
				     -textvariable => \$on,
				     )->pack(side => 'top');
    $on_contig->pack(-side => 'left');

    $on_frame->Label(font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
		     text => 'Left position:')->pack(-side => 'left');
    
    my $on_contig_left = $on_frame->Entry(
					  -state => 'disabled',
					  -width => 12,
					  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
					  -bg => $entrycolour,
					  -textvariable => \$on_left,
					  )->pack(side => 'top');
    $on_contig_left->pack(-side => 'left');

    $on_frame->Label(font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
		     text => 'Right position:')->pack(-side => 'left');
    
    my $on_contig_right = $on_frame->Entry(
					  -state => 'disabled',
					  -width => 12,
					  -font => '*-times-medium-r-normal--*-140-*-*-p-*-*-*',
					  -bg => $entrycolour,
					  -textvariable => \$on_right,
					  )->pack(side => 'top');
    $on_contig_right->pack(-side => 'left');



    ###############
    # Menu options
    ###############

    #######
    # File
    #######
    my$fileMenu1 = $menuBar1->Menubutton(bg => 'grey77', text => 'File', underline => 0);
    $fileMenu1->configure(-menu => $fileMenu1 ->Menu(tearoff => 0));
    $fileMenu1->command(-label => 'Quit', 
			underline => 0,
			command => sub{ 
			    $graphics->destroy();
			});
    $fileMenu1->pack(-side => 'left');
    
    ##### End of menu options #####


    &go_contig($this_contig, $db);

}

sub go_contig {
    my ($contig) = @_;
    
    # Harsh ! We now need to do some thinking

    my $dbh = WrapDBI->connect("$db", {RaiseError => 1});
    #######################
    # Some contig analysis
    #######################

    # How big is this contig >?<
    my $contig_length = contig->calc_length($dbh, $contig);

    #$$contig_length = 9000;


#    warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ \n";
#    warn "length returned from database -> $$contig_length \n";
    my $len = ($$contig_length / 10);
    $len = $len . 'c';
#    warn "converted -> $len \n";
#    warn "@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@ \n";


    my $cHeight = $canvas->height();
    my $cWidth = $canvas->width();

#    warn "cHeight -> $cHeight \n";
#    warn "cWidth -> $cWidth \n";

    $canvas->configure(-scrollregion => [0, 0, $cWidth, $cHeight]);

    # Does this contig lie on another contig ?
    $on = contig->on_contig($dbh, $contig);

    if ($on eq 'N/A'){
	$on_left = 'N/A';
	$on_left = 'N/A';
    } else {
	my $positions = contig->on_positions($dbh, $contig);
	
	$on_left = $positions->[0];
	$on_right = $positions->[1];
    }

    ## ----------------------------------------------------
    ## ----------------------------------------------------

    my %coords;
    $coords{'x1'} = 0;
    $coords{'y1'} = 10;
    #$coords{'x2'} = 2000;
    #$coords{'x2'} = $contig_length;
    $coords{'x2'} = $cWidth;
    $coords{'y2'} = 20;
    my $clone2 = rectangle->new($canvas, \%coords);

    ## ----------------------------------------------------
    ## ----------------------------------------------------

    
    $dbh->disconnect();

}

package Display;

sub new {
    my ($type, $graphics, $contig) = @_;
    my $self = {topLevel => $graphics};
    bless $self, $type;
    $self->makeWindow($mainWindow, $contig);
    $self->draw();
}

sub makeWindow {
    my ($self, $graphics, $contig) = @_;
#    my $buttonBar = $topLevel->Frame(-relief => 'raised', -bd => 2);
#    $buttonBar->pack(-side => 'top', -fill => 'x');
#    $buttonBar->Button(-text => 'Zoom In',
#		       -command => sub { $self->zoom(2); })
#	->pack(-side => 'left');
#    $buttonBar->Button(-text => 'Zoom Out',
#		       -command => sub { $self->zoom(0.5); })
#	->pack(-side => 'left');
#
#    $topLevel->Label(textvariable => \$self->{labelText})
#	->pack(-side => 'bottom', -fill => 'x');

    my $canvas = $topLevel->Scrolled('Canvas', -scrollbars => 's');
    $canvas->pack(-side => 'top', -fill => 'both', -expand => 'yes');
    $topLevel->bind('<Configure>', sub { $self->resize(); });
    $self->{topLevel} = $topLevel;
    $self->{canvas} = $canvas->{SubWidget}->{canvas};
}




1;

