#!/usr/bin/perl

#rigged BINGO name, part 2 (known sequence of call numbers, random distribution of cards)
#all winning cards are double bingos; one unspoiled point at diagonal
#all losing cards hit 20 numbers; spoiled (noncalled) numbers at either (randomly chosen) diagonal ensure nonwinnner, but exciting

use strict;
use warnings;

my $losers = 120;
my $prizes = 8;
#my $losers = 6;
#my $prizes = 0;

#this script corrupts original @callseq
my( @callseq, @winstring, @noncallseq); #auxillary lists to build ###NO LONGER NEED WINSTRING 3.0
my( @wincard, @losecard); #lists of strings, strings are info for cards
my( %serialNumber );

####################################################MAIN EXECUTION 2
 
&doInit;
&mkCards;

my @allcards = (@losecard,@wincard);

print '\documentclass[portrait]{seminar}
\slidesmag{6}
\slideframe{none}
\usepackage{graphicx}
\usepackage{times}
\begin{document}
\begin{center}
';

my $count;
for (@allcards){    
    if (m,([01]{10})\n((?:(?:\w\-\d+[\s\n]){5}){5}),)
    {
	my $code = $1;
	my $card = $2;
	$card =~ s,((?:\w\-\d+\s){5}),$1\n,g;
	$card =~ s,\w\-(\d+),$1,g;
	$card =~ s, , \& ,g;
	$card =~ s,\&\s*?\n,\\\\\n\\hline\n,g;

	print '\begin{tabular}[]{| c | c | c | c | c |}';
	print "\n";
	print '\multicolumn{5}{c}{{\large B}IOCHEMISTRY {\large R}ETREAT {\large 2005}} \\\\';
	print "\n";
	print '{\huge \bf B} & {\huge  \bf I } & {\huge  \bf N } & {\huge \bf G } & {\huge  \bf O! } \\\\[-1.5pt] \hline';
	print "\n";

	print "$card";
	print '\multicolumn{5}{c}{{\tiny '."$code"."}}\n\n";
	print '\end{tabular}'."\n%%%%%\n";
}}

print '\end{center}
\end{document}';


####################################################FUNCTIONS

