view buy.pl @ 29:7742910e0479 laserkard

[svn r30] implemented drawing text on the picture dynamically. still need to center stuff
author rlm
date Sat, 16 Jan 2010 12:25:43 -0500
parents 5b5c03a850b9
children 0deeb2d5d1db
line wrap: on
line source
1 #!/usr/bin/perl
4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
5 use Storable;
6 use CGI::Ajax;
7 use CGI;
11 my $q = new CGI;
15 my %hash = (
17 'material' => \&material,
18 'pokedex' => \&pokedex,
19 'template' => \&template,
20 'inputbox' => \&inputbox,
21 'display' => \&display,
22 'change_rules' => \&change_rules,
23 'vanish' => \&vanish
24 );
28 my $pjx = CGI::Ajax->new(%hash);
29 #$pjx->JSDEBUG(1);
30 #$pjx->DEBUG(1);
32 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'}); # this outputs the html for the page
38 sub material{
40 $newvar = shift;
42 my $t = $newvar;
44 $newvar =~ m/([^_]*)_/;
45 $newvar = $1;
47 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
49 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
51 {
52 local( $/, *FH ) ;
53 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
54 $y = <FH>;
55 }
57 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
59 for (@symbols)
60 {
61 $c = $_;
62 $c =~ s/PERL:://;
63 $c =~ tr/[A-Z]/[a-z]/;
64 $c =~ s/^/_/;
66 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
67 $y =~ s/$_/$b/;
68 }
71 $first = shift;
72 if ($first){ $y =~ s/display[^;]*;//g; }
76 return $y;
79 }
83 sub template
84 {
86 $all = shift;
87 $all =~ m/_(.*)/;
89 $materialcolor = $1;
92 $r = "<div id = \"i_templates\"><titletron>Templates</titletron><br>
94 <input TYPE=\"image\" src = \"./images/templates/big_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__big\'],[\'pokedex\']);\" onclick=\"display([\'template2\'], [\'display\']); inputbox([\'template2\'], [\'inputbox\']);material([\'template2\'], [\'materials\']);\" ID=\"template2\" NAME=\"template2\" VALUE=\"big_$materialcolor\" > <br>
96 <input TYPE=\"image\" src = \"./images/templates/basic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__basic\'],['pokedex\']);\" onclick=\"display([\'template3\'], [\'display\']); inputbox([\'template3\'], [\'inputbox\']);material([\'template3\'], [\'materials\']);\" ID=\"template3\" NAME=\"template3\" VALUE=\"basic_$materialcolor\" ><br>
98 <input TYPE=\"image\" src = \"./images/templates/classic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__classic\'],[\'pokedex\']);\" onclick=\"display([\'template1\'], [\'display\']); inputbox([\'template1\'], [\'inputbox\']);material([\'template1\'], [\'materials\']);\" ID=\"template1\" NAME=\"template1\" VALUE=\"classic_$materialcolor\" ><br>
100 <input TYPE=\"image\" src = \"./images/templates/lines_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__lines\'],[\'pokedex\']);\" onclick=\"display([\'template4\'], [\'display\']); inputbox([\'template4\'], [\'inputbox\']);material([\'template4\'], [\'materials\']);\" ID=\"template4\" NAME=\"template4\" VALUE=\"lines_$materialcolor\" >
101 </div>
103 ";
105 return $r;
106 }
111 sub inputbox
112 {
114 #grab the type of template we'll be using <<<<
115 $type = shift;
116 # return $type;
117 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
119 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
120 #will probaly eventually create a script to automate the generation of these files.
123 #take care of everythign but acrylic clear type
127 {
128 local( $/, *FH ) ;
129 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
130 $z = <FH>;
131 }
134 #every type has it's own associated paylist file the contains the things we need
136 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
137 return $z;
143 }
152 sub display
153 {
154 $all = shift;
158 $t = <<HERE;
159 <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
161 <div id = overlay>
164 </div>
166 HERE
170 $t =~ s/PERL::PIC/$all/g;
174 return $t;
176 }
181 sub gen
182 {
183 {
184 local( $/, *FH ) ;
185 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
186 $a = <FH>;
187 }
189 {
190 local( $/, *FH ) ;
191 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
192 $b = <FH>;
193 }
197 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
198 $b = &material("void_acrylic_clear",1);
199 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
200 $b = &template("big_acrylic_clear");
202 #$a =~ s/PERL-REPLACE::TEMPLATES//;
203 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!
205 $b = &display("big_acrylic_clear");
206 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
208 $b = &inputbox("big_acrylic_clear");
209 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
211 $b = &pokedex('big');
212 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
215 return $a
218 }
222 sub pokedex
223 {
226 $classic = <<HERE;
227 <h1>The Classic LaserKard.</h1>
228 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
229 HERE
231 $bold = <<HERE;
232 <h1>The Bold Kard.</h1>
233 Austere and Iconic. For those that wish to leave an impression with the power of their name accompanied only by their main method of contact. Bold, period.
234 HERE
236 $arrow = <<HERE;
237 <h1>The Arrow Kard.</h1>
238 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
239 HERE
241 $direct = <<HERE;
242 <h1>The Direct Kard.</h1>
243 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
244 HERE
248 my %megahash =
249 (
251 'big' => $bold,
253 'basic' => $arrow,
255 'lines' => $direct,
257 'classic' => $classic,
259 'big_acrylic_clear' => $bold,
261 'classic_acrylic_clear' => $classic,
263 'basic_acrylic_clear' => $arrow,
265 'lines_acrylic_clear' => $direct
266 );
270 my $key = shift;
273 if (!$megahash{$key}){return $key;}
275 return $megahash{$key};
280 }
289 # this here function makes the paypal button go away so people know it's working!
290 sub vanish
291 {
292 return "";
295 }