#!/usr/bin/perl

use strict;
use warnings;

###################################################USER VARIABLES
#define number of people, number of prizes, number of draws (> 5)
my $people = 10;
my $prizes = 8;
my $draws = 22*2;

#define total set of BINGO numbers
#range of numbers
my $range = 75;
####################################################INTERNAL/DEVELOPMENT VARIABLES
my $bin = int $range/5;
my @bins = ($bin, 2*$bin, 3*$bin, 4*$bin);
#my @seq = @fudgedDrawSeq; 
my (@callseq, @noncallseq); #auxillary lists to build 
my @winstring;
####################################################MAIN EXECUTION 1
###########-this part used to define metadata; cards outputed from metadata
###########-this metadata needed so Matt can have the draw sequence now.
#my %ball; #hash containing $range BINGO balls THIS SHOULDN'T BE HERE
#my @drawSeq; #for &defDrawSeq, draw sequence
#&defDrawSeq; #define @drawSwq
#my @seq = @drawSeq; #for modularity to &mkWinstring
#print "DEBUG: @seq\n";
#print "CALL SEQUENCE:";
#for (0..($draws-1)){push( @callseq, $seq[$_] ); print "$seq[$_], ";}
#print "\nNONCALL SEQUENCE:";
#for ($draws..($range-1)){push( @noncallseq, $seq[$_] ); print "$seq[$_], ";}
#&mkWinstring;###############################################################
#unless (&chkWinstring){die "\nplease rerun, internal randomization error"}
#&mkCards;

####################################################FUNCTIONS 1
sub defDrawSeq (){
#define draw sequences (string of $draw numbers, randomized with hashtable lookup)
    {
	for (1..$range){
	    if ( $_ <= $bins[0] ){$ball{$_}="B-$_"}
	    elsif ( $_ <= $bins[1] ){$ball{$_}="I-$_"}
	    elsif ( $_ <= $bins[2] ){$ball{$_}="N-$_"}
	    elsif ( $_ <= $bins[3] ){$ball{$_}="G-$_"}
	    else{$ball{$_}="O-$_"};
	}
    }

    for (keys %ball){
	push (@drawSeq, $ball{$_}); #print "\'$ball{$_}\', ";
    };
}

sub chkWinstring () {
    for (@winstring){
	my @temp = split;
	my ($sum,$err);
	for (@temp){$sum++;}
	if ($sum != 5){return 1}else{return 0}
    }
}

sub mkWinstring (){
    my (@b, @i, @n, @g, @o);
    for (0..($draws-1)){
	local $_ = $seq[$_];
#	print "DEBUG $_\n";

	if (m,B,){push(@b,$_);next;}
	elsif(m,I,){push(@i,$_);next;}
	elsif(m,N,){push(@n,$_);next;}
	elsif(m,G,){push(@g,$_);next;}
	elsif(m,O,){push(@o,$_);next;}
    }
    print "\nSUBLISTS FOR CARD MAKING:\n";
    print "***\n B: @b \nI: @i\nN: @n\nG: @g\nO: @o\n***\n";

    for my $j (0..($prizes-1))
    {
	my $winstring = $b[$j].' '.$i[$j].' '.$n[$j].' '.$g[$j].' '.$o[$j]."\n";
	my @temp = split(/\s+/,$winstring);
	my $temp; for (@temp){$temp++;} #print "DEBUG $m\n";}
	if  ($temp == 5){
	    push (@winstring, $winstring);
        }else{
	    print "ERROR $winstring";
	}
    } print "WINSTRINGS:\n***\n@winstring***\n";
}

sub mkCards{#needs global @winstring
    my( @wincard, @losecard);
    #print winning cards;    
    print "WINNING CARDS:\n";
    for my $k (1..$prizes)
    {
	my $l = "$winstring[$k-1]";
	print "LINESTRING 0: $l";
	for my $line (1..4)
	{
	    my $linestring;
	    my $pos = &getPos();
	    my $temp = &getDrawBall;
	    print "$temp ";
#	    if( $pos == 1 ){ $linestring = ";}
#	    elsif( $pos == 2 ){ $linestring = "$b[$j] $i[$j] $n[$j] $g[$j] $o[$j]\n";}
#	    elsif( $pos == 3 ){ $linestring = "$b[$j] $i[$j] $n[$j] $g[$j] $o[$j]\n";}
#	    elsif( $pos == 4 ){ $linestring = "$b[$j] $i[$j] $n[$j] $g[$j] $o[$j]\n";}
#	    print "\nLINESTRING $line: $linestring\n";
	}	    
    }
}

sub getRand(){
    while (1){
	my $temp = int(1111*rand()/11);
	unless ($temp = 0) {return $temp; exit}
    }
}

sub getPos(){
    while (1){
	my $temp = int((1111*rand()/111)%5)+1;
	unless ($temp > 5) {return $temp; exit}
    }
}


##</code><code>##

DEBUG: N-42 N-34 O-67 G-59 B-9 O-71 O-75 O-72 O-73 I-22 B-15 O-63 O-70 I-19 B-3 N-32 G-48 N-33 O-74 N-31 B-10 N-37 B-4 N-36 B-7 I-26 G-47 G-51 G-57 I-30 G-52 I-20 O-62 G-58 N-38 I-16 I-24 I-25 G-49 B-8 N-44 B-13 I-28 G-50 O-61 O-64 N-39 G-54 I-23 B-14 I-17 N-45 N-35 B-6 B-5 B-12 G-53 O-65 I-27 O-66 N-41 G-55 O-68 G-56 G-46 N-43 B-11 I-29 N-40 O-69 B-2 G-60 I-21 I-18 B-1
CALL SEQUENCE:N-42, N-34, O-67, G-59, B-9, O-71, O-75, O-72, O-73, I-22, B-15, O-63, O-70, I-19, B-3, N-32, G-48, N-33, O-74, N-31, B-10, N-37, B-4, N-36, B-7, I-26, G-47, G-51, G-57, I-30, G-52, I-20, O-62, G-58, N-38, I-16, I-24, I-25, G-49, B-8, N-44, B-13, I-28, G-50, 
NONCALL SEQUENCE:O-61, O-64, N-39, G-54, I-23, B-14, I-17, N-45, N-35, B-6, B-5, B-12, G-53, O-65, I-27, O-66, N-41, G-55, O-68, G-56, G-46, N-43, B-11, I-29, N-40, O-69, B-2, G-60, I-21, I-18, B-1, 
SUBLISTS FOR CARD MAKING:
***
B: B-9 B-15 B-3 B-10 B-4 B-7 B-8 B-13 
I: I-22 I-19 I-26 I-30 I-20 I-16 I-24 I-25 I-28
N: N-42 N-34 N-32 N-33 N-31 N-37 N-36 N-38 N-44
G: G-59 G-48 G-47 G-51 G-57 G-52 G-58 G-49 G-50
O: O-67 O-71 O-75 O-72 O-73 O-63 O-70 O-74 O-62
***
WINSTRINGS:
***
B-9 I-22 N-42 G-59 O-67
B-15 I-19 N-34 G-48 O-71
B-3 I-26 N-32 G-47 O-75
B-10 I-30 N-33 G-51 O-72
B-4 I-20 N-31 G-57 O-73
B-7 I-16 N-37 G-52 O-63
B-8 I-24 N-36 G-58 O-70
B-13 I-25 N-38 G-49 O-74
***

##</code><code>##

#!/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;
#}