#!/usr/bin/perl -w

#    himack14.pl
#    Copyright 2002 Charlie Kim
#
#    This program is free software; you can redistribute it and/or modify
#    it under the terms of the GNU General Public License as published by
#    the Free Software Foundation; either version 2 of the License, or
#    (at your option) any later version.
#
#    This program is distributed in the hope that it will be useful,
#    but WITHOUT ANY WARRANTY; without even the implied warranty of
#    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#    GNU General Public License for more details.
#
#    For a copy of the GNU General Public License, write to the Free Software
#    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA

# This program uses the following modules

# Perl/Tk 800.023  Copyright (c) 1995-1996 Nick Ing-Simmons. 
# http://starbase.neosoft.com/%7Eclaird/comp.lang.perl.tk/ptkFAQ.html

# GD 1.33 Copyright 1995-2000, Lincoln D. Stein
# Perl "Artistic License"

# GDGraph 1.33
# Copyright (c) 1999 Martien Verbruggen. All rights reserved.

# Math-Round 0.03 Copyright © 2002 Geoffrey Rommel.


use strict;
use Tk;
use Tk::ErrorDialog;
use Tk::Label;
use Tk::Button;
use Tk::Checkbutton;
use Tk::Frame;
use Tk::Entry;
use Tk::Radiobutton;
use Tk::Scale;
use Tk::Scrollbar;
use Tk::Text;
use POSIX;
use GD;
use GD::Graph;
use GD::Graph::lines;
use GD::Graph::colour;
use Math::Round;

&main();

sub main {
    my $mw = MainWindow->new(-title=>'HIMACK');
    $mw->Label(-text=>"Histogram Maker by Charlie Kim\n")->pack();
    $mw->Label(-text=>"Copyright 2002 Charlie Kim GNU General Public License\n")->pack();


    my $inputfr = $mw->Frame(-relief=>'groove',
			     -label=>'.pcl or .cdt Input File',
			     -borderwidth=>2,
			     )->pack(-side=>'top',
				     -anchor=>'nw',
				     -fill=>'both',
				     );
    my $singlefile;
    my $single_e = $inputfr->Entry(-state=>'normal',
				   -textvariable=> \$singlefile,
				   -width=>30,
				   )->pack(-side=>'left',
					   -pady=>3,
					   );
    $inputfr->Button(-text=>'Browse',
		     -command=> [ \&selectsinglefile , \$mw, \$single_e  ],
		     -borderwidth=>1,
		     -padx=> 0,
		     -pady=> 0,
		     )->pack(-side=>'left',
			     );
    
    my $binval = 0.1;
    my $binfr = $mw->Frame(#-relief=>'groove',
			   -borderwidth=>2,
			   )->pack(-side=>'top',
				   -fill=>'both',
				   );
    $binfr->Label(-text=>'Bin size',
		  )->pack(-side=>'left',
			  );
    $binfr->Scale(-from=>0.01,
		  -to=>1,
		  -resolution=>0.01,
		  -variable=> \$binval,
		  -width=>10,
		  -length=>200,
		  -borderwidth=>1,
		  -orient=>'horizontal',
		  )->pack(-anchor=>'nw');
    
    $mw->Button(-text=>"Make Histograms",
		-command=> [\&ccackmain,\$singlefile,\$binval,\$mw],
		-state=> 'normal',
		)->pack();
    
    $mw->Button(-text=>"Exit",
		-command=> sub { exit },
		)->pack();
    MainLoop;
}

