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

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 "" );

#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 "Creating image";
# create a new image

$im = new GD::Image($max_x_size,$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)}
	    #
	    # 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,$startline-100,$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";

$path = `pwd`;
chomp $path;

$im->string(gdSmallFont,2,10,"Sequences analyzed in:",$black);
$im->string(gdMediumBoldFont,2,30,$path,$blue);

#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:
$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);
#
# write image to file:
#
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";}

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
#          );
#  }