# -*-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 Tk::ContigMap;
use Carp;
#use strict qw(vars);
#require Tk::Toplevel;
#require Tk::Canvas;
require TagManager;
@Tk::ContigMap::ISA = qw(Tk::Toplevel);

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

sub Populate {

    my ($this, $args) = @_;

    ######################################
    # 
    # Read the args, set defaults
    #
    ######################################

    $this->SUPER::Populate($args);

    $this->{'width'} = delete $args->{'-width'} || 1100;
    $this->{'height'} = delete $args->{'-height'} || 400; ####we can control window here####
    $this->{'maplen'} = delete $args->{'-maplen'} || 0;


    $this->{'scale'}=10;
    $this->{'canvas_start'}=0;
    $this->{'canvas_end'}=$this->{'maplen'};


    ######################################
    #
    # Instantiate tag manager
    #
    ######################################

    $this->{'tagman'} = TagManager->init;    

    ######################################
    #
    # Main frame
    #
    ######################################

    my $w_frame = $this->Frame(-relief => 'flat', -borderwidth => '1');
    $w_frame->pack(qw(-side top -fill both));


    ######################################
    #
    # Tool bar
    #
    ######################################


    my $tool_bar = $w_frame->Frame(-relief => 'raised', -borderwidth => '1');
    $tool_bar->pack(qw(-side top -fill x -padx 2));
    
    $tool_bar->Button(-bitmap => 'error', -command => sub {$this->destroy; undef %$hash_ref; })
    ->pack(-side => 'left', -fill => 'y', -padx => 3, -ipadx => 2);

#$tool_bar->Button(-bitmap => 'error', -command => ['destroy', $this])
#->pack(-side => 'left', -fill => 'y', -padx => 3, -ipadx => 2);

    $tool_bar->Button(-bitmap => 'questhead', -command => sub { &postLegend($this) })
	->pack(-side => 'left', -fill => 'y', -padx => 3, -ipadx => 2);

    $tool_bar->Button(-bitmap => "\@$ENV{'BITMAP_DIR'}/print.xbm", 
		      -command => sub { &printDialogue($this, $canvas) })
	->pack(-side => 'left', -fill => 'y', -padx => 3, -ipadx => 2);


######### My new report/summary bit

    $tool_bar->Button(-bitmap => 'info', 
		      -command => sub { &summary_info_time($this, $canvas) })
	->pack(-side => 'left', -fill => 'y', -padx => 3, -ipadx => 2);
    
    ######################################
    #
    # Hide / Reveal
    #
    ######################################
    ###NB We do not need a Tag hide/reveal section if we can choose tags
    # $this->{'show_menu'} = $tool_bar->Menubutton(-text => 'Tag-Hide/Reveal..', -indicatoron => 0,
    #					  -relief => 'raised', -bd => 2);
    #$this->{'show_menu'}->pack(-side => 'left', -padx => '1c', -ipadx => 2);


    ######################################
    #
    # Mode selectors
    #
    ######################################

    my $mode = 'Browse';

    my $browse = $tool_bar->Radiobutton(-bitmap => "\@$ENV{'BITMAP_DIR'}/left_ptr", 
				       -variable => \$mode, -value => 'Browse',
				       -indicatoron => 0, -selectcolor => 'grey92');
    $browse->pack(-side => 'left', -ipadx => 7, -ipady => 2, -fill => 'y');

    my $scaleup = $tool_bar ->Radiobutton( -text => '+',
					  -variable => \$mode, -value => 'ZoomIn',
					  -indicatoron => 0, -selectcolor => 'grey92');
    $scaleup->pack(-side => 'left', -ipadx => 7, -ipady => 2, -fill => 'y');

    my $scaledown = $tool_bar ->Radiobutton( -text => '-', 
					    -variable => \$mode, -value => 'ZoomOut',
					    -indicatoron => 0, -selectcolor => 'grey92');
    $scaledown->pack(-side => 'left', -ipadx => 7, -ipady => 2,-fill => 'y');



###### 'info' mode does not seem to do anything...hashed it out...######


    #my $info = $tool_bar->Radiobutton(-bitmap => 'info', 
    #  				      -variable => \$mode, -value => 'Info',
    #				      -indicatoron => 0, -selectcolor => 'grey92');
    #$info->pack(-side => 'left', -ipadx => 7, -ipady => 2, -fill => 'y');


    # Mode label indicator:

    $tool_bar->Label(-text => 'Mode:',)
	->pack(-side => 'left', -padx => 5, -ipadx => 2);

    $tool_bar->Label(-textvariable => \$mode, -bg => 'grey92')
	->pack(-side => 'left', -padx => 3, -ipadx => 2);



    ######################################
    #
    # Info bar
    #
    ######################################

    my $info_bar = $w_frame->Frame(-relief => 'raised', -borderwidth => '1');
    $info_bar->pack(qw(-side bottom -fill x -padx 2));

    my $info_label = $info_bar->Label();
    $info_label->pack(-side => 'left', -fill => 'x', -padx => 7, -pady => 2);

    ######################################
    # 
    # Frame the canvas
    #
    ######################################

    my $c_frame = $w_frame->Frame();
    $c_frame->pack(-side => 'top', -fill => 'both', -expand => 'yes');

    ######################################
    # 
    # Specify the canvas
    # 
    ######################################

    $this->{'canvas'} = $c_frame->Canvas( 
 			      -takefocus => 1,
  			      -scrollregion => [$this->{'canvas_start'}, '0', 
  						$this->{'canvas_end'}, $this->{'height'}],
 			      -width        => $this->{'width'},
 			      -height       => $this->{'height'},
 			      -relief       => 'sunken',
 			      -bd => 3,
			      );

    my $c_frame_hscroll = $c_frame->Scrollbar(-orient => 'horiz', -command => ['xview', $this->{'canvas'}]);
    $this->{'canvas'}->configure(-xscrollcommand => ['set', $c_frame_hscroll]);
    $c_frame_hscroll->pack(-side => 'bottom', -fill => 'x');
    
    $this->{'canvas'}->pack(-expand => 'yes', -fill => 'both');

    # Draw rectangle mask
    # 
    my $extents= $this->{'canvas'}->cget('-scrollregion');
    $this->{'canvas'}->create(('rectangle', $$extents[0], $$extents[1], $$extents[2], $$extents[3]),
		    -fill => 'grey85');

    ######################################
    #
    # Button bindings for movement
    #
    ######################################

    $this->{'canvas'}->Tk::bind('<Any-Enter>' => sub {

	if ($mode eq 'ZoomIn') {
	    
	    $this->{'canvas'}->configure(-cursor => 'crosshair');
	    $this->{'canvas'}->update;
    
	    $this->{'canvas'}->Tk::bind('<1>' => sub {$this->zoom(2);});

	}
	elsif ($mode eq 'ZoomOut') {

	    $this->{'canvas'}->configure(-cursor => 'crosshair');
	    $this->{'canvas'}->update;
    
	    $this->{'canvas'}->Tk::bind('<1>' => sub {$this->zoom(0.5);});
	}
    });


    $this->{'canvas'}->Tk::bind('<Any-Motion>' => sub {

	my $e = $this->{'canvas'}->XEvent;
	my $x = $this->{'canvas'}->canvasx($e->x);
	my $y = $this->{'canvas'}->canvasy($e->y);
	my $id = $this->{'canvas'}->find ('overlapping',$x, $y, $x, $y);
    
	if ($id) { # If we passed over an object 

	    if ($this->{'tagman'}->getTagObjectField($id, 'Name')) { # If info available for object
	    
		my $msg='';

		foreach (qw(Name Type Length From To)) {
		    $msg .= "$_: " .  $this->{'tagman'}->getTagObjectField($id, $_) . " ";
		}
	    
		$info_label->configure(-text => $msg);
		    
	    } 

	} else {
	    $info_label->configure(-text => "");
	}
    });



    $this->{'canvas'}->Tk::bind('<Any-Leave>' => sub {

	$this->{'canvas'}->configure(-cursor => 'top_left_arrow');
	$this->{'canvas'}->update();	
	$this->{'canvas'}->Tk::bind('<1>' => sub {});

    });




    $this->Advertise('canvas' => $this->{'canvas'} );
    $this->ConfigSpecs(DEFAULT => [$this->{'canvas'}]);
    $this->Delegates(DEFAULT => $this->{'canvas'});

    

}


