laserkard: Laserkard.pm comparison

comparison Laserkard.pm @ 51:95fa4bcc5d67 laserkard

[svn r52] implemented SVG backend

author	rlm
date	Wed, 03 Feb 2010 03:14:09 -0500
parents
children	8324f195ef36

comparison

equal deleted inserted replaced

-:1b5417799713
+:95fa4bcc5d67
+package Laserkard;
+use List::Util qw(first max maxstr min minstr reduce shuffle sum);
+use Storable;
+use CGI::Ajax;
+use CGI;
+use JSON;
+use Laserkard;
+use base 'Exporter';
+our @EXPORT =
+qw(
+material
+template
+inputbox
+display
+change_rules
+vanish
+updateForm
+cardType
+);
+sub cardType
+{
+return $_[0];
+}
+sub updateForm
+{
+	$key = shift;
+	$value = shift;
+	$hashString = shift;
+	$perl_hash  = decode_json $hashString;
+	%fieldHash = %$perl_hash;
+	$fieldHash{$key} = $value;
+	$ref = \%fieldHash;
+	$utf8_encoded_json_text = encode_json  $ref ;
+	return $utf8_encoded_json_text;
+}
+sub material{
+	$newvar = shift;
+	my $t = $newvar;
+	$newvar =~ m/([^_]*)_/;
+	$newvar = $1;
+	#return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
+	#$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
+	{
+local( $/, *FH ) ;
+open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
+$y = <FH>;
+	}
+	@symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
+	for (@symbols)
+	{
+	$c = $_;
+	$c =~ s/PERL:://;
+	$c =~ tr/[A-Z]/[a-z]/;
+	$c =~ s/^/_/;
+	$b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? '  CHECKED ' : '');
+	$y =~ s/$_/$b/;
+	}
+	$first = shift;
+	if ($first){  $y =~ s/display[^;]*;//g; }
+	return $y;
+}
+sub template
+{
+$all = shift;
+$all =~ m/([^_]*)_(.*)/;
+$materialcolor = $2;
+$style = $1;
+#here is where we handle important drawing commands relating to the cards.
+$r =  <<HERE;
+<div id = "i_templates"><div class = 'ttyl'> <titletron>Select Style.</titletron></div>
+<div id = 'stupid'>
+<input TYPE="image" src = "./images/templates/big_$materialcolor.jpg"
+onmouseover="pokedex('big_$materialcolor');"
+onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
+onclick=
+"display(['template2'], ['display']);
+inputbox(['template2', 'formValues'], ['inputbox']);
+material(['template2'], ['materials']);
+cardType(['template2'], ['currentSpec']);
+redraw('bold');"
+ID="template2" NAME="template2" VALUE="big_$materialcolor">
+<br>
+<input TYPE="image" src = "./images/templates/basic_$materialcolor.jpg"
+onmouseover="pokedex('basic_$materialcolor');"
+onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
+onclick=
+"display(['template3'], ['display']);
+inputbox(['template3', 'formValues'], ['inputbox']);
+material(['template3'], ['materials']);
+cardType(['template3'], ['currentSpec']);
+redraw('arrow');"
+ID="template3" NAME="template3" VALUE="basic_$materialcolor"          ><br>
+<input TYPE="image" src = "./images/templates/classic_$materialcolor.jpg"
+onmouseover="pokedex('classic_$materialcolor');"
+onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
+onclick=
+"display(['template1'], ['display']);
+inputbox(['template1', 'formValues'], ['inputbox']);
+material(['template1'], ['materials']);
+cardType(['template1'], ['currentSpec']);
+redraw('classic');"
+ID="template1" NAME="template1" VALUE="classic_$materialcolor"    ><br>
+<input TYPE="image" src = "./images/templates/lines_$materialcolor.jpg"
+onmouseover="pokedex('lines_$materialcolor');"
+onmouseout = "pokedex(document.getElementById('currentSpec').innerHTML);"
+onclick=
+"display(['template4'], ['display']);
+inputbox(['template4', 'formValues'], ['inputbox']);
+material(['template4'], ['materials']);
+cardType(['template4'], ['currentSpec']);
+redraw('direct');"
+ID="template4" NAME="template4" VALUE="lines_$materialcolor"           >
+	</div>
+	</div>
+HERE
+%shankHash =
+(
+big => template2,
+basic => template3,
+classic => template1,
+lines  => template4
+);
+$target = $shankHash{$style};
+#$r =~ s/inputbox\(\['$target'\], \['inputbox'\]\)\;//;
+return $r;
+}
+sub inputbox
+{
+#grab the type of template we'll be using <<<<
+	$type = shift;
+	$hashString = shift;
+	#return $hashString;
+	$perl_hash  = decode_json $hashString;
+	%fieldHash = %$perl_hash;
+# we have to care about both the type of template and the material and the color. these are stored in $type>>>>
+#Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
+#will probaly eventually create a script to automate the generation of these files.
+#take care of everythign but acrylic clear type
+{
+local( $/, *FH ) ;
+open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
+$z = <FH>;
+}
+#every type has it's own associated paylist file the contains the things we need
+$z = <<HERE . $z;
+<div id = "whatever" onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);">
+HERE
+$z = $z.'</div>';
+foreach my $key ( keys %fieldHash )
+{
+my $replace  = $fieldHash{$key};
+#id="Name" value = "PERL::NAME"
+$z =~ s/id="$key"/id="$key" value = "$replace"/g;
+}
+return $z;
+}
+sub display
+{
+	$all = shift;
+	#~
+	#~ $t = <<HERE;
+	#~ <image src = "./images/display/PERL::PIC.jpg" 	onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
+	#~
+	#~ <div id = overlay>
+#~
+#~
+	#~ </div>
+	#~
+#~ HERE
+#~
+#~
+#~
+#~ $t =~ s/PERL::PIC/$all/g;
+	$t = <<HERE;
+	<image src = "./images/display/blank.jpg"
+	onmouseover = "pokedex(document.getElementById('currentSpec').innerHTML);"
+	>
+	<div id = overlay>
+	</div>
+HERE
+	return $t;
+}
+sub genBuy
+{
+return gen("buy.html");
+}
+sub genEcho
+{
+return gen("echo.html");
+}
+sub gen
+{
+	my $target = shift;
+{
+local( $/, *FH ) ;
+open( FH, "<./$target" ) or die "sudden flaming death\n";
+$a = <FH>;
+}
+{
+local( $/, *FH ) ;
+open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
+$b = <FH>;
+}
+{
+local( $/, *FH ) ;
+open( FH, "<./cardDefinitions.JSON" ) or die "sudden flaming death\n";
+$c = <FH>;
+}
+$a =~s/PERL::DEFS/$c/;
+$a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
+$b = &material("void_acrylic_clear",1);
+$a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
+$b = "big_acrylic_clear";
+$a =~ s/PERL::INITIALCARD/$b/;
+$b = &template("big_acrylic_clear");
+$a =~ s/PERL-REPLACE::TEMPLATES/$b/;
+$b = &display("big_acrylic_clear");
+$a =~ s/PERL-REPLACE::DISPLAY/$b/;
+$initials = <<HERE ;
+{
+"Name":"James Bond",
+"Email":"jbond\@mi6.co.uk",
+"Phone": "123.456.7890",
+"Company": "MI6",
+"Website" : "http://jamesbond.com",
+"Occupation" : "Secret Agent"
+}
+HERE
+$b = &inputbox("big_acrylic_clear", $initials);
+$a =~ s/PERL-REPLACE::INPUTBOX/$b/;
+$b = &pokedex('big');
+$a =~ s/PERL-REPLACE::POKEDEX/$b/;
+#$b = &updateForm('fuck','12', '{}');
+$a =~ s/PERL::INITIALVALUES/$initials/;
+return $a
+}
+sub pokedex
+{
+$classic = <<HERE;
+<h1>The Classic LaserKard.</h1>
+Balanced and Complete.  The original LaserKard.  For those that wish to leave no stone unturned.  It's all there.
+HERE
+$bold = <<HERE;
+<h1>The Bold Kard.</h1>
+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.
+HERE
+$arrow = <<HERE;
+<h1>The Arrow Kard.</h1>
+Precise and Straightforward.  For those that seek to make a statement while being clear and concise. Straight as an arrow.
+HERE
+$direct = <<HERE;
+<h1>The Direct Kard.</h1>
+Thorough and Distinct.  For those that aim to demonstrate their professionalism with style.  Push the envelope.  Be Direct.
+HERE
+my %megahash =
+(
+'big' => $bold,
+'basic' => $arrow,
+'lines' => $direct,
+'classic' => $classic,
+'big_acrylic_clear' => $bold,
+'classic_acrylic_clear' => $classic,
+'basic_acrylic_clear'  => $arrow,
+'lines_acrylic_clear' => $direct
+);
+my $key = shift;
+if (!$megahash{$key}){return $key;}
+return $megahash{$key};
+}
+# this here function makes the paypal button go away so people know it's working!
+sub vanish
+{
+return "";
+}
+1;

Mercurial > laserkard

comparison Laserkard.pm @ 51:95fa4bcc5d67 laserkard