Mercurial > laserkard

annotate sex_again.pl @ 106:5b0753c6f34d laserkard tip

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
updated to newest compojure and a simpler syntax
author Robert McIntyre <rlm@mit.edu>
date Mon, 27 Sep 2010 20:22:58 -0400
parents 8b3b5753ad41
children
rev   line source
rlm@39 1 #!/usr/bin/perl
rlm@39 2
rlm@39 3
rlm@39 4
rlm@39 5
rlm@39 6
rlm@39 7 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
rlm@39 8 use Storable;
rlm@39 9 use CGI::Ajax;
rlm@39 10 use CGI qw(:standard);
rlm@39 11 use URI::Escape;
rlm@39 12 use MIME::QuotedPrint;
rlm@39 13 use MIME::Base64;
rlm@39 14 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
rlm@39 15 use XML::Simple;
rlm@39 16 use Data::Dumper;
rlm@39 17 $Data::Dumper::Indent = 1;
rlm@39 18 use Storable;
rlm@39 19 use SVG;
rlm@39 20
rlm@39 21
rlm@39 22 $ref = retrieve('file');
rlm@39 23
rlm@39 24 #print Dumper $$ref;
rlm@39 25 &echo($$ref);
rlm@39 26 #&impose($$ref);
rlm@39 27
rlm@39 28
rlm@39 29
rlm@39 30
rlm@39 31 sub impose
rlm@39 32 {
rlm@39 33
rlm@39 34 #here $svg is a string which contains the properly formatted svg data for one card
rlm@39 35 #out purpose here is to take that one card, size it correctly, and make appropiate copies
rlm@39 36 #so that our supplier can simply import the file and print.
rlm@39 37
rlm@39 38 $sss = $_[0];
rlm@39 39 $sss =~ s/^/\n\n\n/;
rlm@39 40 $sss =~ s/$/\n\n\n/;
rlm@39 41 # you fucking bitch!
rlm@39 42 $sss =~ s/Created wit........//;
rlm@39 43
rlm@39 44
rlm@39 45 # read XML file
rlm@39 46 my $xml = new XML::Simple;
rlm@39 47 my $data = $xml->XMLin($sss, ForceArray => 1);
rlm@39 48
rlm@39 49
rlm@39 50 my %data = %$data;
rlm@39 51
rlm@39 52 my %juzz =
rlm@39 53 (
rlm@39 54
rlm@39 55 path => $data{'path'},
rlm@39 56 rect => $data{'rect'},
rlm@39 57 width =>"16in" ,
rlm@39 58 height =>"12in" ,
rlm@39 59 version =>"1.1",
rlm@39 60 xmlns =>"http://www.w3.org/2000/svg"
rlm@39 61
rlm@39 62 );
rlm@39 63
rlm@39 64
rlm@39 65
rlm@39 66
rlm@39 67 #print Dumper(%juzz);
rlm@39 68
rlm@39 69
rlm@39 70 my $svg= SVG->new(width=>"18in",height=>"12in");
rlm@39 71
rlm@39 72 #print Dumper($juzz{'path'}[2]);
rlm@39 73 print "\n***************************\n";
rlm@39 74 #print Dumper($pathData);
rlm@39 75
rlm@39 76
rlm@39 77
rlm@39 78
rlm@39 79 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
rlm@39 80
rlm@39 81
rlm@39 82 my @cardCollection;
rlm@39 83
rlm@39 84 for $name(0..21) #22 letters for 22 cards
rlm@39 85 {
rlm@39 86
rlm@39 87 #calcuate the thing's place in the grid:
rlm@39 88
rlm@39 89 $cardsToARow = 5;
rlm@39 90 $cardsToAColumn = 5;
rlm@39 91
rlm@39 92 my $row = int($name/$cardsToARow); # cards to a row
rlm@39 93 my $column = int($name % $cardsToAColumn);
rlm@39 94
rlm@39 95 $margin = 25;
rlm@39 96 $cardWidth = 514*0.6057;
rlm@39 97 $cardHeight = 317*0.6057;
rlm@39 98
rlm@39 99
rlm@39 100 $transX = 40 + ($margin + $cardWidth ) * $column;
rlm@39 101 $transY = 40 + ($margin + $cardHeight) * $row;
rlm@39 102
rlm@39 103
rlm@39 104
rlm@39 105 ${"group_".$name} =
rlm@39 106 $svg->group(
rlm@39 107 id => "group_".$name,
rlm@39 108 transform => "translate($transX,$transY),"."$base"
rlm@39 109 );
rlm@39 110
rlm@39 111 push @cardCollection, ${"group_".$name};
rlm@39 112 }
rlm@39 113
rlm@39 114
rlm@39 115
rlm@39 116
rlm@39 117 #my $y=$svg->group(
rlm@39 118 # id => 'group_y' );
rlm@39 119 #
rlm@39 120 #my $f=$svg->group(
rlm@39 121 # id => 'group_f' ,
rlm@39 122 # transform => "$base"
rlm@39 123 #
rlm@39 124 # );
rlm@39 125 #
rlm@39 126 #
rlm@39 127
rlm@39 128
rlm@39 129
rlm@39 130
rlm@39 131
rlm@39 132
rlm@39 133 for ($i = 0; $i <= $#cardCollection; $i++)
rlm@39 134 {
rlm@39 135
rlm@39 136 for $pathData(@{$juzz{'path'}})
rlm@39 137 {
rlm@39 138 $cardCollection[$i]->tag('path', %{$pathData});
rlm@39 139 }
rlm@39 140
rlm@39 141 for $pathData(@{$juzz{'rect'}})
rlm@39 142 {
rlm@39 143 $cardCollection[$i]->tag('rect', %{$pathData});
rlm@39 144 }
rlm@39 145
rlm@39 146
rlm@39 147 }
rlm@39 148
rlm@39 149
rlm@39 150
rlm@39 151 #my $tag = $svg->tag('path', $juzz{'path'});
rlm@39 152
rlm@39 153
rlm@39 154 #$tag = $svg->group(%attributes);
rlm@39 155
rlm@39 156
rlm@39 157 $output = $svg->xmlify;
rlm@39 158
rlm@39 159
rlm@39 160 $killCopyrigt = <<HERE;
rlm@39 161 <!--
rlm@39 162 Generated using the Perl SVG Module V2.49
rlm@39 163 by Ronan Oger
rlm@39 164 Info: http://www.roitsystems.com/
rlm@39 165 -->
rlm@39 166 HERE
rlm@39 167
rlm@39 168 $output =~ s/$killCopyrigt/\n/;
rlm@39 169
rlm@39 170 return $output;
rlm@39 171
rlm@39 172
rlm@39 173
rlm@39 174 }
rlm@39 175
rlm@39 176
rlm@39 177
rlm@39 178
rlm@39 179
rlm@39 180
rlm@39 181
rlm@39 182
rlm@39 183
rlm@39 184
rlm@39 185
rlm@39 186
rlm@39 187 sub echo
rlm@39 188 {
rlm@39 189
rlm@39 190
rlm@39 191 my $svg = $_[0];
rlm@39 192
rlm@39 193 my $destination = 'rlm@mit.edu';
rlm@39 194 #~ $svg =~ s/</\&lt\;/g;
rlm@39 195 #~ return $svg;
rlm@39 196
rlm@39 197
rlm@39 198 #$svg = &repair_file($svg);
rlm@39 199
rlm@39 200 $svg = &impose($svg);
rlm@39 201
rlm@39 202
rlm@39 203 #print $svg;
rlm@39 204 open OUT, '>C:/Documents and Settings/Robert McIntyre/Desktop/perlOut.svg';
rlm@39 205 select OUT;
rlm@39 206 print $svg;
rlm@39 207 close OUT;
rlm@39 208
rlm@39 209 #&mail($svg, $destination);
rlm@39 210
rlm@39 211 return "done.";
rlm@39 212
rlm@39 213 }
rlm@39 214
rlm@39 215
rlm@39 216
rlm@39 217
rlm@39 218
rlm@39 219
rlm@39 220 sub repair_file
rlm@39 221 {
rlm@39 222
rlm@39 223
rlm@39 224 $sss = $_[0];
rlm@39 225
rlm@39 226
rlm@39 227
rlm@39 228 $sss =~ s/^/\n\n\n/;
rlm@39 229 $sss =~ s/$/\n\n\n/;
rlm@39 230 # you fucking bitch.
rlm@39 231 $sss =~ s/Created wit........//;
rlm@39 232
rlm@39 233
rlm@39 234 store \$sss, 'file';
rlm@39 235
rlm@39 236 # read XML file
rlm@39 237 my $xml = new XML::Simple;
rlm@39 238 my $data = $xml->XMLin($sss, ForceArray => 1);
rlm@39 239
rlm@39 240
rlm@39 241 my %data = %$data;
rlm@39 242
rlm@39 243 my %juzz =
rlm@39 244 (
rlm@39 245
rlm@39 246 path => $data{'path'},
rlm@39 247 rect => $data{'rect'},
rlm@39 248 width =>"16in" ,
rlm@39 249 height =>"12in" ,
rlm@39 250 version =>"1.1",
rlm@39 251 xmlns =>"http://www.w3.org/2000/svg"
rlm@39 252
rlm@39 253 );
rlm@39 254
rlm@39 255
rlm@39 256 $out = $xml->XMLout(\%juzz , RootName=>'svg');
rlm@39 257
rlm@39 258
rlm@39 259 my $fixed = <<HERE;
rlm@39 260 <?xml version="1.0" standalone="no"?>
rlm@39 261 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
rlm@39 262 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
rlm@39 263 HERE
rlm@39 264
rlm@39 265
rlm@39 266
rlm@39 267 $fixed .= $out;
rlm@39 268
rlm@39 269 #print $fixed;
rlm@39 270 return $fixed;
rlm@39 271
rlm@39 272 }
rlm@39 273
rlm@39 274
rlm@39 275
rlm@39 276
rlm@39 277
rlm@39 278
rlm@39 279
rlm@39 280
rlm@39 281
rlm@39 282
rlm@39 283
rlm@39 284
rlm@39 285
rlm@39 286
rlm@39 287
rlm@39 288
rlm@39 289
rlm@39 290
rlm@39 291