################################################
# 
# General display Methods
# 
################################################

# Toggle raising and lowering of tags behind mask
#
# $this->{'tagview'}->{$tag} == 1   # means tag is lowered (hidden)
# $this->{'tagview'}->{$tag} == 0   # means tag is raised (revealed)
#
sub toggleView {

    my ($this, $tag) = @_;
    ($this->{'tagview'}->{$tag}) ? $this->{'canvas'}->raise($tag) : $this->{'canvas'}->lower($tag)
}


#sub addShowItem {

  #  my ($this, $tag, $desc) = @_;

   # if (defined( $this->{'taglist'}->{$tag})) {
	#return;
    #}
    
   # $this->{'show_menu'}->checkbutton(-label => $desc, -indicatoron => 1, 
			#	      -variable => \$this->{'tagview'}->{$tag},
				#      -command => sub { $this->toggleView($tag);});

#    $this->{'taglist'}->{$tag}++

#}




sub zoom {

    my ($this,$zoom_factor) = @_;

    my $e = $this->{'canvas'}->XEvent;
    my $x = $e->x;
    my $y = $e->y;
    
    $this->{'canvas'}->scale('all', $x, $y, $zoom_factor, 1.0);
    my $diff_to_start = $x - $this->{'canvas_start'};
    my $diff_to_end = $this->{'canvas_end'} - $x;		
    $this->{'canvas_start'} = $x - ($zoom_factor * $diff_to_start);
    $this->{'canvas_end'} = $x + ($zoom_factor * $diff_to_end);
    $this->{'canvas'}->configure('-scrollregion' =>
		       [$this->{'canvas_start'}, 0,
			$this->{'canvas_end'}, $this->{'height'}]);

}


