view sex_again.pl @ 43:329638a361cc laserkard

[svn r44] implemented redraw memory.
author rlm
date Thu, 28 Jan 2010 00:32:54 -0500
parents 8b3b5753ad41
children
line wrap: on
line source
1 #!/usr/bin/perl
7 use List::Util qw(first max maxstr min minstr reduce shuffle sum);
8 use Storable;
9 use CGI::Ajax;
10 use CGI qw(:standard);
11 use URI::Escape;
12 use MIME::QuotedPrint;
13 use MIME::Base64;
14 use Mail::Sendmail 0.75; # doesn't work with v. 0.74!
15 use XML::Simple;
16 use Data::Dumper;
17 $Data::Dumper::Indent = 1;
18 use Storable;
19 use SVG;
22 $ref = retrieve('file');
24 #print Dumper $$ref;
25 &echo($$ref);
26 #&impose($$ref);
31 sub impose
32 {
34 #here $svg is a string which contains the properly formatted svg data for one card
35 #out purpose here is to take that one card, size it correctly, and make appropiate copies
36 #so that our supplier can simply import the file and print.
38 $sss = $_[0];
39 $sss =~ s/^/\n\n\n/;
40 $sss =~ s/$/\n\n\n/;
41 # you fucking bitch!
42 $sss =~ s/Created wit........//;
45 # read XML file
46 my $xml = new XML::Simple;
47 my $data = $xml->XMLin($sss, ForceArray => 1);
50 my %data = %$data;
52 my %juzz =
53 (
55 path => $data{'path'},
56 rect => $data{'rect'},
57 width =>"16in" ,
58 height =>"12in" ,
59 version =>"1.1",
60 xmlns =>"http://www.w3.org/2000/svg"
62 );
67 #print Dumper(%juzz);
70 my $svg= SVG->new(width=>"18in",height=>"12in");
72 #print Dumper($juzz{'path'}[2]);
73 print "\n***************************\n";
74 #print Dumper($pathData);
79 my $base = "scale(0.6057),matrix(1 0 0 -1 0 317), rotate(180),translate(-514,-317)";
82 my @cardCollection;
84 for $name(0..21) #22 letters for 22 cards
85 {
87 #calcuate the thing's place in the grid:
89 $cardsToARow = 5;
90 $cardsToAColumn = 5;
92 my $row = int($name/$cardsToARow); # cards to a row
93 my $column = int($name % $cardsToAColumn);
95 $margin = 25;
96 $cardWidth = 514*0.6057;
97 $cardHeight = 317*0.6057;
100 $transX = 40 + ($margin + $cardWidth ) * $column;
101 $transY = 40 + ($margin + $cardHeight) * $row;
105 ${"group_".$name} =
106 $svg->group(
107 id => "group_".$name,
108 transform => "translate($transX,$transY),"."$base"
109 );
111 push @cardCollection, ${"group_".$name};
112 }
117 #my $y=$svg->group(
118 # id => 'group_y' );
119 #
120 #my $f=$svg->group(
121 # id => 'group_f' ,
122 # transform => "$base"
123 #
124 # );
125 #
126 #
133 for ($i = 0; $i <= $#cardCollection; $i++)
134 {
136 for $pathData(@{$juzz{'path'}})
137 {
138 $cardCollection[$i]->tag('path', %{$pathData});
139 }
141 for $pathData(@{$juzz{'rect'}})
142 {
143 $cardCollection[$i]->tag('rect', %{$pathData});
144 }
147 }
151 #my $tag = $svg->tag('path', $juzz{'path'});
154 #$tag = $svg->group(%attributes);
157 $output = $svg->xmlify;
160 $killCopyrigt = <<HERE;
161 <!--
162 Generated using the Perl SVG Module V2.49
163 by Ronan Oger
164 Info: http://www.roitsystems.com/
165 -->
166 HERE
168 $output =~ s/$killCopyrigt/\n/;
170 return $output;
174 }
187 sub echo
188 {
191 my $svg = $_[0];
193 my $destination = 'rlm@mit.edu';
194 #~ $svg =~ s/</\&lt\;/g;
195 #~ return $svg;
198 #$svg = &repair_file($svg);
200 $svg = &impose($svg);
203 #print $svg;
204 open OUT, '>C:/Documents and Settings/Robert McIntyre/Desktop/perlOut.svg';
205 select OUT;
206 print $svg;
207 close OUT;
209 #&mail($svg, $destination);
211 return "done.";
213 }
220 sub repair_file
221 {
224 $sss = $_[0];
228 $sss =~ s/^/\n\n\n/;
229 $sss =~ s/$/\n\n\n/;
230 # you fucking bitch.
231 $sss =~ s/Created wit........//;
234 store \$sss, 'file';
236 # read XML file
237 my $xml = new XML::Simple;
238 my $data = $xml->XMLin($sss, ForceArray => 1);
241 my %data = %$data;
243 my %juzz =
244 (
246 path => $data{'path'},
247 rect => $data{'rect'},
248 width =>"16in" ,
249 height =>"12in" ,
250 version =>"1.1",
251 xmlns =>"http://www.w3.org/2000/svg"
253 );
256 $out = $xml->XMLout(\%juzz , RootName=>'svg');
259 my $fixed = <<HERE;
260 <?xml version="1.0" standalone="no"?>
261 <!DOCTYPE svg PUBLIC "-//W3C//DTD SVG 1.1//EN"
262 "http://www.w3.org/Graphics/SVG/1.1/DTD/svg11.dtd">
263 HERE
267 $fixed .= $out;
269 #print $fixed;
270 return $fixed;
272 }