sub mkCards{
    #needs global @winstring
    #print losing cards;
    ##################################################################################
    for my $k (1..$losers)
    {
	my $linestring;
	my $count = 0;
       	my %seen;	
	local *getNewDrawBall = sub { #workaround for scoping inner subroutine with typeglob - ugly Perlism
 	    my $type = shift;
	    my $temp2;
	    while (1){
		$temp2 = &getDrawBall($type);
		if (exists $seen{$temp2})
		{
		    next;
		}else{ $seen{$temp2}++;return $temp2;} #print "DEBUGdraw: $temp\n";
	    }
	};
	local *getNewNonDrawBall = sub { #workaround for scoping inner subroutine with typeglob - ugly Perlism
	    my $type = shift;
	    my $temp2;
	    while (1){
		$temp2 = &getNonDrawBall($type);
		if (exists $seen{$temp2})
		{
		    next;
		}else{ $seen{$temp2}++;return $temp2;} #print "DEBUG_no_draw: $temp\n";
	    }
	};	

	#SPOIL CARD HERE
	my @spoil = &getSpoilScheme();           ### @SPOIL DECLARED HERE ###
	my $scheme;
	if ($spoil[0] == 0){$scheme= '01'}else{$scheme = '10'};
	
        ############serial number
	local *coinFlip = sub {
	    my $z = &getRand;
	    my $coin = int($z)% 2;
	    return $coin;
	};	
	local *buildSN = sub {
	    my @sn;
	    for (1..4){
		local $_ = &coinFlip; 
		push( @sn, $_);
	    };
	    push( @sn, "$scheme");
	    for (1..4){
		local $_ = &coinFlip; 
		push( @sn, $_);
	    };
	    my $temp = "@sn";
	    $temp =~ s,\s+,,g;
#		
	    $temp;};	 
    my $sn;my $thing =1;
    while ($thing == 1){
	$sn = &buildSN;
	unless (exists $serialNumber{$sn}){
	    $thing=0}};	
    my $spoilflag = 'nospoil';

    #actually write card
    for my $num (1..25)
    {
       	    my( $mod, $temp);
	    $mod = $num % 5;

	    if (($num) == ($spoil[0] + 1))  ##SET SPOILFLAG
	    {
		shift @spoil unless (@spoil == 1);
		$spoilflag = 'spoil';
	    }else{
		$spoilflag = 'nospoil';
	    };
#	    print "DEBUG.spoil: k $k num $num flag $spoilflag spoil @spoil \n";    
	    if ($spoilflag eq 'nospoil')  ##REACT TO SPOILFLAG
	    {

		if( $mod == 1){$temp = &getNewDrawBall('B');$seen{$temp}++;}
		elsif( $mod == 2){$temp = &getNewDrawBall('I');$seen{$temp}++;}
		elsif( $mod == 3){$temp = &getNewDrawBall('N');$seen{$temp}++;}
		elsif( $mod == 4){$temp = &getNewDrawBall('G');$seen{$temp}++;}
		elsif( $mod == 0){$temp = &getNewDrawBall('O');$seen{$temp}++;};
	    }elsif($spoilflag eq 'spoil')
	    {
		if( $mod == 1){$temp = &getNewNonDrawBall('B');$seen{$temp}++;}
		elsif( $mod == 2){$temp = &getNewNonDrawBall('I');$seen{$temp}++;}
		elsif( $mod == 3){$temp = &getNewNonDrawBall('N');$seen{$temp}++;}
		elsif( $mod == 4){$temp = &getNewNonDrawBall('G');$seen{$temp}++;}
		elsif( $mod == 0){$temp = &getNewNonDrawBall('O');$seen{$temp}++;};
	    }else{die "THIS SHOULDN'T HAPPEN\n";};

	    $linestring .= "$temp ";
	    $count++;
#	    print "DEBUG: k $k n $num m $mod t $temp\n";
	}
	push( @losecard , ($sn."\n".$linestring));
    }
    #print win cards
    ##################################################################################
    for my $k2 (1..$prizes)
    {
	my $linestring;
	my $count = 0;

       	my %seen;
	
	local *getNewDrawBall = sub { #workaround for scoping inner subroutine with typeglob - ugly Perlism
 	    my $type = shift;
	    my $temp2;
	    while (1){
		$temp2 = &getDrawBall($type);
		if (exists $seen{$temp2})
		{
		    next;
		}else{ $seen{$temp2}++;return $temp2;} #print "DEBUGdraw: $temp\n";
	    }
	};
	local *getNewNonDrawBall = sub { #workaround for scoping inner subroutine with typeglob - ugly Perlism
	    my $type = shift;
	    my $temp2;
	    while (1){
		$temp2 = &getNonDrawBall($type);
		if (exists $seen{$temp2})
		{
		    next;
		}else{ $seen{$temp2}++;return $temp2;} #print "DEBUG_no_draw: $temp\n";
	    }
	};	

	#SPOIL CARD HERE
	my @spoil = &getSpoilScheme();
	my $spoilflag = 'nospoil';

	#actually write card

	#define modified spoil and winstring
	my $winline;
	my %winNums;
	my $tempWL = 1;
	while ($tempWL == 1) {$winline = &getRand;  if ($winline < 5){$tempWL = 0};} #perhaps cleaner way to deal with loops; uses variables though
	my $winNumStart = 5 * $winline - 4;
	for ($winNumStart .. ($winNumStart+4)){$winNums{$_}++};

	local *coinFlip = sub {
	    my $z = &getRand;
	    my $coin = int($z)% 2;
	    return $coin;
	};
############serial number
	my $scheme = '11';
	local *buildSN = sub {
	    while (1){
		my @sn;
		for (1..4){
		    local $_ = &coinFlip; 
		    push( @sn, $_);
		};
		push( @sn, "$scheme");
		for (1..4){
		    local $_ = &coinFlip; 
		    push( @sn, $_);
		};
		my $temp = "@sn";
		$temp =~ s,\s+,,g;
#		unless (exists $serialNumber{$temp}){
		    return $temp;
		}} ;	 
	my $sn;my $thing =1;
	while ($thing == 1){
	    $sn = &buildSN;
	    unless (exists $serialNumber{$sn}){
		$thing=0}};

	for my $num (1..25)
	{
       	    my( $mod, $temp);
	    $mod = $num % 5;

	    if (($num) == ($spoil[0] + 1))  ##SET SPOILFLAG
	    {
		shift @spoil unless (@spoil == 1);
		$spoilflag = 'spoil';  #print "intend to spoil $num\n";
	    }else{
		$spoilflag = 'nospoil';
	    };
	    if(exists $winNums{$num})
	    {
		$spoilflag = 'nospoil'; #print "spoiling of $num rescued here\n";
	    }
	    
#	    print "DEBUG.spoil: k $k num $num flag $spoilflag spoil @spoil \n";    	    

	    if ($spoilflag eq 'nospoil')  ##REACT TO SPOILFLAG
	    {

		if( $mod == 1){$temp = &getNewDrawBall('B');$seen{$temp}++;}
		elsif( $mod == 2){$temp = &getNewDrawBall('I');$seen{$temp}++;}
		elsif( $mod == 3){$temp = &getNewDrawBall('N');$seen{$temp}++;}
		elsif( $mod == 4){$temp = &getNewDrawBall('G');$seen{$temp}++;}
		elsif( $mod == 0){$temp = &getNewDrawBall('O');$seen{$temp}++;};
	    }elsif($spoilflag eq 'spoil')
	    {
		if( $mod == 1){$temp = &getNewNonDrawBall('B');$seen{$temp}++;}
		elsif( $mod == 2){$temp = &getNewNonDrawBall('I');$seen{$temp}++;}
		elsif( $mod == 3){$temp = &getNewNonDrawBall('N');$seen{$temp}++;}
		elsif( $mod == 4){$temp = &getNewNonDrawBall('G');$seen{$temp}++;}
		elsif( $mod == 0){$temp = &getNewNonDrawBall('O');$seen{$temp}++;};
	    }else{die "THIS SHOULDN'T HAPPEN\n";};

	    $linestring .= "$temp ";
	    $count++;
#	    print "DEBUG: k $k n $num m $mod t $temp\n";
	}
	push( @wincard , ($sn."\n".$linestring));
    }
}

