view Laserkard.pm @ 106:5b0753c6f34d laserkard tip

updated to newest compojure and a simpler syntax
author Robert McIntyre <rlm@mit.edu>
date Mon, 27 Sep 2010 20:22:58 -0400
parents 343dc947f999
children
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 { return $_[0];}
29 sub updateForm
30 {
31 ###################
32 $key = shift;
33 $value = shift;
34 $hashString = shift;
35 ###################
37 $perl_hash = decode_json($hashString);
39 %fieldHash = %$perl_hash;
41 $fieldHash{$key} = $value;
42 $ref = \%fieldHash;
44 $utf8_encoded_json_text = encode_json($ref);
45 return $utf8_encoded_json_text;
46 }
51 sub material
52 {
53 ##################
54 $newvar = shift;
55 ##################
56 my $t = $newvar;
58 $newvar =~ m/([^_]*)_/;
59 $newvar = $1;
61 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
63 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
65 {
66 local( $/, *FH ) ;
67 open( FH, "<./buy_pieces/materials2.html" )
68 or die "sudden flaming death\n";
69 $y = <FH>;
70 }
72 @symbols = qw (PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN
73 PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE
74 PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
76 for (@symbols)
77 {
78 $c = $_;
79 $c =~ s/PERL:://;
80 $c =~ tr/[A-Z]/[a-z]/;
81 $c =~ s/^/_/;
83 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
84 $y =~ s/$_/$b/;
85 }
87 $first = shift;
88 if ($first){ $y =~ s/display[^;]*;//g; }
89 return $y;
90 }
94 sub template
95 {
97 $all = shift;
98 $all =~ m/([^_]*)_(.*)/;
100 $materialcolor = $2;
101 $style = $1;
102 #here is where we handle important drawing commands relating to the cards.
106 $r = <<HERE;
107 <div id = "i_templates">
108 <div class = 'ttyl'> <titletron>Select Style.</titletron></div>
109 <div id = 'stupid'>
110 <input
111 TYPE="image"
112 src = "./images/templates/big_$materialcolor.jpg"
113 onmouseover="pokedex('big_$materialcolor');"
114 onmouseout =
115 "pokedex(document.getElementById('currentSpec').innerHTML);"
117 onclick=
118 "display(['template2'], ['display']);
119 inputbox(['template2', 'formValues'], ['inputbox']);
120 material(['template2'], ['materials']);
121 cardType(['template2'], ['currentSpec']);
122 redraw('bold');"
123 ID="template2"
124 NAME="template2"
125 VALUE="big_$materialcolor">
126 <br>
130 <input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
131 onmouseover="pokedex('basic_$materialcolor');"
132 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
133 onclick=
134 "display(['template3'], ['display']);
135 inputbox(['template3', 'formValues'], ['inputbox']);
136 material(['template3'], ['materials']);
137 cardType(['template3'], ['currentSpec']);
138 redraw('arrow');"
139 ID="template3" NAME="template3" VALUE="basic_$materialcolor" ><br>
143 <input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
144 onmouseover="pokedex('classic_$materialcolor');"
145 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
146 onclick=
147 "display(['template1'], ['display']);
148 inputbox(['template1', 'formValues'], ['inputbox']);
149 material(['template1'], ['materials']);
150 cardType(['template1'], ['currentSpec']);
151 redraw('classic');"
152 ID="template1" NAME="template1" VALUE="classic_$materialcolor" ><br>
156 <input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
157 onmouseover="pokedex('lines_$materialcolor');"
158 onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
159 onclick=
160 "display(['template4'], ['display']);
161 inputbox(['template4', 'formValues'], ['inputbox']);
162 material(['template4'], ['materials']);
163 cardType(['template4'], ['currentSpec']);
164 redraw('direct');"
165 ID="template4" NAME="template4" VALUE="lines_$materialcolor" >
167 </div>
168 </div>
170 HERE
173 %shankHash =
174 (
176 big => template2,
177 basic => template3,
178 classic => template1,
179 lines => template4
180 );
182 $target = $shankHash{$style};
188 return $r;
189 }
194 sub inputbox
195 {
197 #grab the type of template we'll be using <<<<
198 $type = shift;
200 $hashString = shift;
201 #return $hashString;
203 $perl_hash = decode_json $hashString;
205 %fieldHash = %$perl_hash;
208 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
210 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
211 #will probaly eventually create a script to automate the generation of these files.
214 #take care of everythign but acrylic clear type
216 {
217 local( $/, *FH ) ;
218 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
219 $z = <FH>;
220 }
223 #every type has it's own associated paylist file the contains the things we need
225 $z = <<HERE . $z;
226 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
227 HERE
232 $z = $z.'</div>';
235 foreach my $key ( keys %fieldHash )
236 {
238 my $replace = $fieldHash{$key};
240 #id="Name" value = "PERL::NAME"
243 $z =~ s/id="$key"/id="$key" value = "$replace"/g;
246 }
249 return $z;
255 }
260 sub display
261 {
262 $all = shift;
265 #~
266 #~ $t = <<HERE;
267 #~ <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
268 #~
269 #~ <div id = overlay>
270 #~
271 #~
272 #~ </div>
273 #~
274 #~ HERE
275 #~
276 #~
277 #~
278 #~ $t =~ s/PERL::PIC/$all/g;
280 $t = <<HERE;
281 <image src = "./images/blank.jpg"
282 onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
283 >
285 <div id = overlay>
288 </div>
290 HERE
292 return $t;
294 }
297 sub genBuy
299 {
300 return gen("buy.html");
302 }
305 sub genEcho
306 {
308 return gen("echo.html");
310 }
313 sub gen
314 {
316 my $target = shift;
318 {
319 local( $/, *FH ) ;
320 open( FH, "<./$target" ) or die "sudden flaming death\n";
321 $a = <FH>;
322 }
324 {
325 local( $/, *FH ) ;
326 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
327 $b = <FH>;
328 }
330 {
331 local( $/, *FH ) ;
332 open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
333 $c = <FH>;
334 }
336 $a =~s/PERL::DEFS/$c/;
340 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
341 $b = &material("void_acrylic_clear",1);
342 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
346 $b = "big_acrylic_clear";
347 $a =~ s/PERL::INITIALCARD/$b/;
348 $b = &template("big_acrylic_clear");
349 $a =~ s/PERL-REPLACE::TEMPLATES/$b/;
351 $b = &display("big_acrylic_clear");
352 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
354 $initials = <<HERE ;
355 {
356 "Name":"My Name",
357 "Email":"email\@example.com",
358 "Phone": "(555)-555-5555",
359 "Company": "Company",
360 "Website" : "http://www.example.com",
361 "Occupation" : "Occupation"
362 }
364 HERE
368 $b = &inputbox("big_acrylic_clear", $initials);
369 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
371 $b = &pokedex('big');
372 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
376 #$b = &updateForm('fuck','12', '{}');
377 $a =~ s/PERL::INITIALVALUES/$initials/;
381 return $a
384 }
388 sub pokedex
389 {
392 $classic = <<HERE;
393 <h1>The Classic LaserKard.</h1>
394 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
395 HERE
397 $bold = <<HERE;
398 <h1>The Bold Kard.</h1>
399 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.
400 HERE
402 $arrow = <<HERE;
403 <h1>The Arrow Kard.</h1>
404 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
405 HERE
407 $direct = <<HERE;
408 <h1>The Direct Kard.</h1>
409 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
410 HERE
414 my %megahash =
415 (
417 'big' => $bold,
419 'basic' => $arrow,
421 'lines' => $direct,
423 'classic' => $classic,
425 'big_acrylic_clear' => $bold,
427 'classic_acrylic_clear' => $classic,
429 'basic_acrylic_clear' => $arrow,
431 'lines_acrylic_clear' => $direct
432 );
436 my $key = shift;
439 if (!$megahash{$key}){return $key;}
441 return $megahash{$key};
446 }
455 # this here function makes the paypal button go away so people know it's working!
456 sub vanish
457 {
458 return "";
461 }
463 1;