#!/usr/local/bin/perl
#
################################################################################
# Requirements                                                                 #
################################################################################
#
require 5.002;
#require "GUSI.ph"; #MacOS
#
# External References
#
use Carp;
use FileHandle;
use File::Path;
use File::Basename;
use Getopt::Std;   #UNIX

use vars qw($opt_d $opt_n $opt_s $opt_h);
#
################################################################################
# Main program global variables                                                #
################################################################################
#
my $next        = 0 ;
my $position    = -1;
my $seqname     = "";
my @h_circles   = ();
my @h_circles1  = ();
my @f_circles   = ();
my @f_circles1  = ();
my $file        = "";
my $seq         = "";
my $laenge      = 0;
my $max_clones  = 0;
my $i           = 0;
my $f_circle    = 0;
my $h_circle    = 0;
my $left_offset = 0;
my $startline   = 0;
my $suche    = "-a";
my $base        = "";
my $path        = "";
my $maxclones   = 0;
my $ticknumber  = 0;
my $ps_string   = "";
my $now_string  = localtime;

$| = 1;                          #print immediately

#
################################################################################
# Grafic output default values                                                 #
################################################################################
#
my $stepdown      =   10;
my $offset_h      =   50;
my $offset_v      =  110;
my $max_x_size    =  842; #x size of the page in points (default for A4 landscape)
my $ps_leftmargin =   20; #left margin of output in points
my $ps_hight      =  595; #y size of the page in points (default for A4 landscape)
                          #if the value is decreased the graphics starts lower on the page
my $ps_topmargin  =   40;
my $ps_x_scale    =     1; #output scale
my $ps_y_scale    =     1;
my $axis_length   =  500; #default length of the x-axis in points
my $tick_dist     =   50; #distance between the labels of the x-axis

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

     Plot_CpGs_to_PS: Program converts methylation patterns from Seq1 files 
     into a postscript-image

AVAILABILITY

     Requires perl 5.002

DESCRIPTION

     The program serves for the visualization of methylation patterns of 
     individual sequences. The sequence files are expected to be in seq1-format
     (5mC = capital "C" all other bases lower case). All files in one directory.
     It uses a set of full and hollow circles to represent methylated and  
     unmethylated CpGs, respectively. A scale has to be choosen in accordance
     to the length of the analyzed region and the number of clones (e.g. 0.5 for
     about 1200 bp and 50 clones)
     Output is a file in postscript-format ("file name".ps).

SYNOPSIS

     Plot_CpGs_to_PS.pl [-d path] [-n ps-file-name] [-s scale] [-h]
     (Replaced by file selector box and input prompt under MacOS)

OPTIONS

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

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

CHANGE LOG

     Oct.  5th, 1999 CG   initial version

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

#$opt_d = &GetFolder("Choose input folder");        #MacOS
#$opt_n = &PutFile("Choose output postscript file");#MacOS
#print "Scale of postscript file (default 1):";     #MacOS
#$opt_s = <STDIN>;                                  #MacOS
#chomp $opt_s;                                      #MacOS
if (!defined ($opt_s) || $opt_s eq "" || $opt_s !~ /(\d*\.*\d+)/) {$opt_s = 1;}
$ps_x_scale = $opt_s;
$ps_y_scale = $opt_s;
print "x-scale = $ps_x_scale, y-scale = $ps_y_scale\n";
#
# 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 <1) {print "Sorry. No files available!\n\n$MAN";}
else
{

#
# Generate postscript output:
#
print "Creating PS image";

$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 =~ /\.ps$/i) {$base = $base.".ps";}