sub getSpoilScheme{
    my @spoil;
    my @spoil1 = (0,6,12,18,24);
    my @spoil2 = (4,8,12,16,20);
    #select spoil scheme (coin flip)
    my $z = &getRand;
    my $coin = int($z)% 2;
    if ($coin==0){@spoil = @spoil1}else{@spoil = @spoil2};
#    print "DEBUGspoil\:\: z $z coin $coin spoil @spoil\n";
    return @spoil;
}
sub getRand{
    my $temp;
    while (1){
	$temp = int(1111*rand()/11); 
	unless ($temp == 0) {return $temp}}};
sub getDrawBall{
    my $type = shift;
    while (1){
	my $temp = pop @callseq;
	unshift( @callseq, $temp );
	if ($temp =~ /$type/){return $temp; print "DEBUG getDrawBall: $temp\n";}}}
sub getNonDrawBall{
    my $type = shift;
    while (1){
	my $temp = pop @noncallseq;
	unshift( @noncallseq, $temp ); #print "sNDB\:\: TEMP $temp TYPE $type\n";
	if ($temp =~ /$type/){return $temp; print "DEBUG getnonDrawBall: $temp\n";}}}

###########-this part used to load predefined  metadata; cards outputed from metadata
###########-this metadata needed so Matt can have the draw sequence now.
sub doInit () #with lispy whitespace!
{
    open (IN, "metadata2.dat");
    my $tempState = 'start';
    while( <IN> ){
	if ( m{\ACALL SEQUENCE:([^\n]+),} ){
	    $tempState = 'callseq';
	    my $temp = $1; #print "$temp\n";
	    $temp =~ s/,//g;
	    @callseq = split(/\s+/,$temp);
	}
#		print "DEBUGY3: here\n";
#	for (@callseq){print "callseq:: $_\n";}
	if ( m!
	     \A NONCALL\sSEQUENCE: ([^\n]+),
	     !x){
#		print "DEBUGY2: here\n";
	    $tempState = 'noncallseq';
	    my $temp = $1; #print "$temp\n";
	    $temp =~ s/,//g;
	    @noncallseq = split(/\s+/,$temp);
#		for (@noncallseq){print "DEBUGY1: noncallseq\:\: $_\n";}
	    if ( m{WINSTRINGS} ){
		$tempState = 'winstring';
		next;}
	    if ($tempState eq 'winstring'){
		next if (m,\*{3},);
		if ( m,\s?(B-\d.+?)\n, ){
		    push( @winstring,$_ );}}}}}

#{#test suite
#print "LOSECARDS:\n";
#{my $i;for(@losecard){$i++; s,((?:\w\-\d+\s){5}),$1\n,g;}}
#{my $i;for(@wincard){$i++; s,((?:\w\-\d+\s){5}),$1\n,g;}}

#my $test = &chkCards(\@wincard);
#$test =~  s,((?:[\w\!]+\s){5}),$1\n,g;
#$test =~ s,((?:[^\n]+\n){5}),$1\n,g;
#$test =~ s,((?:!DAUB!\s?){5}),$1 OOOO,g;
#print "$test";
#$test = &chkCards(\@losecard);
#$test =~  s,((?:[\w\!]+\s){5}),$1\n,g;
#$test =~ s,((?:[^\n]+\n){5}),$1\n,g;
#$test =~ s,((?:!DAUB!\s?){5}),$1 OOOO,g;
#print "$test";
#$test = &testSuite;
#my $ref = $test;
#my %testSeen;
#$test =~ s,([01]{10}),$1(?{$testSeen{$1}++}),g;
#for ( sort{ $a <=> $b } keys %testSeen    )
#for ( keys %testSeen )  
#{print;print "\n";};
#}
#my @allcards = push( @wincard, @losecard );
#{my $i;for(@allcards){$i++; s,((?:\w\-\d+\s){5}),$1\n\n,g;print "$i\n";print;}}

#sub chkCards{
#    my @cards = shift;
#    my $count;
#    my $out;
#    my( %call, %nocall);
#    for (@callseq){$call{$_}++};
#    for (@noncallseq){$nocall{$_}++};
#    local *chkCard = sub {
#	my $card = shift;
#	my @seq = split(/\s+/,$card);
#	for (@seq)
#	{
#	    if (m,[01]{10},){print "$&\n";next;}
#	    if(exists $call{$_}){
#		$out .= "!DAUB! ";
#	    }elsif(exists $nocall{$_}){
#		$out .= "NODAUB ";
#	    }else{
#		die "this shouldn't happen";
#	    }
#	}
#    };
#    for (@wincard){
#	&chkCard($_)
#    };
#    return $out;
#}