sub postLegend {
    
    my ($this)=@_;
 
    ############################################
    # 
    # New toplevel for active key
    # 
    ############################################

    my $key = $this->Toplevel;
    my $label = 'Key to symbols';
    $key->title($label);
    $key->iconname($label);
    

    my $title_frame = $key -> Frame (-relief => 'flat', -borderwidth => '2');
    $title_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');
    &bitmapLabel2($key, "\@$ENV{'BITMAP_DIR'}/key.xbm");
 
    $key->Label( -text => 'Hawk has found and labelled the following;',
		-wraplength => '4i',
		-justify => 'left')
	->pack(-side => 'top', -pady => '1m');
    

    ############################################
    # 
    # Show description next to colour
    # 
    ############################################

    my $legend_frame = $key -> Frame (-relief => 'groove', 
				      -borderwidth => '2');
    $legend_frame->pack (-side => 'top', 
			 -padx => '1m', 
			 -pady => '1m', 
			 -fill => 'x', 
			 -expand => 'yes');

    my $legend_text = $legend_frame->Text(-wrap => 'none', 
					  -state => 'normal', 
					  -width => 60, 
					  -height => 10);
    my $legend_scroll = $legend_frame->Scrollbar(-command => [$legend_text => 'yview']);
    $legend_text->configure(-yscrollcommand => [$legend_scroll => 'set']);
    $legend_scroll->pack(-side => right, -fill => 'y');
    $legend_text->pack(-expand => 'yes', -fill => 'both');
    my $hash_ref = $this->{'tagman'}->getTagTypes;

    my $name;
    my $textLen = 0;
    foreach $name (sort(keys(%$hash_ref))) {
	#warn "****$legend_frame****$$hash_ref{$name}->[0]****$$hash_ref{$name}->[1])**** \n";
	$legend_text->insert('end', "     ", $name, "$$hash_ref{$name}->[1]\n", "text$name");
	my $l = length($$hash_ref{$name}->[1]);
	$textLen = $l if ($textLen < $l);
	$legend_text->tagConfigure($name, -background => $$hash_ref{$name}->[0], 
				  -foreground => 'white', -font => '*times*-r*20*');
	$legend_text->tagConfigure("text$name", 
				  -foreground => 'black', -font => '*times*-r*20*');

    }
    $legend_text->configure(-state => 'disabled', -width => $textLen);

    
##############################################################
#The following should be in the help section really !!to do !!
##############################################################


$key->Label( -text => 'Functions:',-wraplength => '4i',-justify => 'left')->pack(-side => 'top', -pady => '1m');
my $tool_frame = $key -> Frame (-relief => 'groove', -borderwidth => '2');
$tool_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');
&bitmapLabel($tool_frame, "\@$ENV{'BITMAP_DIR'}/left_ptr", 'Browse contigs');
&swatchLabel($tool_frame, 'grey85', 'Zoom In', '+');
&swatchLabel($tool_frame, 'grey85', 'Zoom Out', '-');
&bitmapLabel($tool_frame, 'info', 'Report on project');
&bitmapLabel($tool_frame, 'error', 'Quits display window');    
&bitmapLabel($tool_frame, 'questhead', 'This help');
&bitmapLabel($tool_frame, "\@$ENV{'BITMAP_DIR'}/print.xbm", 'Print output');

    ############################################
    # 
    # Button bar
    # 
    ############################################

    my $but_frame = $key -> Frame (-relief => 'flat', -borderwidth => '2');
    $but_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');
    
    $but_frame->Button(-text => 'Close', 
		       -command =>sub { $key->destroy;})
	->pack(-side => 'left', -padx => '10', -pady => '5');

    
}