open (BILD, ">$base") || die ("Cannot open file '$base'.");
print BILD "%!PS-Adobe-2.0\n";
print BILD "%%Creator: Plot_CpGs_to_PS.pl (MethTools)\n";
print BILD "%%Title: Output for $opt_n , $now_string\n";
print BILD "%%Orientation: Landscape \n";
print BILD "%%DocumentMedia: Default $max_x_size $ps_hight 0 () ()\n";
print BILD "%%ViewingOrientation: 0 -1 1 0 \n";
print BILD "%%Pages: 1 \n";
print BILD "%%EndComments \n";
print BILD "%%Page: 1 \n";
print BILD "gsave\n";
print BILD "\n%global starting points and scale of the graphics--------------\n";
print BILD "$ps_leftmargin $ps_topmargin translate\n";
print BILD "$ps_x_scale $ps_y_scale scale\n";
print BILD "90 rotate\n";
print BILD "\n%header--------------------------------------------------------\n";
print BILD "/Times-Roman findfont\n";
print BILD "12 scalefont\n";
print BILD "setfont\n";
print BILD "newpath\n";
print BILD "5 -40 moveto\n";
print BILD "(Files analyzed in:) show\n";
print BILD "/Times-Roman findfont\n";
print BILD "16 scalefont\n";
print BILD "setfont\n";
print BILD "newpath\n";
print BILD "100 -40 moveto\n";
print BILD "($opt_d) show\n";

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);
	     push (@f_circles1, $position);
	     }
	 $position = -1;
	 while ($seq)
	     {
	     $next = $position + 1;
	     $position = index ($seq,"cg",$next);
	     if ($position == -1) {last};
	     push (@h_circles, $position);
	     push (@h_circles1, $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);
 print BILD "\n%graphics for $seqname------------------------------\n";
	#
 # write Fasta-name
	#
 print BILD "/Helvetica-Oblique findfont   % Get the basic font\n";
 print BILD "10 scalefont                  % Scale the font to points\n";
 print BILD "setfont                       % Make it the current font\n";
 print BILD "newpath                       % Start a new path\n";
 $ps_x = $startline - 80;
 $ps_y = $offset_h+$stepdown+2;
 print BILD  "$ps_x -$ps_y moveto % Lower left corner of text\n";
 print BILD "($seqname) show\n";
	#
	# draw line representing the sequence fragment
	#
 print BILD "newpath         % draw a line\n";
 print BILD "0 setgray       % 100% black\n";
 print BILD "1 setlinewidth  % 1 point thick line\n";
 $ps_x = $startline;
 $ps_y = $offset_h+$stepdown;
 print BILD "$ps_x -$ps_y moveto\n";
 $ps_x = $startline+$laenge;
 $ps_y = $offset_h+$stepdown;
 print BILD "$ps_x -$ps_y lineto\n"; 
 print BILD "closepath\n"; 
 print BILD "stroke\n";
 #
 # draw circles for unmethylated CpG
 #		
	print BILD "newpath         % draw a series of circles\n";
 print BILD "0 setgray\n";
 print BILD "2 setlinewidth\n";
 while (@h_circles)
	      {
	      $h_circle = shift(@h_circles);
       $ps_x = $offset_v+$h_circle;
       $ps_y = $offset_h+$stepdown;
       print BILD "$ps_x -$ps_y moveto\n";
       print BILD "$ps_x -$ps_y 2 0 360 arc\n";
	      }
	print BILD "closepath\n";
	print BILD "stroke\n";
 #
 # fill circles for unmethylated CpG with white
 #		
	print BILD "newpath         % fill the circles with white\n";
 print BILD "1 setgray\n";
 print BILD "1 setlinewidth\n";
 while (@h_circles1)
	      {
	      $h_circle = shift(@h_circles1);
       $ps_x = $offset_v+$h_circle;
       $ps_y = $offset_h+$stepdown;
       print BILD "$ps_x -$ps_y moveto\n";
       print BILD "$ps_x -$ps_y 2 0 360 arc\n";
	      }
	print BILD "closepath\n";
	print BILD "fill\n";

	#
 # draw circles for methylated CpG
 #		
	print BILD "newpath         % draw a series of circles\n";
 print BILD "0 setgray\n";
 print BILD "2 setlinewidth\n";
 while (@f_circles)
	      {
	      $f_circle = shift(@f_circles);
       $ps_x = $offset_v+$f_circle;
       $ps_y = $offset_h+$stepdown;
       print BILD "$ps_x -$ps_y moveto\n";
       print BILD "$ps_x -$ps_y 2 0 360 arc\n";
       print BILD "$ps_x -$ps_y moveto\n";
       print BILD "$ps_x -$ps_y 2 0 360 arc\n";
	      }
	print BILD "closepath\n";
	print BILD "stroke\n";
 #
 # fill circles for methylated CpG with black
 #		
	print BILD "newpath         % fill the circles with black\n";
 print BILD "0 setgray       % set color to 100% black\n";
 print BILD "1 setlinewidth\n";
 while (@f_circles1)
	      {
	      $f_circle = shift(@f_circles1);
       $ps_x = $offset_v+$f_circle;
       $ps_y = $offset_h+$stepdown;
       print BILD "$ps_x -$ps_y moveto\n";
       print BILD "$ps_x -$ps_y 2 0 360 arc\n";
       print BILD "$ps_x -$ps_y moveto\n";
       print BILD "$ps_x -$ps_y 2 0 360 arc\n";
	      }
	print BILD "closepath\n";
	print BILD "fill\n";
	
 $stepdown = $stepdown+12;
}
print "\n";