sub ccackmain {
    my $infileref = shift;
    my $infile = $$infileref;
    my $binref = shift;
    my $bin = $$binref;
    my $mwref = shift;
    my $mw = $$mwref;

    my ($firstdatacol,$keyref,$headerref,$dataref) = &readdata($infileref,$binref);

    my $savetypes = [
		     "{JPG files}     {.jpg}      ",
		     "{All files}     *           ",
		     ];
    my $outfile = $mw->getSaveFile(-title=>'Save Graphical Results As',
				   -filetypes=> $savetypes,
				   );
    unless ($outfile =~ /\.jpg$/i) {
	$outfile .= '.jpg';
    }

    my %data = %{$dataref};
    my $graph = GD::Graph::lines->new(600,300);
    my $xskip = int(1 / $bin);
    $graph->set(
		x_label_skip => $xskip,
		title => $infile,
		);
    my $gd;
    my @colors = GD::Graph::colour::sorted_colour_list;
    my @filteredcolors;
    foreach (@colors) {
	next if /white/i;
	push @filteredcolors, $_;
    }
    $graph->set ( dclrs => \@filteredcolors );

    my @allkeys = sort {$a<=>$b} keys %{$keyref};
    my %newkeys = %{$keyref};

    for (my $c = $allkeys[0]; $c <= $allkeys[$#allkeys]; $c+=$bin) {
	my $key = nearest($bin,$c);
	next if $newkeys{$key};
	$newkeys{$key} = 1;
    }

    my @legend_keys;
    foreach (sort {$a<=>$b} keys %{$headerref}) {
	next if $_ < $firstdatacol;
	my $legendname = $headerref->{$_};
	push @legend_keys, $legendname;
    }
    $graph->set_legend(@legend_keys);
    $graph->set(
		legend_placement => 'RC',
		);
    
    my @datagraph;
    my $ymax = 0;
    foreach (sort {$a<=>$b} keys %{$headerref}) {
	next if $_ < $firstdatacol;

	my %dataset = %{$data{$_}};
	foreach (sort {$a<=>$b} keys %newkeys) {
	    next if $dataset{$_};
	    $dataset{$_} = 0;
	}

	my @datax;
	my @datay;
	foreach (sort {$a<=>$b} keys %dataset) {
	    push @datax, $_;
	    push @datay, $dataset{$_};
	    $ymax = $dataset{$_} if $ymax < $dataset{$_};
	}

	push @datagraph, ([@datax]) if !@datagraph;
	push @datagraph, ([@datay]);
    }

    $ymax += 100 if $ymax % 50 < 50;
    $ymax = nearest(100,$ymax);
    $graph->set(y_max_value => $ymax);
    $gd = $graph->plot(\@datagraph);

    open(GRAPH, ">$outfile") or die $!;
    binmode GRAPH;
    print GRAPH $gd->jpeg(100);

    close GRAPH;

    my $textoutref = &textout(\@legend_keys,\@datagraph);
    my $texttypes = [
		     "{TXT files}     {.txt}      ",
		     "{All files}     *           ",
		     ];
    my $textout = $mw->getSaveFile(-title=>'Save Text Results As',
				   -filetypes=> $texttypes,
				   );
    unless ($textout =~ /\.txt$/i) {
	$textout .= '.txt';
    }
    open(TEXTOUT,">$textout") or die "Couldn't open text output file\n";
    my %text = %{$textoutref};
    foreach (sort {$a<=>$b} keys %text) {
	print TEXTOUT "$text{$_}";
    }
    
    $mw->bell;
    $mw->Dialog(-title=>'Finished',
		-text=>'Processing complete',
		)->Show();
}

sub textout {
    my $nameref = shift;
    my $dataref = shift;
    my %lines;

    my @names = @{$nameref};
    $lines{0} = "\t$names[0]";
    for (my $c = 1; $c <= $#names; $c++) {
	$lines{0} .= "\t$names[$c]";
    }

    my @data = @{$dataref};
    foreach (@data) {
#	print "$_\n";
	my @tempset = @{$_};
	my $line = 1;
	$lines{$line} .= "\t$tempset[0]";
	for (my $c = 1; $c <= $#tempset; $c++) {
	    $line++;
	    $lines{$line} .= "\t$tempset[$c]";
	}
    }

    foreach (sort {$a<=>$b} keys %lines) {
	$lines{$_} .= "\n";
	next if $_ == 0;
	$lines{$_} =~ s/^\t//;
    }

    return(\%lines);

}

sub readdata {
    my $infileref = shift;
    my $infile = $$infileref;
    my $binref = shift;
    my $bin = $$binref;

    open(INFILE,$infile) or die "Can't open infile $infile\n";
    chomp(my $header=<INFILE>);
    my $gweight = 0;
    my $gid = 0;
    $gweight++ if $header =~ /gweight/i;
    $gid++ if $header =~ /gid/i;
    my $firstDataCol = 2 + $gweight + $gid;

    my @headerline = split(/\t/,$header);
    my %headers = ();
    for (my $c = 0; $c <= $#headerline; $c++) {
	$headers{$c} = $headerline[$c];
    }

    my %data = ();
    my %allkeys = ();
    while(<INFILE>) {
	chomp;
	next if /^AID/i;
	next if /^EWEIGHT/i;
	next if !$_;

	my @line = split(/\t/);
	for (my $c = $firstDataCol; $c <= $#line; $c++) {
	    next if $line[$c] eq '';
	    my $val = $line[$c];
	    $val /= $bin;
	    $val += 0.00000001; # required for rounding errors
	    $val = floor($val);
	    $val *= $bin;

	    $allkeys{$val} = 1 unless defined($allkeys{$val});
	    $data{$c}{$val}++;
	}
    }
    close INFILE;
    return ($firstDataCol,\%allkeys,\%headers,\%data);
}



sub selectsinglefile {
    my $mainwindowref = shift;
    my $mainwindow = $$mainwindowref;
    my $entryref = shift;
    my $entry = $$entryref;
    my $opentypes = [
		     "{All files}     *           ",
		     "{PCL files}     {.pcl}      ",
		     "{CDT files}     {.cdt}      ",
		     "{Text files}    {.txt}      ",
		     ];
    my $file = $mainwindow->getOpenFile(-filetypes=>$opentypes);
    if (defined $file and $file ne '') {
	$entry->delete(0, 'end');
	$entry->insert(0, $file);
	$entry->xview('end');
    }
}