sub swatchLabel {

    my($this, $colour, $text1, $text2)=@_;

    my $frame = $this -> Frame ();
    $frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    my $label = $frame->Label( -text => $text1 )
	->pack(-side => 'left', -expand => 'yes', -anchor => 'w');

    my $swatch= $frame->Label(-text => $text2, -bg => $colour)
	->pack(-side => 'right', -expand => 'yes', -anchor => 'e');

}

sub bitmapLabel {

    my($this, $bitmap, $label_text)=@_;

    my $frame = $this -> Frame ();
    $frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    my $label = $frame->Label( -text => $label_text )
	->pack(-side => 'left', -expand => 'yes', -anchor => 'w');

    my $swatch= $frame->Label(-bitmap => $bitmap)
	->pack(-side => 'right', -expand => 'yes', -anchor => 'e');

}

sub bitmapLabel2 {

    my($this, $bitmap, $label_text)=@_;

    my $frame = $this -> Frame ();
    $frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    my $label = $frame->Label( -text => $label_text )
	->pack(-side => 'right', -expand => 'yes', -anchor => 'w');

    my $swatch= $frame->Label(-bitmap => $bitmap)
	->pack(-side => 'left', -expand => 'yes', -anchor => 'e');
}

sub formLabelEntry {

    my($this, $label_text, $var_ref)=@_;

    my $frame = $this -> Frame ();
    $frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    my $label= $frame->Label( -text => $label_text );
    my $entry= $frame->Entry(-textvariable => $var_ref, -width => '25');

    $entry->pack(-side => 'right', -expand => 'yes', -anchor => 'e');
    $label->pack(-side => 'left', -expand => 'yes', -anchor => 'e');

    $entry->bind('<Delete>', Backspace);

    return $entry;

}


