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

# Copied out of exptools.pl.
# NOTE: new code should be using Cover.pm instead.

############################################################
############################################################
###  Routines to determine uncovered regions in sequences, contigs
############################################################
############################################################

############################################################
# &dumpcover(@uncovered)
#
# Dumps out a coverage array to STDERR
#
############################################################

sub dumpcover {
    local ($i);
    local (@uncovered) = @_;

    warn $#uncovered+1," uncovered regions\n";
    for ($i = 0; $i <= $#uncovered; $i++) {
	warn "  $uncovered[$i]->[0] $uncovered[$i]->[1]\n";
    }
}


############################################################
# &initcover($from, $to)
#
# Initialised array @uncovered with $from and $to. This is
# normally called with $from=1 and $to=length($seq).
#
############################################################
sub initcover {
    local ( $c1 , $c2 ) = @_;

    @uncovered = ();

    if ($c1 > $c2) { ($c1, $c2) = ($c2, $c1); }

    $uncovered[0] = [$c1, $c2];

}

############################################################
# &cover($from, $to)
#
# Mask out region $from..$to from @uncovered array.
#
############################################################
sub cover {
    local ( $c1 , $c2 ) = @_;
    local($i);

    if ($c1 > $c2) { ($c1, $c2) = ($c2, $c1); }

    for ($i = 0; $i <= $#uncovered; $i++) {
	# Does $c1..$c2 cover $uncovered[$i]->[0]..$uncovered[$i]->[1] ???
	# Consider all 6 actions
	if ($c2 < $uncovered[$i]->[0]) {
	    last;
	} elsif ($c1 <= $uncovered[$i]->[0] && $c2 < $uncovered[$i]->[1]) {
	    $uncovered[$i]->[0] = $c2+1;
	} elsif ($c1 <= $uncovered[$i]->[0]) {
	    splice(@uncovered,$i,1); $i--;
	} elsif ($c2 < $uncovered[$i]->[1]) {
	    splice(@uncovered,$i,0,[$uncovered[$i]->[0],$uncovered[$i]->[1]]);
	    $uncovered[$i]->[1] = $c1-1;
	    $i++;
	    $uncovered[$i]->[0] = $c2+1;
	} elsif ($c1 <= $uncovered[$i]->[1]) {
	    $uncovered[$i]->[1] = $c1-1;
	} else {
	    # no action
	}
    }

}

############################################################
# ($left, $right) = &myDetermineActiveRegion($mode)
#
# This is a rewrite of &determineActiveRegion() using &cover()
#
# Mode:
#     -c  - mask cloning vector (CS)
#     -C  - mask everything but the cloning vector
#     -ql - mask poor quality regions (1..QL)
#     -qr - mask poor quality regions (QR..END)
#     -sl - mask sequencing vector (1..SL)
#     -sr - mask sequencing vector (SR..END)
#     -xl - mask using quality revert Squirrels final clip points
#     -xr - mask using quality revert Squirrels final clip points
#
############################################################

sub myDetermineActiveRegion {
    local($SQ);
    local($SQlen);
    local($CS);
    local($CSfrom);
    local($CSto);
    local($QL);
    local($QR);
    local($exQL);
    local($exQR);
    local($SL);
    local($SR);
    local(@overall);
    local(@uncovered);
    local($switches) = @_;

    # Determine left and right end cuts
    if (! defined($SQ = &getEntry("SQ"))) {
	warn "determineActiveRegion - No sequence\n";
	$SQlen = 4096;
    } else {
	$SQlen = length($SQ);
    }


    # determine active region
    &initcover(1,$SQlen);
    if ($switches =~ /-sl/) { 
	if (defined($SL = &getEntry("SL"))) { &cover(0,$SL); }
    }
    if ($switches =~ /-sr/) { 
	if (defined($SR = &getEntry("SR"))) { &cover($SR,$SQlen+1); }
    }
    if ($switches =~ /-ql/) { 
	if (defined($QL = &getEntry("QL"))) { &cover(0,$QL); }
    }
    if ($switches =~ /-qr/) {
	if (defined($QR = &getEntry("QR"))) { &cover($QR,$SQlen+1); }
    }
    if ($switches =~ /-c/) {
	if ( defined($CS = &getEntry("CS"))) {
	    ($CSfrom,$CSto) = $CS =~ /^(\d+)..(\d+)$/;
	    &cover($CSfrom,$CSto);
	}
    }
    if ($switches =~ /-C/) {
	if ( defined($CS = &getEntry("CS"))) {
	    ($CSfrom,$CSto) = $CS =~ /^(\d+)..(\d+)$/;
	    &cover(0,$CSfrom-1);
	    &cover($CSto+1,$SQlen+1);
	}
    }

    ############################################################
    # Precheck
    if ($switches =~ /-x/) {
	# We should ignore overall clips!
	$overall = 0;
	foreach ( @{$expEntry{"CC"}} ) {
	    if (/Set final clip points for gap/) {
		$overall = 1;
		last;
	    }
	}
    }
    ############################################################

    if ($switches =~ /-xl/) {
	if (defined($exQL = $expEntry{"QL"}[$expNentries{"QL"}-1-$overall])) { &cover(0,$exQL); }
    }
    if ($switches =~ /-xr/) {
	if (defined($exQR = $expEntry{"QR"}[$expNentries{"QR"}-1-$overall])) { &cover($exQR,$SQlen+1); }
    }


    # Return results
    if ($#uncovered >= 0) {
	return ($uncovered[0]->[0],$uncovered[0]->[1]);
    } else {
	return (1,0);
    }
}

1;

############# end of file ###############
# Local Variables:
# mode:perl
# End:
############# end of file ###############

