Mercurial > laserkard

comparison buy.pl @ 51:95fa4bcc5d67 laserkard

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
[svn r52] implemented SVG backend
author rlm
date Wed, 03 Feb 2010 03:14:09 -0500
parents 4431dc7d4bb5
children 343dc947f999
comparison
equal deleted inserted replaced
50:1b5417799713 51:95fa4bcc5d67
1 #!/usr/bin/perl 1 #!/usr/bin/perl
2 2
3 3
4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
5 use Storable;
6 use CGI::Ajax;
7 use CGI;
8 use JSON;
9 4
5 use Laserkard;
10 6
11 7
12 my $q = new CGI; 8 my $q = new CGI;
13 9
10 #print Laserkard::gen();
14 11
15 12 my %hash =
16 my %hash = ( 13 (
17 14 'material' => \&Laserkard::material,
18 'material' => \&material, 15 'template' => \&Laserkard::template,
19 16 'inputbox' => \&Laserkard::inputbox,
20 'template' => \&template, 17 'display' => \&Laserkard::display,
21 'inputbox' => \&inputbox, 18 'change_rules' => \&Laserkard::change_rules,
22 'display' => \&display, 19 'vanish' => \&Laserkard::vanish,
23 'change_rules' => \&change_rules, 20 'updateForm' => \&Laserkard::updateForm,
24 'vanish' => \&vanish, 21 'cardType' => \&Laserkard::cardType
25 'updateForm' => \&updateForm,
26 'cardType' => \&cardType
27 ); 22 );
28 23
29 24
30 25
31 my $pjx = CGI::Ajax->new(%hash); 26 my $pjx = CGI::Ajax->new(%hash);
32 27
33 28
34 # this outputs the html for the page 29 # this outputs the html for the page
35 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'}); 30 print $pjx->build_html($q,\&Laserkard::genBuy,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'});
36 31
37 32
38 33 # it's a refrence to a function, not a function itself.
39 sub cardType
40 {
41
42 return $_[0];
43
44 }
45
46
47
48 sub updateForm
49
50 {
51
52
53 $key = shift;
54 $value = shift;
55 $hashString = shift;
56
57 $perl_hash = decode_json $hashString;
58
59 %fieldHash = %$perl_hash;
60
61
62 $fieldHash{$key} = $value;
63 $ref = \%fieldHash;
64
65 $utf8_encoded_json_text = encode_json $ref ;
66 return $utf8_encoded_json_text;
67
68 }
69
70
71
72
73 sub material{
74
75 $newvar = shift;
76
77 my $t = $newvar;
78
79 $newvar =~ m/([^_]*)_/;
80 $newvar = $1;
81
82 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
83
84 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
85
86 {
87 local( $/, *FH ) ;
88 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
89 $y = <FH>;
90 }
91
92 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
93
94 for (@symbols)
95 {
96 $c = $_;
97 $c =~ s/PERL:://;
98 $c =~ tr/[A-Z]/[a-z]/;
99 $c =~ s/^/_/;
100
101 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
102 $y =~ s/$_/$b/;
103 }
104
105
106 $first = shift;
107 if ($first){ $y =~ s/display[^;]*;//g; }
108
109
110
111 return $y;
112
113
114 }
115
116
117
118 sub template
119 {
120
121 $all = shift;
122 $all =~ m/([^_]*)_(.*)/;
123
124 $materialcolor = $2;
125 $style = $1;
126 #here is where we handle important drawing commands relating to the cards.
127
128
129
130 $r = <<HERE;
131 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
132 <div id = 'stupid'>
133
134
135 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"
136 onmouseover="pokedex('big_$materialcolor');"
137 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
138
139
140
141 onclick=
142 "display(['template2'], ['display']);
143 inputbox(['template2', 'formValues'], ['inputbox']);
144 material(['template2'], ['materials']);
145 cardType(['template2'], ['currentSpec']);
146 redraw('bold');"
147 ID="template2" NAME="template2" VALUE="big_$materialcolor">
148 <br>
149
150
151
152 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
153 onmouseover="pokedex('basic_$materialcolor');"
154 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
155 onclick=
156 "display(['template3'], ['display']);
157 inputbox(['template3', 'formValues'], ['inputbox']);
158 material(['template3'], ['materials']);
159 cardType(['template3'], ['currentSpec']);
160 redraw('arrow');"
161 ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
162
163
164
165 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
166 onmouseover="pokedex('classic_$materialcolor');"
167 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
168 onclick=
169 "display(['template1'], ['display']);
170 inputbox(['template1', 'formValues'], ['inputbox']);
171 material(['template1'], ['materials']);
172 cardType(['template1'], ['currentSpec']);
173 redraw('classic');"
174 ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
175
176
177
178 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
179 onmouseover="pokedex('lines_$materialcolor');"
180 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
181 onclick=
182 "display(['template4'], ['display']);
183 inputbox(['template4', 'formValues'], ['inputbox']);
184 material(['template4'], ['materials']);
185 cardType(['template4'], ['currentSpec']);
186 redraw('direct');"
187 ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
188
189 </div>
190 </div>
191
192 HERE
193
194
195 %shankHash =
196 (
197
198 big => template2,
199 basic => template3,
200 classic => template1,
201 lines => template4
202 );
203
204 $target = $shankHash{$style};
205
206
207
208
209 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
210
211
212
213
214
215 return $r;
216 }
217
218
219
220
221 sub inputbox
222 {
223
224 #grab the type of template we'll be using <<<<
225 $type = shift;
226
227 $hashString = shift;
228 #return $hashString;
229
230 $perl_hash = decode_json $hashString;
231
232 %fieldHash = %$perl_hash;
233
234
235 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
236
237 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
238 #will probaly eventually create a script to automate the generation of these files.
239
240
241 #take care of everythign but acrylic clear type
242
243 {
244 local( $/, *FH ) ;
245 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
246 $z = <FH>;
247 }
248
249
250 #every type has it's own associated paylist file the contains the things we need
251
252 $z = <<HERE . $z;
253 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
254 HERE
255
256
257
258
259 $z = $z.'</div>';
260
261
262 foreach my $key ( keys %fieldHash )
263 {
264
265 my $replace = $fieldHash{$key};
266
267 #id="Name" value = "PERL::NAME"
268
269
270 $z =~ s/id="$key"/id="$key" value = "$replace"/g;
271
272
273 }
274
275
276 return $z;
277
278
279
280
281
282 }
283
284
285
286
287 sub display
288 {
289 $all = shift;
290
291
292 #~
293 #~ $t = <<HERE;
294 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
295 #~
296 #~ <div id = overlay>
297 #~
298 #~
299 #~ </div>
300 #~
301 #~ HERE
302 #~
303 #~
304 #~
305 #~ $t =~ s/PERL::PIC/$all/g;
306
307 $t = <<HERE;
308 <image src = "./images/display/blank.jpg"
309 onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
310 >
311
312 <div id = overlay>
313
314
315 </div>
316
317 HERE
318
319 return $t;
320
321 }
322
323
324
325
326 sub gen
327 {
328 {
329 local( $/, *FH ) ;
330 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
331 $a = <FH>;
332 }
333
334 {
335 local( $/, *FH ) ;
336 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
337 $b = <FH>;
338 }
339
340 {
341 local( $/, *FH ) ;
342 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
343 $c = <FH>;
344 }
345
346 $a =~s/PERL::DEFS/$c/;
347
348
349
350 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
351 $b = &material("void_acrylic_clear",1);
352 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
353
354
355
356 $b = "big_acrylic_clear";
357 $a =~ s/PERL::INITIALCARD/$b/;
358 $b = &template("big_acrylic_clear");
359 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
360
361 $b = &display("big_acrylic_clear");
362 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
363
364 $initials = <<HERE ;
365 {
366 "Name":"James Bond",
367 "Email":"jbond\@mi6.co.uk",
368 "Phone": "123.456.7890",
369 "Company": "MI6",
370 "Website" : "http://jamesbond.com",
371 "Occupation" : "Secret Agent"
372 }
373
374 HERE
375
376
377
378 $b = &inputbox("big_acrylic_clear", $initials);
379 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
380
381 $b = &pokedex('big');
382 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
383
384
385
386 #$b = &updateForm('fuck','12', '{}');
387 $a =~ s/PERL::INITIALVALUES/$initials/;
388
389
390
391 return $a
392
393
394 }
395
396
397
398 sub pokedex
399 {
400
401
402 $classic = <<HERE;
403 <h1>The Classic LaserKard.</h1>
404 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
405 HERE
406
407 $bold = <<HERE;
408 <h1>The Bold Kard.</h1>
409 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.
410 HERE
411
412 $arrow = <<HERE;
413 <h1>The Arrow Kard.</h1>
414 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
415 HERE
416
417 $direct = <<HERE;
418 <h1>The Direct Kard.</h1>
419 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
420 HERE
421
422
423
424 my %megahash =
425 (
426
427 'big' => $bold,
428
429 'basic' => $arrow,
430
431 'lines' => $direct,
432
433 'classic' => $classic,
434
435 'big_acrylic_clear' => $bold,
436
437 'classic_acrylic_clear' => $classic,
438
439 'basic_acrylic_clear' => $arrow,
440
441 'lines_acrylic_clear' => $direct
442 );
443
444
445
446 my $key = shift;
447
448
449 if (!$megahash{$key}){return $key;}
450
451 return $megahash{$key};
452
453
454
455
456 }
457
458
459
460
461
462
463
464
465 # this here function makes the paypal button go away so people know it's working!
466 sub vanish
467 {
468 return "";
469
470
471 }
472