sub printDialogue {

    my ($this, $canvas)=@_;

    ############################################
    # 
    # New toplevel
    # 
    ############################################

    my $ps = $this->Toplevel;

    my $label = 'Print graphic';
    $ps->title($label);
    $ps->iconname($label);


    ############################################
    # 
    # Ask which printer
    # 
    ############################################

    my $lp_frame = $ps->Frame(-relief => 'flat', -borderwidth => '2');
    $lp_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');
    
    my $lp = 'lpr -Pclp';

    &formLabelEntry($lp_frame, 'Print command:', \$lp);


    ############################################
    # 
    # Colour or Greyscale
    # 
    ############################################


    my $c_frame = $ps->Frame (-relief => 'flat', -borderwidth => '2');
    $c_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    my $colour='color';
    $c_frame->Radiobutton(-text => 'Colour', -variable => \$colour, -value => 'color')
	->pack(qw(-side left));

    $c_frame->Radiobutton(-text => 'Greyscale', -variable => \$colour, -value => 'gray')
	->pack(qw(-side left));



    ############################################
    # 
    # Button bar
    # 
    ############################################


    my $but_frame = $ps->Frame (-relief => 'flat', -borderwidth => '2');
    $but_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    
    $but_frame->Button(-text => 'Print', -state => 'disabled', 
		       -command =>sub {

			   $ps->destroy;
			   my $psfile = "/tmp/_hawk$$";
			   &makePs($psfile, $canvas, $colour);
			   `$lp $psfile`;
			   unlink($psfile);
		       })
	->pack(-side => 'left', -padx => '10', -pady => '5');


    $but_frame->Button(-text => 'Cancel', 
		       -command =>sub {$ps->destroy;})
	->pack(-side => 'left', -padx => '10', -pady => '5');



}


sub makePs {

    my ($psfile, $c, $colour) =@_;
    
    $c->postscript(-file => $psfile,
		   -pagewidth => '8i',
		   -pageheight => '13i',
		   -colormode => $colour,
		   -rotate => 1);
}

################################################
# 
# settings Methods
# 
################################################

sub setScale {

    my ($this, $scale) = @_;
    $this->{'scale'}  = $scale;
    
}


sub scaleDownCoord {

    my ($this, $val) = @_;
    return ($val / $this->{'scale'});

}


sub scaleUpCoord {

    my ($this, $val) = @_;
    return ($val * $this->{'scale'});

}



################################################
# 
# draw Methods
# 
################################################

sub ruler {
    
    my $this=shift;
    my %args = @_;

    my $x = $args{'-x'};
    my $y = $args{'-y'};
    my $h = $args{'-height'} || 20;
    my $tick = $args{'-tick'} || 100;
    my $len = $args{'-length'} || 1000;

#    my $font = '-*-times*-r*20*';

    my $intv = ($tick/4);
    my $x_o = $x;

    for(;$x < $len; $x+=$tick) {

	$this->{'canvas'}->create('text', $x, $y-$h-10, -text => ($x-$x_o)*$this->{'scale'});#, -font => $font); 

	$this->{'canvas'}->create('line', $x, $y, $x+$tick, $y);
	$this->{'canvas'}->create('line', $x, $y, $x, $y-$h);
	$this->{'canvas'}->create('line', $x+$intv, $y, $x+$intv, $y-($h/3));
	$this->{'canvas'}->create('line', $x+(2*$intv), $y, $x+(2*$intv), $y-(($h/3)*2));
	$this->{'canvas'}->create('line', $x+(3*$intv), $y, $x+(3*$intv), $y-($h/3));

    }

    $this->{'canvas'}->create('line', $x, $y, $x, $y-$h);
    $this->{'canvas'}->create('text', $x, $y-$h-10, -text => ($x-$x_o)*$this->{'scale'});#, -font => $font);

}


sub drawContig {

    my $this = shift;
    my %args = @_;

    my $x = $args{'-x'};
    my $y = $args{'-y'};
    my $h = $args{'-height'} || 20;
    my $colour = $args{'-colour'} || 'white';
    my $desc = $args{'-desc'};
    my $len = $args{'-length'} || 1000;
    my $name = $args{'-name'};


    my $from = $x;
    my $to = $len + $x;

    $x =$this->scaleDownCoord($x);
#    my $y =$this->scaleDownCoord($y);
    $len =$this->scaleDownCoord($len);    
#    my $h =$this->scaleDownCoord($h);    


    my $id =
	$this->{'canvas'}->create('rectangle',
			$x,
			$y,
			($len+$x),
			($h+$y), 
			-fill => $colour,
			-tags => $name);
    
    	
    $this->{'tagman'}->defineTagObject($id, {Type=>'contig',
				   Name=>$name, 
				   Colour=> $colour,
				   From=>$from, 
				   To=>$to, 
				   'Length'=>abs($from-$to)+1});

}



