#!/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.                      #
#######################################################################


# $Id: viewer.pm,v 1.8 1999/03/24 12:06:20 dn1 Exp $
# $Log: viewer.pm,v $
# Revision 1.8  1999/03/24 12:06:20  dn1
# *** empty log message ***
#
# Revision 1.7  1999/03/24 12:03:09  dn1
# *** empty log message ***
#
# Revision 1.6  1999/01/06 15:23:47  dn1
# New version uses a text widget
#
# Revision 1.5  1998/09/23  08:29:11  dn1
# *** empty log message ***
#
# Revision 1.4  1998/07/09  13:15:24  dn1
# added an optional code handler on pressing the 'Cancel' button
#
# Revision 1.3  1998/06/29  11:05:50  dn1
# #&main::popup ("INFO", ["Sending output to printer $printer"]);
# warn "INFO -> Sending output to printer $printer \n";
#
#
# Owl now uses viewer.pm too; has a different popup routine...
#
# Revision 1.2  1998/04/02  09:17:33  dn1
# pass @contents by reference now
#
# Revision 1.1  1998/03/31  09:06:25  dn1
# Initial revision
#

# DN1
#########################################################
# Modularise the functionality of;
# sub viewer (finch; file-viewer)
# sub view_subs (finch; database query-result viewer)
# Allow printing
#########################################################
# Supply the module with $printer    <- Printouts
#                        $mainWindow <- Create the Toplevel window from
#                        $title      <- A title
#                        @contents   <- What you want to display
#                        $anycode    <- any code to execute on hitting the 'Close' button (optional)

require Exporter;
use Tk;

@viewer::ISA = qw(Exporter);
@viewer::EXPORT = qw(viewer);

package viewer;

sub viewer {
    my ($printer,$mainWindow,$title,$contents, $anycode) = @_;
    my @contents = @$contents;
    #Create a top-level window
    my $entry_viewer = $mainWindow->Toplevel;
    $entry_viewer->wm('minsize', 800, 460); 
    $entry_viewer->wm('maxsize', 800, 460);
    my $f = $entry_viewer->Frame(-height => 460, -width => 800);
    $f->pack();
    $entry_viewer->idletasks();
    $entry_viewer->packPropagate(0);
    $entry_viewer->idletasks();
    $f->packForget();

    $entry_viewer->configure (-title => "Viewing $title");

    # Make some frames
    my $top_frame = $entry_viewer->Frame()->pack(side => 'top', fill => 'x');
    my $middle_frame = $entry_viewer->Frame(-relief => 'ridge', -borderwidth => '5')->pack(side => 'top', fill => 'x');
    my $bottom_frame = $entry_viewer->Frame()->pack(side => 'top', fill => 'x');

    # Header
    my $header = $top_frame->Label(-text => "$title", -background => 'white');
    $header->pack(side => 'top', fill => 'x');

    my $scroll = $middle_frame->Text(-wrap => 'none',
				     -state => 'normal',
				     -height => 25,
				     -background => 'white');
    my $l_scroll = $middle_frame->Scrollbar(-command => [$scroll => 'yview']);
    $scroll->configure(-yscrollcommand => [$l_scroll => 'set']);
    $l_scroll->pack(-side => 'right', -fill => 'y');
    $scroll->pack(-side => 'left', -expand => 1, -fill => 'both');
    

    #############################################
    #Fill the list with the contents of the file
    #############################################

    my $n;
    foreach $n (@contents){
	$scroll->insert('end', "$n\n");
    }
    #$scroll->insert('end',@contents);

    $scroll->configure(-state => 'disabled');
    
#Create an exit button to leave this window
    my $exitButton = $bottom_frame->Button(-text => 'close',
					   -width => '5',
					   -command => sub { 
					       $entry_viewer->destroy;
					       if ($anycode ne ''){
						   &$anycode;
					       }
					   });

    my $printButton = $bottom_frame->Button(-text => 'print',
					    -width => '5',
					    -command => sub { &printer($printer,$title,@contents); });
					    
    $exitButton->pack(-side => 'left', -expand => 'no', -fill => 'x');
    $printButton->pack(-side => 'left', -expand => 'no', -fill => 'x');
    

} # end of sub viewer

sub printer {
    my ($printer,$title,@contents) = @_;
    open (PRINT, "| lpr -P $printer") || main::popup ("WARN", ["Cannot open filehandle to printer $printer"]);
    print PRINT "$title \n";
    print PRINT "\n";
    foreach $next (@contents){
	print PRINT "$next \n";
    }

    #&main::popup ("INFO", ["Sending output to printer $printer"]);
    warn "INFO -> Sending output to printer $printer \n";

    close PRINT || main::popup ("WARN", ["Something went wrong closing the filehandle to printer $printer"]);
}				# end of sub printer

1;




