Mercurial > rlmcintyre

     1 #!C:/strawberry/perl/bin/perl.exe

     2 

     3 use List::Util qw(first max maxstr min minstr reduce shuffle sum);

     4 use Storable;

     5 use CGI::Ajax;

     6 use CGI;

     7 use Rule;

     8 use Filter;

     9 use Card;

    10 my $q = new CGI;

    11 

    12 

    13 

    14 my $refstruct = retrieve 'CARD.perl';

    15 my @pokes = @$refstruct;

    16 

    17 

    18 

    19 

    20 

    21 my %hash = ( 'gen_pack' => \&gen_pack, 'change_rules' => \&change_rules);

    22 

    23 

    24 

    25 

    26 

    27 

    28 my $pjx = CGI::Ajax->new(%hash);

    29 #$pjx->JSDEBUG(1);

    30 #$pjx->DEBUG(1);

    31 

    32 print $pjx->build_html($q,\&gen); # this outputs the html for the page

    33 

    34 

    35 

    36 

    37 

    38 sub change_rules

    39 {

    40 	my $currentRuleref = retrieve 'rlm/booster.prefs';

    41 	$currentRule = $$currentRuleref;

    42 	$a = shift;

    43 	$currentRule -> setSets(($a));

    44 	store \$currentRule, 'rlm/booster.prefs'; 

    45 	return $a;

    46   

    47 	

    48 }

    49 

    50 

    51 

    52 

    53 

    54 

    55 

    56 

    57 

    58 

    59 sub gen_pack

    60 {

    61 	sub tag_analyze

    62 	{

    63 

    64 	

    65 	

    66 	my @sets = $currentRule -> getSets();

    67 	#print ERR @sets;

    68 	

    69 	my $card = shift;

    70 	

    71 	#print ERR $card->getPix();

    72 	#print ERR "\n";

    73 	return $card -> hasTags(@sets);

    74 	

    75 		

    76 	}

    77 		

    78 	my $currentRuleref = retrieve 'rlm/booster.prefs';

    79 	$currentRule = $$currentRuleref;

    80 	

    81 	my $mapRules = $currentRule -> getRarityMap();

    82 	my %mapRules = %$mapRules;

    83 	

    84 	

    85 	

    86 	

    87 	#print ERR "@pokes";

    88 	@reduced = filter(\&tag_analyze, @pokes);

    89 	@reduced = shuffle(@reduced);

    90 	

    91 	my @final_list = ();

    92 	my $rnum = $mapRules{"Rare"};

    93 	my $unum = $mapRules{"Uncommon"};

    94 	my $cnum = $mapRules{"Common"};

    95 	

    96 	$holochoose = int(rand(3));

    97 	##########3

    98 	#my $rnum = 500;

    99 	#my $unum      =500;

   100 	#my $cnum = 500;

   101 	#;

   102 	##############

   103 	for $crd(@reduced)

   104 	{

   105 		

   106 		

   107 		if ($holochoose==0 or $holochoose==1 ){if (($crd -> hasTags("Rare"))and  ($rnum>0)){push @r_list, $crd;  $rnum--;}}

   108 		if ($holochoose==2){if (($crd -> hasTags("Rare Holo"))and  ($rnum>0)){push @r_list, $crd;  $rnum--;}}

   109 		#if (($crd -> hasTags("Rare") or $crd -> hasTags("Rare Holo"))and  ($rnum>0)){push @r_list, $crd;  $rnum--;}

   110 		if (($crd -> hasTags("Uncommon"))and  ($unum>0)){push @u_list, $crd;  $unum--;}

   111 		if (($crd -> hasTags("Common"))and  ($cnum>0)){push @c_list, $crd;  $cnum--;}

   112 		if ($rnum+$unum+$cnum == 0){last;}

   113 	}

   114 	

   115 	@final_list = (@r_list,@u_list,@c_list);

   116 	

   117 	

   118 	for $crd(@final_list)

   119 	{

   120 		$rob = $rob."<A HREF=\"javascript:popUp('".$crd->getPix()."')\"><img src = \"".$crd->getPix()."\"></img></A>";	

   121 		

   122 		

   123 	}

   124 	

   125 	#print $rob;

   126 

   127 	#print ERR @reduced;

   128 	#print ERR $rob;

   129 	#print $rob;

   130 	return $rob;

   131 	#close ERR;

   132 	

   133 	

   134 };

   135 

   136 

   137 

   138 

   139 

   140 sub gen

   141 {

   142 open FILE, "<index.html";

   143 return do { local $/; <FILE> };

   144 

   145 };

   146 

   147 #print "done";

   148 

   149 #print &change_rules("Fossil");

   150 #print &gen_pack;
author	Robert McIntyre <rlm@mit.edu>
date	Mon, 27 Sep 2010 16:57:26 -0400
parents
children