#!/usr/local/bin/perl 
#######################################################################
# 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.                      #
#######################################################################

package InfoWin;

my $IW;             # (Info window)          
my $ic;             # canvas
my @stuff_drawn;
my $xext = 10;
my $info =1;
my $LB;
my $menuBar;
my $menuBar_Info;
my $Choice; 
my @Show = (0,0,1);
my $tc;
my $menuVis;
my @Table;

###############################################################################################
# Valid window

sub SetInfo{
    $info =1;
}
sub SetKey{
    &ClearWin;
    $info = 0;
}
sub IsValid{
    $IW;
}
sub GetInfoKey{
    $info;
}
###############################################################################################
# ret canvas
sub GetInfoCanv{
    $ic;
}
###############################################################################################
# ids of all drawn stuff
sub GetStuff{
    @stuff_drawn;
}
###############################################################################################
# deletes all drawn stuff
sub ClearWin{

    $ic->delete('all');
}				
##############################################################################################
# add new drawn stuff
sub SetStuff{
    my ($add,%newStuff) = @_;

    if(!$add){&ClearWin;}
  
#    @stuff_drawn = (@stuff_drawn,@newStuff);     
#    @stuff_drawn;
}
##############################################################################################
sub AddStuff{
    my ($stuffID) = @_;

#    push(@stuff_drawn,$stuffID);
 
#    @stuff_drawn;
}
##############################################################################################
# Draws Reads arrow-box type thing
sub InfoFR_box {

my ($canv,$x1,$y1,$x2,$y2,$fwd,$hfr,$bad) = @_; 

my $col;
my $h = int((abs($x1-$x2))/2);	# height
my $yh = int((abs($y2-$y1))/2) + $y1;
my $circ;
my $bid;

if ($x1 < $x2){$h += $x1;$circ = $x1- (int($h/2));}else{$h += $x2;$circ = $x1+ (int($h/2));}
if(!$fwd){$col = 'yellow';}else{$col = 'blue';}

$bid= $canv->create('polygon',$x1,$y1,$h,$y1,$x2,$yh,$h,$y2,$x1,$y2,$x1,$y1,
                  -width=>1,-outline=>'dark green',-fill=> $col);
    

if($bad)			# internally inconsistent....
{
    $canv->create('oval',$x1,$y1-1,$circ,$y2+1,-width=> 1,-outline => 'black',-fill=> 'black'); 
}
$bid;
}
##################################################################################################
# mapping stuff for this window
sub dmapx{
    my ($xin,$xmax,$xmin) = @_;

    my $nx;
    my $s = $xmax - $xmin;	# x co-ord system
    my $val;
    # offset from left = 5 pix
    # max right = 100 pix

    if($s == 0) {$s =1;}  
    if($s > $xext-5)
    {
	$nx = $s / ($xext-5);	
	$val = int($xin / $nx);
    }else{
	$nx = (($xext-5) / $s);
	$val = int($xin * $nx);
    }
    $val += 5;
    $val;
}
###############################################################################################
# self explan.

sub Create_InfoWin{

    if(!$IW)
    {
	$IW = MainWindow->new;	# new window
     if($IW)
     {
#	 $IW->wm("minsize",  250, 250);
	 $IW->wm("maxsize",  50, 50);
	 $menuBar = $IW->Frame;
	 $menuBar->pack(-side => 'top', -fill => 'x');
	 $menuBar_Info = $menuBar->Menubutton(
					      -text      => 'View',
					      -underline => 0,
					      );
	 $menuBar_Info->command(
				-label     => 'Dynamic Info',
				-underline => 0,
				-command   => \&SetInfo,
				);
	 $menuBar_Info->command(
				-label     => 'Key',
				-underline => 0,
				-command   => \&SetKey,
				);
	 $menuBar_Info->command(
				-label     => 'Close',
				-underline => 0,
				-command   => \&killwin,
				);
	 $menuBar_Info->pack(-side => 'left');

	 my $menuBar_LS = $menuBar->Menubutton(
					      -text      => 'List',
					      -underline => 0,
      				      );
	 my $ms = 'Sorting';
        $menuBar_LS->cascade(
				-label     => $ms,
				-underline => 0,
			#	-command   => \&ByDir,
				);

	 my $cm = $menuBar_LS->cget(-menu);
	 my $cc = $cm->Menu;
	 $menuBar_LS->entryconfigure($ms, -menu => $cc);
	 $cc->radiobutton(-label=> 'By Direction',-variable => \$Choice,-value => 0);
	 $cc->radiobutton(-label=> 'By Strand',-variable => \$Choice , -value => 1);
	 $cc->radiobutton(-label=> 'By Template',-variable => \$Choice, -value => 2);
	 $cc->invoke(1);
	 
	 $menuBar_LS->pack(-side => 'left');

	 $IW->title('Crow : Read Information');
	 $IW->iconname('Crow:Info');
	 $ic = $IW->Canvas(
			   -width        => 230,
			   -height       => 100,
			   -relief       => 'sunken',
			   -bd           => 1,
			   );

	 $ic->pack(-side => 'top',-expand => 'no',-fill => 'y');
	 

	 my $scroll = $IW->Scrollbar;
	 $scroll->pack(-side => 'right', -expand => 'no',-fill => 'y');
	 $LB = $IW->Listbox(
			    -yscrollcommand => [$scroll => 'set'],
			    -setgrid => 1,
			    -height  => 5,
			    );
	 $scroll->configure(-command => [$LB => 'yview']);
	 $LB->pack(-side => 'bottom', -expand => 'yes', -fill => 'both');
	
     }
    }
    $IW;
}


##############################################################################################
sub FillList{
    my (@T) = @_;
    my $str = "";
    my $i =0;
    
 

  
    $LB->delete(0,$LB->size);
    undef(@Table);
    @Table = @T;
  
    if($Choice == 0){@Table = sort by_dir @Table;}
    elsif($Choice == 1){@Table = sort by_str @Table;}
    elsif($Choice == 2){@Table = sort by_temp @Table;}

    foreach $line (@Table)
	  {
	      $str ="";
	      $str = $str.$$line[0]." ".$$line[1]." ".$$line[3];
	      if($$line[8] eq "positive") {$str = $str." "."=>";}else
	      { $str = $str." "."<=";}		
	           
	      $LB->insert($i,$str);
	      $i++;	     
	  }

}
sub by_dir{
  
    $$b[8] cmp $$a[8];
}
sub by_str{
    
    $$b[3] cmp $$a[3];
}
sub by_temp{
  
    $$b[1] cmp $$a[1];
}
##############################################################################################
# clean up

sub killwin{
    &ClearWin;
    $IW->destroy;
    undef($ic);
    undef($IW);
}
###############################################################################################
1;



