view Laserkard.pm @ 51:95fa4bcc5d67 laserkard

[svn r52] implemented SVG backend
author rlm
date Wed, 03 Feb 2010 03:14:09 -0500
parents
children 8324f195ef36
line wrap: on
line source
1 package Laserkard;
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 JSON;
8 use Laserkard;
9 use base 'Exporter';
11 our @EXPORT =
12 qw(
13 material
14 template
15 inputbox
16 display
17 change_rules
18 vanish
19 updateForm
20 cardType
21 );
27 sub cardType
28 {
30 return $_[0];
32 }
36 sub updateForm
38 {
41 $key = shift;
42 $value = shift;
43 $hashString = shift;
45 $perl_hash = decode_json $hashString;
47 %fieldHash = %$perl_hash;
50 $fieldHash{$key} = $value;
51 $ref = \%fieldHash;
53 $utf8_encoded_json_text = encode_json $ref ;
54 return $utf8_encoded_json_text;
56 }
61 sub material{
63 $newvar = shift;
65 my $t = $newvar;
67 $newvar =~ m/([^_]*)_/;
68 $newvar = $1;
70 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
72 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
74 {
75 local( $/, *FH ) ;
76 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
77 $y = <FH>;
78 }
80 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
82 for (@symbols)
83 {
84 $c = $_;
85 $c =~ s/PERL:://;
86 $c =~ tr/[A-Z]/[a-z]/;
87 $c =~ s/^/_/;
89 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
90 $y =~ s/$_/$b/;
91 }
94 $first = shift;
95 if ($first){ $y =~ s/display[^;]*;//g; }
99 return $y;
102 }
106 sub template
107 {
109 $all = shift;
110 $all =~ m/([^_]*)_(.*)/;
112 $materialcolor = $2;
113 $style = $1;
114 #here is where we handle important drawing commands relating to the cards.
118 $r = <<HERE;
119 <div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
120 <div id = 'stupid'>
123 <input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"
124 onmouseover="pokedex('big_$materialcolor');"
125 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
129 onclick=
130 "display(['template2'], ['display']);
131 inputbox(['template2', 'formValues'], ['inputbox']);
132 material(['template2'], ['materials']);
133 cardType(['template2'], ['currentSpec']);
134 redraw('bold');"
135 ID="template2" NAME="template2" VALUE="big_$materialcolor">
136 <br>
140 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
141 onmouseover="pokedex('basic_$materialcolor');"
142 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
143 onclick=
144 "display(['template3'], ['display']);
145 inputbox(['template3', 'formValues'], ['inputbox']);
146 material(['template3'], ['materials']);
147 cardType(['template3'], ['currentSpec']);
148 redraw('arrow');"
149 ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
153 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
154 onmouseover="pokedex('classic_$materialcolor');"
155 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
156 onclick=
157 "display(['template1'], ['display']);
158 inputbox(['template1', 'formValues'], ['inputbox']);
159 material(['template1'], ['materials']);
160 cardType(['template1'], ['currentSpec']);
161 redraw('classic');"
162 ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
166 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
167 onmouseover="pokedex('lines_$materialcolor');"
168 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
169 onclick=
170 "display(['template4'], ['display']);
171 inputbox(['template4', 'formValues'], ['inputbox']);
172 material(['template4'], ['materials']);
173 cardType(['template4'], ['currentSpec']);
174 redraw('direct');"
175 ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
177 </div>
178 </div>
180 HERE
183 %shankHash =
184 (
186 big => template2,
187 basic => template3,
188 classic => template1,
189 lines => template4
190 );
192 $target = $shankHash{$style};
197 #$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
203 return $r;
204 }
209 sub inputbox
210 {
212 #grab the type of template we'll be using <<<<
213 $type = shift;
215 $hashString = shift;
216 #return $hashString;
218 $perl_hash = decode_json $hashString;
220 %fieldHash = %$perl_hash;
223 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
225 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
226 #will probaly eventually create a script to automate the generation of these files.
229 #take care of everythign but acrylic clear type
231 {
232 local( $/, *FH ) ;
233 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
234 $z = <FH>;
235 }
238 #every type has it's own associated paylist file the contains the things we need
240 $z = <<HERE . $z;
241 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
242 HERE
247 $z = $z.'</div>';
250 foreach my $key ( keys %fieldHash )
251 {
253 my $replace = $fieldHash{$key};
255 #id="Name" value = "PERL::NAME"
258 $z =~ s/id="$key"/id="$key" value = "$replace"/g;
261 }
264 return $z;
270 }
275 sub display
276 {
277 $all = shift;
280 #~
281 #~ $t = <<HERE;
282 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
283 #~
284 #~ <div id = overlay>
285 #~
286 #~
287 #~ </div>
288 #~
289 #~ HERE
290 #~
291 #~
292 #~
293 #~ $t =~ s/PERL::PIC/$all/g;
295 $t = <<HERE;
296 <image src = "./images/display/blank.jpg"
297 onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
298 >
300 <div id = overlay>
303 </div>
305 HERE
307 return $t;
309 }
312 sub genBuy
314 {
315 return gen("buy.html");
317 }
320 sub genEcho
321 {
323 return gen("echo.html");
325 }
328 sub gen
329 {
331 my $target = shift;
333 {
334 local( $/, *FH ) ;
335 open( FH, "<./$target" ) or die "sudden flaming death\n";
336 $a = <FH>;
337 }
339 {
340 local( $/, *FH ) ;
341 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
342 $b = <FH>;
343 }
345 {
346 local( $/, *FH ) ;
347 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
348 $c = <FH>;
349 }
351 $a =~s/PERL::DEFS/$c/;
355 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
356 $b = &material("void_acrylic_clear",1);
357 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
361 $b = "big_acrylic_clear";
362 $a =~ s/PERL::INITIALCARD/$b/;
363 $b = &template("big_acrylic_clear");
364 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
366 $b = &display("big_acrylic_clear");
367 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
369 $initials = <<HERE ;
370 {
371 "Name":"James Bond",
372 "Email":"jbond\@mi6.co.uk",
373 "Phone": "123.456.7890",
374 "Company": "MI6",
375 "Website" : "http://jamesbond.com",
376 "Occupation" : "Secret Agent"
377 }
379 HERE
383 $b = &inputbox("big_acrylic_clear", $initials);
384 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
386 $b = &pokedex('big');
387 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
391 #$b = &updateForm('fuck','12', '{}');
392 $a =~ s/PERL::INITIALVALUES/$initials/;
396 return $a
399 }
403 sub pokedex
404 {
407 $classic = <<HERE;
408 <h1>The Classic LaserKard.</h1>
409 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
410 HERE
412 $bold = <<HERE;
413 <h1>The Bold Kard.</h1>
414 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.
415 HERE
417 $arrow = <<HERE;
418 <h1>The Arrow Kard.</h1>
419 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
420 HERE
422 $direct = <<HERE;
423 <h1>The Direct Kard.</h1>
424 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
425 HERE
429 my %megahash =
430 (
432 'big' => $bold,
434 'basic' => $arrow,
436 'lines' => $direct,
438 'classic' => $classic,
440 'big_acrylic_clear' => $bold,
442 'classic_acrylic_clear' => $classic,
444 'basic_acrylic_clear' => $arrow,
446 'lines_acrylic_clear' => $direct
447 );
451 my $key = shift;
454 if (!$megahash{$key}){return $key;}
456 return $megahash{$key};
461 }
470 # this here function makes the paypal button go away so people know it's working!
471 sub vanish
472 {
473 return "";
476 }
478 1;