sub drawQuality {

    my $this=shift;
    my %args = @_;

    my $xoffset = $args{'-x'};
    my $yoffset = $args{'-y'};
    my $threshold = $args{'-threshold'} || 30;

    my $desc = $args{'-desc'};
    my $name = $args{'-name'};

    my $list_ref = $args{'-coords'};

    my ($i, $lx, $ly);
    for($i=0; $i<=$#{$list_ref}; $i++) {
 
 	my $x = $this->scaleDownCoord($xoffset + $i);
	my $y = 200 - $$list_ref[$i];

	$this->{'canvas'}->create('line',$lx,$ly,$x,$y,
			-smooth => 'on',
			-width => 1,
			-fill => 'black') 
            
            if $lx && $ly;
 
        $lx = $x; $ly = $y;

    }
}


sub drawRegion {

    my $this=shift;
    my %args = @_;

    my $x = $args{'-x'};
    my $y = $args{'-y'};
    my $h = $args{'-height'} || 5;
    my $colour = $args{'-colour'} || 'black';
    my $style = $args{'-style'} || 'line';
    my $name = $args{'-name'};
    my $desc = $args{'-desc'};
    my $coord_ref = $args{'-coords'};


    # State object is visible
    # 
    $this->{'tagview'}->{$name} = 1;
    #$this->addShowItem($name, $desc);
    

    my $i;
    for ($i = 0; $i <= $#{$coord_ref}; $i++) { 

	my ($from, $to) = ($$coord_ref[$i]->[0], $$coord_ref[$i]->[1]);

	my $d_from =$this->scaleDownCoord($from);
	my $d_to =$this->scaleDownCoord($to+1);	  
	my $x =$this->scaleDownCoord($x);

	my $id;
	if ($style eq 'rectangle') {

	    $id =
		$this->{'canvas'}->create('rectangle', $x+$d_from, $y, $x+$d_to, $y+$h,
				-fill => $colour,
				-width => 0.5,
				-tags => $name);

	} else { # $style eq 'line'

	    $id =
		$this->{'canvas'}->create('line', $x+$d_from, $y, $x+$d_to, $y, 
				-fill => $colour,
				-width => $h,
				-tags => $name);
	}

	$this->{'tagman'}->defineTagObject($id, {Type=>'region', 
				       Name=>$name, 
				       Colour=> $colour,
				       From=>$from, 
				       To=>$to,
				       'Length'=>abs($from-$to)+1});

	$this->{'tagman'}->addTypeList(Name=>$name, 
			     Colour=> $colour,
			     Description => $desc);
	
    }   
}

##################################################################
# New Reporting feature
##################################################################

sub summary_info_time {

        my ($this)=@_;

    my $key = $this->Toplevel;

    my $label = 'Report';
    $key->title($label);
    $key->iconname($label);
   
   
    my $title_frame = $key -> Frame (-relief => 'flat', -borderwidth => '2');
    $title_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');
        
    $title_frame->Label (-text => 'Report for project.', -font => '*times*-r*25*')
	->pack(-side => 'left', -ipadx => '10');

    $key->Label( -text => 'Please contact bug if there is anything you would like to see here.',
		-wraplength => '4i',
		-justify => 'left')
	->pack(-side => 'top', -pady => '1m');

    my $legend_frame = $key -> Frame (-relief => 'groove', -borderwidth => '2');
    $legend_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');

    &bitmapLabel($legend_frame, "\@$ENV{'BITMAP_DIR'}/construc.xbm");
	    
    ############################################
    # 
    # Button bar
    # 
    ############################################

    my $but_frame = $key -> Frame (-relief => 'flat', -borderwidth => '2');
    $but_frame->pack (-side => 'top', -padx => '1m', -pady => '1m', -fill => 'x', -expand => 'yes');
    
    $but_frame->Button(-text => 'Close', 
		       -command =>sub {$key->destroy;})
	->pack(-side => 'left', -padx => '10', -pady => '5');


}

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


1;
