#!/usr/local/bin/perl -w
#
# Maureen Liu notes: This version was downloaded from methtools website in 2007
#   and modified by Maureen Liu (Sanger Institute). All modifications are
#   accompanied by 'ML' notes.
#
################################################################################
# Requirements                                                                 #
################################################################################
#
require 5.002;
#require "GUSI.ph"; #MacOS
#
# External References
#
use GD;
use Carp;
use FileHandle;
use File::Path;
use File::Basename;
use Getopt::Std;   #UNIX

use vars qw($opt_d $opt_n $opt_h);
#
################################################################################
# Main program global variables                                                #
################################################################################
#
my $next        = 0;
my $position    = -1;
my $seqname        ;
my @f_circles      ;
my @h_circles      ;
my @files          ;
my $file           ;
my $seq            ;
my $laenge      = 0;
my $max_clones  = 0;
my $i           = 0;
my $f_circle    = 0;
my $h_circle    = 0;
my $fcag_circle = 0;
my $hcag_circle = 0;
my $fctg_circle = 0;
my $hctg_circle = 0;
my $fcta_circle = 0;
my $left_offset    ;
my $startline   = 0;
my $suche    = "-a";
my $base           ;
my $path           ;
my $maxclones   = 0;
#
# ML: laenge = length, suche = search
#
################################################################################
# Grafic output default values                                                 #
################################################################################
#
my $stepdown    =   10;
my $offset_h    =   50;
my $offset_v    =  110;
my $max_x_size  = 1800;

################################################################################
# MAN page                                                                     #
################################################################################
my $MAN = <<MAN;
NAME

     Plot_CpGs_to_png: Program converts methylation patterns from Seq1 files 
     into a png-image

AVAILABILITY

     Requires perl 5.002

DESCRIPTION

     The program serve for the visualization of methylation patterns of 
     individual sequences. 
     It uses a set of red and blue circles to represent 
     methylated CpGs and unmethylated CpGs, respectively.
     Output is a file in png-format ("choosen file".png)

SYNOPSIS

     Plot_CpGs_to_png.pl [-d path] [-n png-file-name] [-h]
     (Replaced by file selector box under MacOS)

OPTIONS

    -d string Path name to seq1-files
    -n string file name of png-image
    -h        Prints this message ('Cancel' 'Cancel' under MacOS)
 
AUTHOR(S)

     Christoph Grunau (cgrunau\@imb-jena.de)

CHANGE LOG

     Nov.   1st, 1998 CG   Initial version
     Sep.  30th, 1999 CG   minor changes
     Apr.  10th, 2000 CG   PNG version for UNIX
     Mar.  23rd, 2007 ML   sort clones by methylation density, adjust img size
     Jul.   2nd, 2008 ML   left align clone names

MAN
################################################################################
# main program                                                                 #
################################################################################
#
# Command line parsing 
#
getopts('d:n:h') || croak($MAN);           #UNIX

#$opt_d = &GetFolder("Choose input folder"); #MacOS
#$opt_n = &PutFile("Choose output image file");#MacOS
#
# Check command line arguments
#
croak($MAN) if ( $opt_h || ! defined($opt_d) || $opt_d eq "" );

# ----------------------------------------------------------------------
# ML: moved the two parts from later in the programme to the beginning
#       define output filename

$path = `pwd`;    
chomp $path;

if (!defined $opt_n)
   {
    ($base = $path) =~ s#.*[/:]##;    #from path name end to last / or :
    }

else {
     $opt_n =~ tr/a-zA-Z0-9_\.\///cd;  #UNIX
     $base  =  $opt_n;
     }

