annotate buy.pl @ 29:7742910e0479 laserkard

[svn r30] implemented drawing text on the picture dynamically. still need to center stuff
author rlm
date Sat, 16 Jan 2010 12:25:43 -0500
parents 5b5c03a850b9
children 0deeb2d5d1db
rev   line source
rlm@0 1 #!/usr/bin/perl
rlm@0 2
rlm@0 3
rlm@0 4 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
rlm@0 5 use Storable;
rlm@0 6 use CGI::Ajax;
rlm@0 7 use CGI;
rlm@0 8
rlm@0 9
rlm@0 10
rlm@0 11 my $q = new CGI;
rlm@0 12
rlm@0 13
rlm@0 14
rlm@0 15 my %hash = (
rlm@0 16
rlm@0 17 'material' => \&material,
rlm@2 18 'pokedex' => \&pokedex,
rlm@0 19 'template' => \&template,
rlm@0 20 'inputbox' => \&inputbox,
rlm@0 21 'display' => \&display,
rlm@23 22 'change_rules' => \&change_rules,
rlm@23 23 'vanish' => \&vanish
rlm@23 24 );
rlm@0 25
rlm@0 26
rlm@0 27
rlm@0 28 my $pjx = CGI::Ajax->new(%hash);
rlm@0 29 #$pjx->JSDEBUG(1);
rlm@0 30 #$pjx->DEBUG(1);
rlm@0 31
rlm@28 32 print $pjx->build_html($q,\&gen,{-Cache_Control => 'no-store, no-cache, must-revalidate', -Pragma => 'no-cache'}); # this outputs the html for the page
rlm@0 33
rlm@0 34
rlm@0 35
rlm@0 36
rlm@0 37
rlm@0 38 sub material{
rlm@0 39
rlm@0 40 $newvar = shift;
rlm@0 41
rlm@0 42 my $t = $newvar;
rlm@0 43
rlm@0 44 $newvar =~ m/([^_]*)_/;
rlm@0 45 $newvar = $1;
rlm@0 46
rlm@0 47 #return (($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked');
rlm@0 48
rlm@0 49 #$y = "$t<br>".(($t =~ m/_acrylic_green/) ? 'CHECKED' : 'notchecked')."
rlm@2 50
rlm@2 51 {
rlm@2 52 local( $/, *FH ) ;
rlm@2 53 open( FH, "<./buy_pieces/materials2.html" ) or die "sudden flaming death\n";
rlm@2 54 $y = <FH>;
rlm@2 55 }
rlm@2 56
rlm@2 57 @symbols = qw(PERL::ACRYLIC_CLEAR PERL::ACRYLIC_BLUE PERL::ACRYLIC_GREEN PERL::ALUMINUM_RED PERL::ALUMINUM_BLUE PERL::ALUMINUM_GREEN PERL::ALUMINUM_BLACK);
rlm@2 58
rlm@2 59 for (@symbols)
rlm@2 60 {
rlm@2 61 $c = $_;
rlm@2 62 $c =~ s/PERL:://;
rlm@2 63 $c =~ tr/[A-Z]/[a-z]/;
rlm@2 64 $c =~ s/^/_/;
rlm@2 65
rlm@2 66 $b = '"'.$newvar.$c.'"'.(($t =~ m/$c/) ? ' CHECKED ' : '');
rlm@2 67 $y =~ s/$_/$b/;
rlm@2 68 }
rlm@2 69
rlm@2 70
rlm@2 71 $first = shift;
rlm@2 72 if ($first){ $y =~ s/display[^;]*;//g; }
rlm@2 73
rlm@0 74
rlm@0 75
rlm@0 76 return $y;
rlm@0 77
rlm@0 78
rlm@0 79 }
rlm@0 80
rlm@0 81
rlm@0 82
rlm@0 83 sub template
rlm@0 84 {
rlm@0 85
rlm@0 86 $all = shift;
rlm@0 87 $all =~ m/_(.*)/;
rlm@0 88
rlm@0 89 $materialcolor = $1;
rlm@0 90
rlm@0 91
rlm@24 92 $r = "<div id = \"i_templates\"><titletron>Templates</titletron><br>
rlm@22 93
rlm@22 94 <input TYPE=\"image\" src = \"./images/templates/big_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__big\'],[\'pokedex\']);\" onclick=\"display([\'template2\'], [\'display\']); inputbox([\'template2\'], [\'inputbox\']);material([\'template2\'], [\'materials\']);\" ID=\"template2\" NAME=\"template2\" VALUE=\"big_$materialcolor\" > <br>
rlm@22 95
rlm@22 96 <input TYPE=\"image\" src = \"./images/templates/basic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__basic\'],['pokedex\']);\" onclick=\"display([\'template3\'], [\'display\']); inputbox([\'template3\'], [\'inputbox\']);material([\'template3\'], [\'materials\']);\" ID=\"template3\" NAME=\"template3\" VALUE=\"basic_$materialcolor\" ><br>
rlm@22 97
rlm@22 98 <input TYPE=\"image\" src = \"./images/templates/classic_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__classic\'],[\'pokedex\']);\" onclick=\"display([\'template1\'], [\'display\']); inputbox([\'template1\'], [\'inputbox\']);material([\'template1\'], [\'materials\']);\" ID=\"template1\" NAME=\"template1\" VALUE=\"classic_$materialcolor\" ><br>
rlm@22 99
rlm@22 100 <input TYPE=\"image\" src = \"./images/templates/lines_$materialcolor.jpg\" onmouseover=\"pokedex([\'args__lines\'],[\'pokedex\']);\" onclick=\"display([\'template4\'], [\'display\']); inputbox([\'template4\'], [\'inputbox\']);material([\'template4\'], [\'materials\']);\" ID=\"template4\" NAME=\"template4\" VALUE=\"lines_$materialcolor\" >
rlm@5 101 </div>
rlm@0 102
rlm@0 103 ";
rlm@0 104
rlm@0 105 return $r;
rlm@0 106 }
rlm@0 107
rlm@0 108
rlm@0 109
rlm@0 110
rlm@0 111 sub inputbox
rlm@0 112 {
rlm@0 113
rlm@0 114 #grab the type of template we'll be using <<<<
rlm@0 115 $type = shift;
rlm@0 116 # return $type;
rlm@0 117 # we have to care about both the type of template and the material and the color. these are stored in $type>>>>
rlm@0 118
rlm@0 119 #Then, update with a special custon paypal form, taken from the paypal folder and specially designed for that particular template.
rlm@0 120 #will probaly eventually create a script to automate the generation of these files.
rlm@0 121
rlm@0 122
rlm@0 123 #take care of everythign but acrylic clear type
rlm@2 124
rlm@2 125
rlm@2 126
rlm@2 127 {
rlm@2 128 local( $/, *FH ) ;
rlm@2 129 open( FH, "<./paypal/$type.paylist" ) or die "sudden flaming death\n";
rlm@2 130 $z = <FH>;
rlm@2 131 }
rlm@0 132
rlm@0 133
rlm@0 134 #every type has it's own associated paylist file the contains the things we need
rlm@2 135
rlm@23 136 $z = '<div id = "whatever" onmouseover='."\"pokedex([\'args__$type\'],[\'pokedex\']);\">".$z.'</div>';
rlm@2 137 return $z;
rlm@2 138
rlm@2 139
rlm@0 140
rlm@0 141
rlm@0 142
rlm@0 143 }
rlm@0 144
rlm@0 145
rlm@0 146
rlm@0 147
rlm@0 148
rlm@0 149
rlm@0 150
rlm@0 151
rlm@0 152 sub display
rlm@0 153 {
rlm@0 154 $all = shift;
rlm@0 155
rlm@0 156
rlm@0 157
rlm@24 158 $t = <<HERE;
rlm@29 159 <image src = "./images/display/PERL::PIC.jpg" onmouseover="pokedex(['args__PERL::PIC'],['pokedex']);">
rlm@29 160
rlm@29 161 <div id = overlay>
rlm@29 162
rlm@29 163
rlm@29 164 </div>
rlm@29 165
rlm@24 166 HERE
rlm@24 167
rlm@24 168
rlm@29 169
rlm@24 170 $t =~ s/PERL::PIC/$all/g;
rlm@24 171
rlm@29 172
rlm@24 173
rlm@0 174 return $t;
rlm@0 175
rlm@0 176 }
rlm@0 177
rlm@0 178
rlm@0 179
rlm@0 180
rlm@0 181 sub gen
rlm@0 182 {
rlm@0 183 {
rlm@0 184 local( $/, *FH ) ;
rlm@0 185 open( FH, "<./buy.html" ) or die "sudden flaming death\n";
rlm@0 186 $a = <FH>;
rlm@0 187 }
rlm@0 188
rlm@0 189 {
rlm@0 190 local( $/, *FH ) ;
rlm@0 191 open( FH, "<./top_menu.include" ) or die "sudden flaming death\n";
rlm@0 192 $b = <FH>;
rlm@0 193 }
rlm@0 194
rlm@2 195
rlm@2 196
rlm@2 197 $a =~ s/PERL-REPLACE::TOP_MENU/$b/; #equivalent to <?php include("top_menu.html"); ?>, but in perl and with more memory problems :)
rlm@2 198 $b = &material("void_acrylic_clear",1);
rlm@2 199 $a =~ s/PERL-REPLACE::MATERIALS/$b/; #let's do it again!!! :)
rlm@22 200 $b = &template("big_acrylic_clear");
rlm@2 201
rlm@16 202 #$a =~ s/PERL-REPLACE::TEMPLATES//;
rlm@16 203 $a =~ s/PERL-REPLACE::TEMPLATES/$b/; #comment out one or the other!
rlm@2 204
rlm@22 205 $b = &display("big_acrylic_clear");
rlm@22 206 $a =~ s/PERL-REPLACE::DISPLAY/$b/;
rlm@22 207
rlm@22 208 $b = &inputbox("big_acrylic_clear");
rlm@22 209 $a =~ s/PERL-REPLACE::INPUTBOX/$b/;
rlm@2 210
rlm@24 211 $b = &pokedex('big');
rlm@24 212 $a =~ s/PERL-REPLACE::POKEDEX/$b/;
rlm@24 213
rlm@0 214
rlm@0 215 return $a
rlm@0 216
rlm@0 217
rlm@2 218 }
rlm@0 219
rlm@0 220
rlm@2 221
rlm@2 222 sub pokedex
rlm@2 223 {
rlm@2 224
rlm@24 225
rlm@24 226 $classic = <<HERE;
rlm@24 227 <h1>The Classic LaserKard.</h1>
rlm@24 228 Balanced and Complete. The original LaserKard. For those that wish to leave no stone unturned. It's all there.
rlm@24 229 HERE
rlm@24 230
rlm@24 231 $bold = <<HERE;
rlm@24 232 <h1>The Bold Kard.</h1>
rlm@24 233 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.
rlm@24 234 HERE
rlm@24 235
rlm@24 236 $arrow = <<HERE;
rlm@24 237 <h1>The Arrow Kard.</h1>
rlm@24 238 Precise and Straightforward. For those that seek to make a statement while being clear and concise. Straight as an arrow.
rlm@24 239 HERE
rlm@24 240
rlm@24 241 $direct = <<HERE;
rlm@24 242 <h1>The Direct Kard.</h1>
rlm@24 243 Thorough and Distinct. For those that aim to demonstrate their professionalism with style. Push the envelope. Be Direct.
rlm@24 244 HERE
rlm@24 245
rlm@24 246
rlm@24 247
rlm@24 248 my %megahash =
rlm@24 249 (
rlm@24 250
rlm@24 251 'big' => $bold,
rlm@24 252
rlm@24 253 'basic' => $arrow,
rlm@24 254
rlm@24 255 'lines' => $direct,
rlm@24 256
rlm@24 257 'classic' => $classic,
rlm@24 258
rlm@24 259 'big_acrylic_clear' => $bold,
rlm@24 260
rlm@24 261 'classic_acrylic_clear' => $classic,
rlm@24 262
rlm@24 263 'basic_acrylic_clear' => $arrow,
rlm@24 264
rlm@24 265 'lines_acrylic_clear' => $direct
rlm@24 266 );
rlm@24 267
rlm@24 268
rlm@24 269
rlm@2 270 my $key = shift;
rlm@2 271
rlm@24 272
rlm@24 273 if (!$megahash{$key}){return $key;}
rlm@24 274
rlm@24 275 return $megahash{$key};
rlm@24 276
rlm@24 277
rlm@2 278
rlm@2 279
rlm@2 280 }
rlm@23 281
rlm@23 282
rlm@23 283
rlm@23 284
rlm@23 285
rlm@23 286
rlm@23 287
rlm@23 288
rlm@23 289 # this here function makes the paypal button go away so people know it's working!
rlm@23 290 sub vanish
rlm@23 291 {
rlm@24 292 return "";
rlm@23 293
rlm@23 294
rlm@23 295 }
rlm@23 296