Mercurial > laserkard

     1 package Laserkard;

     2 

     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';

    10 

    11 our @EXPORT = 

    12 qw(

    13 material

    14 template 

    15 inputbox

    16 display

    17 change_rules

    18 vanish

    19 updateForm

    20 cardType

    21 );

    22 

    23 

    24 

    25 

    26 

    27 sub cardType { return $_[0];}

    28 

    29 sub updateForm

    30 {

    31     ###################

    32     $key = shift;

    33     $value = shift;

    34     $hashString = shift;

    35     ###################

    36 

    37     $perl_hash  = decode_json($hashString);

    38     

    39     %fieldHash = %$perl_hash;

    40     

    41     $fieldHash{$key} = $value;

    42     $ref = \%fieldHash;

    43     

    44     $utf8_encoded_json_text = encode_json($ref);

    45     return $utf8_encoded_json_text;

    46 }

    47 

    48 

    49 

    50 

    51 sub material

    52 {

    53     ##################

    54     $newvar = shift;

    55     ##################

    56     my $t = $newvar;

    57     

    58     $newvar =~ m/([^_]*)_/;

    59     $newvar = $1;

    60     

    61     #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');

    62     

    63     #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."

    64     

    65     {

    66 	local( $/, *FH ) ;

    67 	open( FH, "<./buy_pieces/materials2.html" ) 

    68 	    or die "sudden flaming death\n";

    69 	$y = <FH>;

    70     }

    71     

    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);

    75     

    76     for (@symbols)

    77     {

    78 	$c = $_;

    79 	$c =~ s/PERL:://;

    80 	$c =~ tr/[A-Z]/[a-z]/;

    81 	$c =~ s/^/_/;

    82 	

    83 	$b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? '  CHECKED ' : '');

    84 	$y =~ s/$_/$b/; 

    85     }

    86 	

    87 	$first = shift;

    88 	if ($first){  $y =~ s/display[^;]*;//g; }

    89 	return $y;

    90 }

    91 

    92 

    93 

    94 sub template

    95 {

    96     

    97     $all = shift;

    98     $all =~ m/([^_]*)_(.*)/;

    99     

   100     $materialcolor = $2;

   101     $style = $1;

   102 #here is where we handle important drawing commands relating to the cards.

   103     

   104     

   105     

   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);"

   116 		 	

   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>

   127 

   128   

   129 

   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>

   140 

   141  

   142 

   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>

   153 

   154  

   155 

   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"           > 

   166 

   167 	</div>

   168 	</div>

   169 

   170 HERE

   171 

   172 

   173 %shankHash = 

   174 (

   175 

   176 big => template2,  

   177 basic => template3,

   178 classic => template1,

   179 lines  => template4

   180 );

   181 

   182 $target = $shankHash{$style};

   183 

   184 

   185 

   186 

   187 

   188 return $r;

   189 }

   190 

   191 

   192 

   193 

   194 sub inputbox

   195 {

   196 

   197 #grab the type of template we'll be using <<<<

   198 	$type = shift;

   199 	

   200 	$hashString = shift;

   201 	#return $hashString;

   202 	

   203 	$perl_hash  = decode_json $hashString;

   204 

   205 	%fieldHash = %$perl_hash;

   206  

   207 

   208 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>

   209 

   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.

   212 

   213 

   214 #take care of everythign but acrylic clear type

   215 

   216   {

   217     local( $/, *FH ) ;

   218     open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";

   219     $z = <FH>;

   220   }

   221 

   222 

   223 #every type has it's own associated paylist file the contains the things we need

   224 

   225 $z = <<HERE . $z;

   226 <div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">

   227 HERE

   228 

   229 

   230 

   231 

   232 $z = $z.'</div>';

   233 

   234 

   235 foreach my $key ( keys %fieldHash )

   236 {

   237 

   238 my $replace  = $fieldHash{$key};

   239 

   240 #id="Name" value = "PERL::NAME" 

   241 

   242 

   243 $z =~ s/id="$key"/id="$key" value = "$replace"/g;

   244 

   245 

   246 }

   247 

   248 

   249 return $z;

   250 

   251 

   252 

   253 

   254 

   255 }

   256 

   257 

   258 

   259 

   260 sub display

   261 {

   262 	$all = shift;

   263 	

   264 	

   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;

   279 

   280 	$t = <<HERE;

   281 	<image src = "./images/blank.jpg" 	

   282 	onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"

   283 	>

   284 	

   285 	<div id = overlay>

   286 

   287 

   288 	</div>

   289 	

   290 HERE

   291 	

   292 	return $t;

   293 	

   294 }

   295 

   296 

   297 sub genBuy

   298 

   299 {

   300 return gen("buy.html");	

   301 	

   302 }

   303 

   304 

   305 sub genEcho

   306 {

   307 	

   308 return gen("echo.html");

   309 	

   310 }

   311 

   312 

   313 sub gen

   314 {

   315 	

   316 	my $target = shift;

   317 	

   318   {

   319     local( $/, *FH ) ;

   320     open( FH, "<./$target" ) or die "sudden flaming death\n";

   321     $a = <FH>;

   322    }

   323 

   324   {

   325     local( $/, *FH ) ;

   326     open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";

   327     $b = <FH>;

   328    }

   329 

   330   {

   331     local( $/, *FH ) ;

   332     open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";

   333     $c = <FH>;

   334    }

   335 

   336 $a =~s/PERL::DEFS/$c/;

   337 

   338 

   339 

   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!!! :)

   343 

   344 

   345 

   346 $b = "big_acrylic_clear";

   347 $a =~ s/PERL::INITIALCARD/$b/;

   348 $b = &template("big_acrylic_clear");

   349 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; 

   350 

   351 $b = &display("big_acrylic_clear");

   352 $a =~ s/PERL-REPLACE::DISPLAY/$b/;

   353 

   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 }

   363 

   364 HERE

   365 

   366 

   367 

   368 $b = &inputbox("big_acrylic_clear", $initials);

   369 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;

   370 

   371 $b = &pokedex('big');

   372 $a =~ s/PERL-REPLACE::POKEDEX/$b/;

   373 

   374 

   375 

   376 #$b = &updateForm('fuck','12', '{}');

   377 $a =~ s/PERL::INITIALVALUES/$initials/;

   378 

   379 

   380 

   381 return $a

   382 

   383 

   384 }

   385 

   386 

   387 

   388 sub pokedex

   389 {

   390 

   391 

   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

   396 

   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

   401 

   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

   406 

   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

   411 

   412 

   413 

   414 my %megahash = 

   415 (

   416 

   417 'big' => $bold,

   418 

   419 'basic' => $arrow,

   420 

   421 'lines' => $direct,

   422 

   423 'classic' => $classic,

   424 

   425 'big_acrylic_clear' => $bold,

   426 

   427 'classic_acrylic_clear' => $classic,

   428 

   429 'basic_acrylic_clear'  => $arrow,

   430 

   431 'lines_acrylic_clear' => $direct

   432 );

   433 

   434 

   435 

   436 my $key = shift;

   437 

   438 

   439 if (!$megahash{$key}){return $key;}

   440 

   441 return $megahash{$key};

   442 

   443 

   444 

   445 

   446 }

   447 

   448 

   449 

   450 

   451 

   452 

   453 

   454 

   455 # this here function makes the paypal button go away so people know it's working!

   456 sub vanish

   457 {

   458 return "";

   459 

   460 

   461 }

   462 

   463 1;

   464 

   465
author	Robert McIntyre <rlm@mit.edu>
date	Sun, 25 Jul 2010 22:36:16 -0400
parents	343dc947f999
children