|
robert@0
|
1 #!C:/strawberry/perl/bin/perl.exe
|
|
robert@0
|
2
|
|
robert@2
|
3 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
|
|
robert@2
|
4 use Storable;
|
|
robert@0
|
5 use CGI::Ajax;
|
|
robert@0
|
6 use CGI;
|
|
robert@2
|
7 use Rule;
|
|
robert@2
|
8 use Filter;
|
|
robert@2
|
9 use Card;
|
|
robert@0
|
10 my $q = new CGI;
|
|
robert@0
|
11
|
|
robert@0
|
12
|
|
robert@2
|
13
|
|
robert@2
|
14 my $refstruct = retrieve 'CARD.perl';
|
|
robert@2
|
15 my @pokes = @$refstruct;
|
|
robert@2
|
16
|
|
robert@2
|
17
|
|
robert@2
|
18
|
|
robert@2
|
19
|
|
robert@2
|
20
|
|
robert@2
|
21 my %hash = ( 'gen_pack' => \&gen_pack, 'change_rules' => \&change_rules);
|
|
robert@0
|
22
|
|
robert@0
|
23
|
|
robert@0
|
24
|
|
robert@0
|
25
|
|
robert@0
|
26
|
|
robert@0
|
27
|
|
robert@0
|
28 my $pjx = CGI::Ajax->new(%hash);
|
|
robert@2
|
29 #$pjx->JSDEBUG(1);
|
|
robert@2
|
30 #$pjx->DEBUG(1);
|
|
robert@2
|
31
|
|
robert@0
|
32 print $pjx->build_html($q,\&gen); # this outputs the html for the page
|
|
robert@0
|
33
|
|
robert@0
|
34
|
|
robert@0
|
35
|
|
robert@0
|
36
|
|
robert@0
|
37
|
|
robert@2
|
38 sub change_rules
|
|
robert@2
|
39 {
|
|
robert@2
|
40 my $currentRuleref = retrieve 'rlm/booster.prefs';
|
|
robert@2
|
41 $currentRule = $$currentRuleref;
|
|
robert@2
|
42 $a = shift;
|
|
robert@2
|
43 $currentRule -> setSets(($a));
|
|
robert@2
|
44 store \$currentRule, 'rlm/booster.prefs';
|
|
robert@2
|
45 return $a;
|
|
robert@2
|
46
|
|
robert@2
|
47
|
|
robert@2
|
48 }
|
|
robert@0
|
49
|
|
robert@2
|
50
|
|
robert@2
|
51
|
|
robert@2
|
52
|
|
robert@2
|
53
|
|
robert@2
|
54
|
|
robert@2
|
55
|
|
robert@2
|
56
|
|
robert@2
|
57
|
|
robert@2
|
58
|
|
robert@2
|
59 sub gen_pack
|
|
robert@0
|
60 {
|
|
robert@2
|
61 sub tag_analyze
|
|
robert@2
|
62 {
|
|
robert@2
|
63
|
|
robert@2
|
64
|
|
robert@2
|
65
|
|
robert@2
|
66 my @sets = $currentRule -> getSets();
|
|
robert@2
|
67 #print ERR @sets;
|
|
robert@2
|
68
|
|
robert@2
|
69 my $card = shift;
|
|
robert@2
|
70
|
|
robert@2
|
71 #print ERR $card->getPix();
|
|
robert@2
|
72 #print ERR "\n";
|
|
robert@2
|
73 return $card -> hasTags(@sets);
|
|
robert@2
|
74
|
|
robert@2
|
75
|
|
robert@2
|
76 }
|
|
robert@2
|
77
|
|
robert@2
|
78 my $currentRuleref = retrieve 'rlm/booster.prefs';
|
|
robert@2
|
79 $currentRule = $$currentRuleref;
|
|
robert@2
|
80
|
|
robert@3
|
81 my $mapRules = $currentRule -> getRarityMap();
|
|
robert@3
|
82 my %mapRules = %$mapRules;
|
|
robert@3
|
83
|
|
robert@3
|
84
|
|
robert@3
|
85
|
|
robert@3
|
86
|
|
robert@2
|
87 #print ERR "@pokes";
|
|
robert@2
|
88 @reduced = filter(\&tag_analyze, @pokes);
|
|
robert@3
|
89 @reduced = shuffle(@reduced);
|
|
robert@2
|
90
|
|
robert@3
|
91 my @final_list = ();
|
|
robert@3
|
92 my $rnum = $mapRules{"Rare"};
|
|
robert@3
|
93 my $unum = $mapRules{"Uncommon"};
|
|
robert@3
|
94 my $cnum = $mapRules{"Common"};
|
|
robert@2
|
95
|
|
robert@6
|
96 $holochoose = int(rand(3));
|
|
robert@5
|
97 ##########3
|
|
robert@5
|
98 #my $rnum = 500;
|
|
robert@5
|
99 #my $unum =500;
|
|
robert@5
|
100 #my $cnum = 500;
|
|
robert@5
|
101 #;
|
|
robert@5
|
102 ##############
|
|
robert@2
|
103 for $crd(@reduced)
|
|
robert@2
|
104 {
|
|
robert@6
|
105
|
|
robert@6
|
106
|
|
robert@6
|
107 if ($holochoose==0 or $holochoose==1 ){if (($crd -> hasTags("Rare"))and ($rnum>0)){push @r_list, $crd; $rnum--;}}
|
|
robert@6
|
108 if ($holochoose==2){if (($crd -> hasTags("Rare Holo"))and ($rnum>0)){push @r_list, $crd; $rnum--;}}
|
|
robert@6
|
109 #if (($crd -> hasTags("Rare") or $crd -> hasTags("Rare Holo"))and ($rnum>0)){push @r_list, $crd; $rnum--;}
|
|
robert@3
|
110 if (($crd -> hasTags("Uncommon"))and ($unum>0)){push @u_list, $crd; $unum--;}
|
|
robert@3
|
111 if (($crd -> hasTags("Common"))and ($cnum>0)){push @c_list, $crd; $cnum--;}
|
|
robert@3
|
112 if ($rnum+$unum+$cnum == 0){last;}
|
|
robert@2
|
113 }
|
|
robert@3
|
114
|
|
robert@3
|
115 @final_list = (@r_list,@u_list,@c_list);
|
|
robert@3
|
116
|
|
robert@3
|
117
|
|
robert@3
|
118 for $crd(@final_list)
|
|
robert@3
|
119 {
|
|
robert@3
|
120 $rob = $rob."<img src = \"".$crd->getPix()."\"></img>";
|
|
robert@3
|
121 }
|
|
robert@3
|
122
|
|
robert@2
|
123 #print $rob;
|
|
robert@2
|
124
|
|
robert@2
|
125 #print ERR @reduced;
|
|
robert@2
|
126 #print ERR $rob;
|
|
robert@2
|
127 #print $rob;
|
|
robert@2
|
128 return $rob;
|
|
robert@2
|
129 #close ERR;
|
|
robert@2
|
130
|
|
robert@2
|
131
|
|
robert@0
|
132 };
|
|
robert@0
|
133
|
|
robert@0
|
134
|
|
robert@0
|
135
|
|
robert@0
|
136
|
|
robert@0
|
137
|
|
robert@0
|
138 sub gen
|
|
robert@0
|
139 {
|
|
robert@0
|
140 open FILE, "<index.html";
|
|
robert@0
|
141 return do { local $/; <FILE> };
|
|
robert@6
|
142
|
|
robert@2
|
143 };
|
|
robert@2
|
144
|
|
robert@2
|
145 #print "done";
|
|
robert@2
|
146
|
|
robert@2
|
147 #print &change_rules("Fossil");
|
|
robert@2
|
148 #print &gen_pack;
|