#x-axis:
print BILD "\n%x-axis of the figure-----------------------------------\n";
$ps_x = $offset_v;
$ps_y = $offset_h+$stepdown+20;
print BILD "newpath        % draw line as x-axis\n";
print BILD "1 setlinewidth\n";
print BILD "0 setgray\n";
print BILD " $ps_x -$ps_y  moveto\n";
$ps_x = $offset_v + $axis_length;
print BILD " $ps_x  -$ps_y  lineto\n";
print BILD "closepath\n";
print BILD "stroke\n";

print BILD "newpath        % draw marks\n";
$ticknumber = abs($axis_length/$tick_dist);
for ($i = 0; $i < $ticknumber+1; ++$i)
    {
    $ps_x = $offset_v + $i * $tick_dist;
    $ps_y = $offset_h+$stepdown+15;
    print BILD " $ps_x -$ps_y  moveto\n";
    $ps_y = $offset_h+$stepdown+25;
    print BILD " $ps_x  -$ps_y  lineto\n";
    }
print BILD "closepath\n";
print BILD "stroke\n";

print BILD "/Times-Roman findfont %label marks\n";
print BILD "12 scalefont\n";
print BILD "setfont\n";

$ticknumber = abs($axis_length/$tick_dist);
for ($i = 0; $i < $ticknumber+1; ++$i)
    {
    $ps_string = $i * $tick_dist + 1;
    $ps_x = $offset_v + $i * $tick_dist - 2;
    $ps_y = $offset_h+$stepdown+35;
    print BILD "newpath\n";
   
    print BILD " $ps_x -$ps_y  moveto\n";
    print BILD "($ps_string) show\n";
    }
print BILD "closepath\n";

# legend:
print BILD "\n%legend of the figure------------------------------------\n";
$ps_string = "Sequence names truncated at 15 letters. Clones in alphabetical order. X-axis in base pairs.";
$ps_x = 0;
$ps_y = $offset_h+$stepdown+60;
print BILD "newpath\n";
print BILD " $ps_x -$ps_y  moveto\n";
print BILD "($ps_string) show\n";

$ps_string = "5mCpG:       CpG:";
$ps_x = 500;
$ps_y = $offset_h+$stepdown+60;
print BILD "newpath\n";
print BILD " $ps_x -$ps_y  moveto\n";
print BILD "($ps_string) show\n";

print BILD "newpath         % draw 2 circles\n";
print BILD "0 setgray\n";
print BILD "2 setlinewidth\n";
$ps_x = 548;
$ps_y = $ps_y - 4;
print BILD "$ps_x  -$ps_y  moveto\n";
print BILD "$ps_x  -$ps_y  2  0 360 arc\n";
$ps_x = 595;
print BILD "$ps_x  -$ps_y  moveto\n";
print BILD "$ps_x  -$ps_y  2  0 360 arc\n";
print BILD "closepath\n";
print BILD "stroke\n";
print BILD "newpath        % fill one circle with white\n";
print BILD "1 setgray\n";
$ps_x = 595;
print BILD "$ps_x  -$ps_y  moveto\n";
print BILD "$ps_x  -$ps_y  2  0 360 arc\n";
print BILD "closepath\n";
print BILD "fill\n";
print BILD "newpath        % fill one circle with black\n";
print BILD "0 setgray\n";
$ps_x = 548;
print BILD "$ps_x  -$ps_y  moveto\n";
print BILD "$ps_x  -$ps_y  2  0 360 arc\n";
print BILD "closepath\n";
print BILD "fill\n";
#
# write image to file:
#
print BILD "showpage\n";
print BILD "grestore\n";
print BILD "%%Trailer\n%%EOF";
close BILD || die ("Cannot close open file '$base'.");
print "PS-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
#          );
#  }