if ($base !~ /\//) {$base =  substr ($base,0,28);}        #UNIX
unless ($base =~ /\.png$/i) {$base = $base.".png";}

# end of ML moved block
# ----------------------------------------------------------------------

# write all .seq1-files into a list
chdir $opt_d            || croak ("Cannot find directory '$opt_d'.");
@files = <*.seq1>;

$maxclones = $#files;
#
# finish program when no files *.seq1 found
#
if ($maxclones <0) {print "Sorry. No files available! Please try option -h.\n"}
else
{
print "Processing files";  

#------------------------------------------------------------------------
# copied here by ML to adjust size of graph
# read first sequence to determine length:
     
     $filelist = $files[0];      #initialize variables
     $seq = "";

     open (SEQUENCE, "<$filelist") || die ("Cannot open file '$filelist'.");
           while (<SEQUENCE>)
	                {
	                $file = $_;
	                chomp $file;
                 unless ($file =~ /^>/){$seq = $seq . $file}
	                }
     close SEQUENCE || die ("Cannot close open file '$filelist'.");

     $laenge = length($seq);
     
# end of ML copied block
#-------------------------------------------------------------------------

print "Creating image";
# create a new image

$im = new GD::Image($laenge+$offset_v*2,$maxclones*$stepdown+150);

# allocate some colors
$white = $im->colorAllocate(255,255,255);
$black = $im->colorAllocate(0,0,0);       
$red   = $im->colorAllocate(255,0,0);      
$blue  = $im->colorAllocate(0,0,255);

# make the background interlaced
$im->interlaced('true');

$| = 1;                          #print immediately


foreach $filelist(@files)
	{
	$seq = "";
	open (SEQUENCE, "<$filelist") || die ("Cannot open file '$filelist'.");  
	print (".");                    #show program is running
	while (<SEQUENCE>)
	    {
	    $file = $_;
	    chomp $file;                #read single line, cut Newline
	    #
	    # recognice ">" of Fasta-name, max.length 15 letters
        if ($file =~ /^>/) {
            $seqname = substr($file, 1, 15);
	    $seqname =~ s/\.\w*//;     # ML: delete ".seq1" etc.	   
	    }
	    #
	    # assemble sequence from the lines
	    #
	unless ($file =~ /^>/){$seq = $seq . $file}
	}
	close SEQUENCE || die ("Cannot close open file '$filelist'.");;
	
	 @f_circles = ();             # set lists back to zero
	 @h_circles = ();
	 
	 while ($seq)
	     {
	     $next = $position + 1;
	     $position = index ($seq,"Cg",$next);
	     if ($position == -1) {last};
	     push (@f_circles, $position);
	     }
	 $position = -1;
	 while ($seq)
	     {
	     $next = $position + 1;
	     $position = index ($seq,"cg",$next);
	     if ($position == -1) {last};
	     push (@h_circles, $position);
	     }

	#
	# find internal "-" and replace by dummy sign "_" 
	#
	$seq =~ s/\w{1}-+\w{1}/_/g;
        #
	# find first occurance of -g etc.
	#	
	if ($seq =~ /-g/) {$suche = "-g"};
	if ($seq =~ /-t/) {$suche = "-t"};
	if ($seq =~ /-c/) {$suche = "-c"};
	if ($seq =~ /-C/) {$suche = "-C"};
	if ($seq =~ /-n/) {$suche = "-n"};
	if ($seq =~ /-a/) {$suche = "-a"};
	$startline = index($seq,$suche);
	$startline = $startline+$offset_v;
	#
	# remove all "-" and "_" and determine sequence length 
	#
	$seq =~ s/-//g;
	$seq =~ s/_//g;
	$laenge = length($seq);
	#
        # write Fasta-name
	#
	$im->string(gdSmallFont,10,$offset_h+$stepdown-5,$seqname,$black);
	#
	# draw line representing the sequence fragment
	#
	$im->line($startline,
		  $offset_h+$stepdown,
		 ($startline+$laenge),
		  $offset_h+$stepdown,
		  $black);
	
	while (@h_circles)
	{
	# draw blue circle for unmethylated CpG
	$h_circle = shift(@h_circles);
        $im->arc($offset_v+$h_circle,$offset_h+$stepdown,5,5,0,360,$blue);
	}
	
	while (@f_circles)
	{
	# draw red circle for methylated CpG
	$f_circle = shift(@f_circles);
        $im->arc($offset_v+$f_circle,$offset_h+$stepdown,5,5,0,360,$red);
	}
	
      $stepdown = $stepdown+10;
  }
print "\n";

$im->string(gdSmallFont,10,10,"Sequences analyzed in:",$black);
# $im->string(gdMediumBoldFont,2,30,$path,$blue);   # ML: not useful for us
$im->string(gdMediumBoldFont,10,30,$base,$blue);     #     use filename instead

#legend:
$im->rectangle(490,5,562,45,$black);
$im->fill(500,35,$white);
$im->string(gdSmallFont,500,10,"5mCpG = o",$red);
$im->string(gdSmallFont,500,30,"  CpG = o",$blue);

#x-axis           copied here by ML to adjust the size of the graph
$abschnitt = int($laenge/50);
for ($z=0; $z<=$abschnitt; $z++)
{
$im->line($offset_v+$z*50,$offset_h+$stepdown+15,$offset_v+$z*50,$offset_h+$stepdown+25,$black);
$im->string(gdSmallFont,$offset_v+$z*50,$offset_h+$stepdown+30,($z*50+1)." bp",$black);
}
$im->line($offset_v,$offset_h+$stepdown+20,$offset_v+$laenge,$offset_h+$stepdown+20,$black);

#x-axis:
#$im->line($offset_v,$offset_h+$stepdown+20,$offset_v+1000,$offset_h+$stepdown+20,$black);
#$im->line($offset_v,$offset_h+$stepdown+15,$offset_v,$offset_h+$stepdown+25,$black);
#$im->line($offset_v+250,$offset_h+$stepdown+15,$offset_v+250,$offset_h+$stepdown+25,$black);
#$im->line($offset_v+500,$offset_h+$stepdown+15,$offset_v+500,$offset_h+$stepdown+25,$black);
#$im->line($offset_v+750,$offset_h+$stepdown+15,$offset_v+750,$offset_h+$stepdown+25,$black);
#$im->line($offset_v+1000,$offset_h+$stepdown+15,$offset_v+1000,$offset_h+$stepdown+25,$black);
#$im->string(gdSmallFont,$offset_v,$offset_h+$stepdown+30,"1 bp",$black);
#$im->string(gdSmallFont,$offset_v+250,$offset_h+$stepdown+30,"251",$black);
#$im->string(gdSmallFont,$offset_v+500,$offset_h+$stepdown+30,"501",$black);
#$im->string(gdSmallFont,$offset_v+750,$offset_h+$stepdown+30,"751",$black);
#$im->string(gdSmallFont,$offset_v+1000,$offset_h+$stepdown+30,"1001",$black);

# $im->string(gdSmallFont,2,$offset_h+$stepdown+50,"Sequence names truncated at 15 letters. Clones in alphabetical order.",$black);   # ML: not suitable for us
$im->string(gdSmallFont,10,$offset_h+$stepdown+50,"Clones ordered according to methylation level.",$black);   # ML modification
#
# write image to file:
#
open (BILD, ">$base") || die ("Cannot open file '$base'.");
binmode STDOUT;      # make sure to write to a binary stream
print BILD $im->png; # Convert the image to png
close BILD || die ("Cannot close open file '$base'.");
print "png-image written into file '$base'.\n";
}
##############################################################################
# SUBROUTINES                                                                #
# part of the Standard File Package Utility for MacPerl 4.1.1                #
#                                                                            #
# 1994.01.05 v4.1.1 Matthias Neeracher <neeri@iis.ee.ethz.ch>                #
#  Minor changes to reflect future plans for standard file support.          #
#                                                                            #
# 1993.10.27 v1.2	wm                                                   #
#	Change the calling syntax to adopt the 4.1.0 release.                #
#                                                                            #
# 1993.10.19 v1.1	wm                                                   #
#	convert for 4.1b6                                                    #
#                                                                            #
# 1993.8.10  V1.0                                                            #
#     Watanabe Maki (Watanabe.Maki@tko.dec.com)                              #
#                                                                            #
##############################################################################
# Name
#    PutFile/GetNewFile
# Syntax
#    $filename = &PutFile($prompt [, $default]);
#    $filename = &GetNewFile($prompt [, $default]);
# Description
#    Query a new file name to user by Standard File Dialog Box.
#    $prompt is a prompt sting on the dialog box.
#    $default is a default file name.
#
#  sub PutFile {
#      local($prompt, $default) = @_;
#      
#      &MacPerl'Choose(
#          &GUSI'AF_FILE,         # domain
#          0,                     # type
#          $prompt,               # prompt
#          "",                    # constraint
#          &GUSI'CHOOSE_NEW + ($default ?
#  &GUSI'CHOOSE_DEFAULT : 0),    
#  		  								 # flag 
#          $default               # default filename
#          );
#  }
######
# Name
#    GetFolder
# Syntax
#    $foldername = &GetFolder($prompt [, $default]);
# Description
# Query a folder name to user by Standard File Dialog Box.
# $default is the default dialog
#
#  sub GetFolder {
#  	local($prompt, $default) = @_;
#  	
#      &MacPerl'Choose(
#          &GUSI'AF_FILE,          # domain
#          0,                      # type
#          $prompt,                # prompt
#          "",                     # constraint
#          &GUSI'CHOOSE_DIR + ($default ?
#  &GUSI'CHOOSE_DEFAULT : 0),
#  		                          # flag
#  		  $default
#          );
#  }
