package Owl_map_blocks2;

use strict;
use vars qw(@ISA @EXPORT);
use Exporter;
@ISA = ('Exporter');
@EXPORT = qw(&map_blocks);



sub map_blocks {

    my ($select_blocks, $datacollector, $max_samples, $plate_size, $ORDER_INDICATOR) = @_;

    # Step 1; to cluster the maps into same PROTOCOL/RUNTYPE batches

    my @clusters;
    if ($ORDER_INDICATOR){
        @clusters = &clusterOrders_by_specfics($select_blocks,$ORDER_INDICATOR);  
    } else {
        @clusters = &clusterOrders($select_blocks);
    }
    my $set;
    my $nummapsused = 0;
    my @maps_used = ();
    my @map_structure = ();
    
    my $COLOUR;
    my $lastblock = 'None';
    my $blockchange = 0;
    
    # We'll use temporary $ID_MAPLATE values for the time being.
    # These can be changed to proper $ID_MAPLATE values from the database
    # When the maps have been selected for submission to the database.
    
    my $ID_MAPPLATE = 0;
    
    # used because ID_MAP for 384 well plates
    # starts at 97
    if ($plate_size == 384){$max_samples = $max_samples+96;}
    
    my $no_plate_needed_flag = 0;
    
    foreach $set (@clusters) { # go through the different block types
#	print ">>SET : @$set<<\n";

	my $it_counter;
	my $it = ($#{$set->[1]} +1); # the number of blocks in this block type

#        print "Number of blocks in the type - $it\n";

	# For each new PROTOCOL/RUNTYPE we need to start a new map
	# get a new MAPPLATE for each clusterset we are looking at...
	
	$ID_MAPPLATE++;
	$nummapsused++;
	push @maps_used, $ID_MAPPLATE;	 
	
	# We now need to add the contents of our blocks to the map
	# If we run out of space on the map we should get a new map
	# How much space should be on the map >?< ($max_samples $plate_size)

	# Are we looking at a 96 or 384 well-plate >?<
	my $ID_MAP;
	if ($plate_size == 96){
	    $ID_MAP = 1;
	}
	if ($plate_size == 384){
	    $ID_MAP = 97;
	}
	
	my $next;
	my $total = $#{$datacollector}; # How many blocks are we looking at
	foreach $next (0 .. $total){    # Go through each block
	    my $test = $datacollector->[$next]->{block};
	    my $hit = 0;
	    my $test2 = $set->[0];
            
            my $CHECK;
            if ($ORDER_INDICATOR){
                $test2=~ /(\w+)\_/;
                $CHECK = $1;
                $test2=~ s/\w+\_//g;
            }

	    if ($test =~ /$test2/){


		# ok, so this block matches the right set but is it
		# on our blocks 'to-do' list >?<
		my $tester;
                if ($ORDER_INDICATOR){
                  foreach $tester (sort @$select_blocks){
                        if (($tester eq $test) && ($tester =~ /^$CHECK/)){
                            $hit = 1;
                        }
                    }  
                } else {
                    foreach $tester (sort @$select_blocks){
                        if ($tester eq $test){
                            $hit = 1;
                        }
                    }
                }
                
		next unless ($hit == 1);
		
		$it_counter++;
		$COLOUR = 'cyan4';
		                            # How many samples in the block
		my $samples_this_block = ($#{$datacollector->[$next]->{contents}} +1);
		my $each;
		my $samples_count = 1;

		foreach $each (0 .. $#{$datacollector->[$next]->{contents}}){
		    my $ID_FREQUEST = $datacollector->[$next]->{contents}->[$each]->[0];
		    my $BLOCKNAME = $datacollector->[$next]->{block};

		    ################################################################## 
		    # TEMPORARY SIMPLE COLOUR-CODING RULE...
		    ##################################################################
		    # If this is a different block to last-time; change the colour
		    # ie. colour will alternate for different blocks
		    my $thisblock = $BLOCKNAME;
		    if ($thisblock ne $lastblock){
			if ($blockchange == 0) {
			    $blockchange++;
			} elsif ($blockchange == 1){
			    $blockchange--;
			}
		    }
		    $lastblock = $thisblock;  
		    if ($blockchange == 0){
			$COLOUR = "cyan4";
		    }
		    if ($blockchange == 1){
			$COLOUR = "cyan3";
		    }
		    
		    # populate a new data-structure which will contain mapping information
		    # ID_MAPPLATE (which plate is the sample on ?)
		    # ID_MAP (the position on the plate ? ; for 96 wells this is 1-96)
		    # ID_FREQUEST (which sample are we talking about ?)
		    
		    my @list = ($ID_MAPPLATE, $ID_MAP, $ID_FREQUEST, $BLOCKNAME, $COLOUR);
  
		    my $hash = {
			"plate_type" => "$set->[0]",
			"contents" => [@list]
			};
		    push @map_structure, $hash;
		    # Do we need a new plate yet >?<
		    
		    if ($ID_MAP >= $max_samples){
			# we need a new plate
			# BUT not if this is the end of a block
			if ($samples_count != $samples_this_block){
			    # This is NOT the end of a block
			    $ID_MAPPLATE++;
			    $nummapsused++;
			    push @maps_used, $ID_MAPPLATE;
			    if ($plate_size == 96) {
				$ID_MAP = 1;
			    } elsif ($plate_size == 384){
				$ID_MAP = 97;
			    }
			    $samples_count++;
			} else {
			    if ($plate_size == 96) {
				$ID_MAP = 1;
			    } elsif ($plate_size == 384){
				$ID_MAP = 97;
			    }
			    
			    # unless this is the last sample in the last block
			    # of a set of blocks...
			    # how many blocks are in the set of blocks >?<
			    unless ($it == $it_counter){
				$ID_MAPPLATE++;
				$nummapsused++;
				push @maps_used, $ID_MAPPLATE;
				$samples_count = 1;
			    }
			    
			    # PROBLEM IS THAT THIS WILL START A NEW PLATE
			    # EVEN IF THIS BLOCK SET IS FINISHED
			    # ...we need to trap this event
			    
			}
			
		    } else {
			#no; go to the next well on the same plate
			$samples_count++;
			
			# This is the only place we increment $ID_MAP
			$ID_MAP++;
			
		    }
		}
	    } else {

	    }
	}
    }

    return(\@map_structure, \@maps_used);
}


sub clusterOrders {
    my ($orders) = @_;

    my $order;
    my %rx;
    my $reaction;
    my @clusters;
    foreach $order (@$orders) {
	$reaction = (split(/__/,$order))[3];

	 if (! defined $rx{$reaction}) {
	     $rx{$reaction} = [ $order ];
	 } else {
	     push(@{$rx{$reaction}}, $order);
	 }
    }


    # Create data structure for return
    foreach $reaction ( keys %rx ) {
	push(@clusters,[$reaction , $rx{$reaction}]);
    }

    return @clusters; 

}


sub clusterOrders_by_specfics {
    my ($orders,$ORDER_INDICATOR) = @_;

    my $order;
    my %rx;
    my $reaction;
    my $projectname;
    my @clusters;
    my $name;

    if ($ORDER_INDICATOR eq 'Projectname'){
        foreach $order (@$orders) {
            ($projectname,$reaction) = (split(/__/,$order))[0,3];
            $name = $projectname.'_'.$reaction;
            if (! defined $rx{$name}) {
                $rx{$name} = [ $order ];
            } else {
                push(@{$rx{$name}}, $order);
            }
        }
    }

    # Create data structure for return
    foreach $name ( keys %rx ) {
	push(@clusters,[$name , $rx{$name}]);
    }

    return @clusters; 

}


1;
