Mercurial > boosterpack

     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 	

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

    98 	#my $rnum = 500;

    99 	#my $unum      =500;

   100 	#my $cnum = 500;

   101 	#;

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

   103 	for $crd(@reduced)

   104 	{

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

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

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

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

   109 	}

   110 	

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

   112 	

   113 	

   114 	for $crd(@final_list)

   115 	{

   116 		$rob = $rob."<img src = \"".$crd->getPix()."\"></img>";	

   117 	}

   118 	

   119 	#print $rob;

   120 

   121 	#print ERR @reduced;

   122 	#print ERR $rob;

   123 	#print $rob;

   124 	return $rob;

   125 	#close ERR;

   126 	

   127 	

   128 };

   129 

   130 

   131 

   132 

   133 

   134 sub gen

   135 {

   136 open FILE, "<index.html";

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

   138 };

   139 

   140 #print "done";

   141 

   142 #print &change_rules("Fossil");

   143 #print &gen_pack;
author	robert
date	Tue, 08 Sep 2009 06:55:23 -0400
parents	2e849c856026
children	4246c7ef6487