dorward / subsector

Software for doing things with Traveller Subsectors including SVG map generation

This URL has Read+Write access

subsector / generate_subsector.pl
raw normal view history
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 1 #!/usr/bin/perl
2 use strict;
3 use warnings;
4 use XML::LibXML;
5 use Carp;
79b41021 » dorward 2009-01-03 Small tidy ups 6 use Games::Traveller::UWP;
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 7
8 my $svgns = "http://www.w3.org/2000/svg";
9 my $xlinkns = "http://www.w3.org/1999/xlink";
10
11 # This is rough, ready and experimental!
12
13 # I'm learning SVG as I go, and feeling my way through this on the way
14 # Expect proper OO et al LATER.
15
ad56d983 » David Dorward 2008-12-26 Add notes 16 # TODO
17 # * Moose
79b41021 » dorward 2009-01-03 Small tidy ups 18
34e3da91 » dorward 2009-01-19 Make a start on reading wor... 19 ###########
20 # Load systems
21 use Data::Dumper;
22 my @system_data = ();
23
24 while (my $line = <STDIN>) {
25 chomp $line;
26 my $uwp = Games::Traveller::UWP->new();
27 $uwp->readUwp( $line );
28 if (defined $uwp->name()) {
29 my $col = $uwp->col();
30 my $row = $uwp->row();
31 unless (defined $system_data[$col]) {
32 $system_data[$col] = [];
33 }
34 $system_data[$col][$row] = $uwp;
35 }
36 if ($uwp->bases) {
37 print Dumper $uwp->bases;
38 print "\n";
39 }
40 }
41 exit();
42 # Done loading subsectors
43 ###########
79b41021 » dorward 2009-01-03 Small tidy ups 44
ad56d983 » David Dorward 2008-12-26 Add notes 45
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 46 my $doc = XML::LibXML->createDocument();
47 $doc->setStandalone(1);
48
49 my %root_attributes = (
a954801a » David Dorward 2008-12-24 Add planets 50 width => "744.09448", #"230mm",
51 height => "1052.3622", #"190mm",
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 52 viewBox => "0 0 3000 5255",
6c55847a » dorward 2008-12-28 Test tweaks needed to gener... 53 # For sectors viewBox => "0 0 12000 " . (5255 * 4),
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 54 );
55 my $root = $doc->createElementNS($svgns, 'svg');
56 for my $key (keys %root_attributes) {
57 my $value = $root_attributes{$key};
58 $root->setAttribute($key, $value);
59 }
60 $doc->setDocumentElement($root);
61
c8460469 » dorward 2008-12-28 Add Pirate Base symbol 62 my $pirate_path = q(M 4.29973999999993,53.46646 C 0,51.96806 1.53786000000002,49.82682 8.79973999999993,47.2009 C 12.64974,45.80872 15.7997399999999,43.92422 15.7997399999999,43.0131 C 15.7997399999999,40.96064 10.74334,38.92858 5.63616000000002,38.92858 C 3.52613999999994,38.92858 1.79973999999993,37.57858 1.79973999999993,35.92858 C 1.79973999999993,34.27858 3.14973999999995,32.92858 4.79973999999993,32.92858 C 6.44974000000002,32.92858 7.79973999999993,33.7194 7.79973999999993,34.68594 C 7.79973999999993,35.65248 10.4795399999999,37.5533 13.7548399999999,38.90998 C 18.95418,41.06362 20.6433999999999,40.8259 27.06528,37.0368999999999 C 32.88212,33.6049 34.76242,33.24428 36.05468,35.31286 C 37.232,37.19748 35.74772,38.40336 30.7442199999999,39.62726 C 21.87884,41.7958 21.99072,43.61438 31.2601599999999,48.01302 C 37.5092999999999,50.97844 38.11272,51.76644 34.97668,52.86652 C 32.47766,53.74312 29.69472,52.64174 26.60716,49.5542 C 20.76584,43.71286 17.56146,43.72968 11.57246,49.63312 C 8.94745999999998,52.2206199999999 5.67473999999993,53.94562 4.29973999999993,53.46646 z M 14.41354,29.60716 C 11.72802,27.5035799999999 7.27328,16.6355599999999 6.97442000000001,10.5750399999999 L 7.10353999999995,10.11074 C 9.07164,3.56769999999995 16.6545599999999,0 19.17274,0 C 24.3481399999999,0 30.01402,4.07431999999994 30.90688,10.38482 C 31.7480399999999,16.97132 28.38392,23.9756199999999 24.5642399999999,29.6951 C 23.48378,31.31298 22.22482,32.71794 19.7097199999999,32.92858 C 19.0001999999999,32.92858 16.02764,31.53216 14.41354,29.60716 z M 17.7997399999999,15.92858 C 17.7997399999999,14.27858 16.44974,12.92858 14.7997399999999,12.92858 C 13.14974,12.92858 11.7997399999999,14.27858 11.7997399999999,15.92858 C 11.7997399999999,17.57858 13.14974,18.92858 14.7997399999999,18.92858 C 16.44974,18.92858 17.7997399999999,17.57858 17.7997399999999,15.92858 z M 27.7997399999999,15.92858 C 27.7997399999999,14.27858 26.44974,12.92858 24.7997399999999,12.92858 C 23.14974,12.92858 21.7997399999999,14.27858 21.7997399999999,15.92858 C 21.7997399999999,17.57858 23.14974,18.92858 24.7997399999999,18.92858 C 26.44974,18.92858 27.7997399999999,17.57858 27.7997399999999,15.92858 z);
79b41021 » dorward 2009-01-03 Small tidy ups 63 my $research_path = q(M 48.0872856321839,7.21387987012987 L 40.7327586206897,7.21387987012987 L 36.4897626436782,29.4490668831169 C 36.0856333333333,31.7015188311688 35.7825626436782,33.5278162337662 35.5805494252874,34.927962987013 C 35.378467816092,36.3281376623377 35.2774442528736,37.3630396103896 35.2774781609195,38.0326707792208 C 35.2774442528736,39.798101948052 35.5939850574713,41.0536811688312 36.2271011494253,41.7994116883117 C 36.8601477011494,42.5451564935065 37.9175281609195,42.918025974026 39.3992454022988,42.9180194805195 C 39.8571810344828,42.918025974026 40.3959735632184,42.8799779220779 41.0156247126437,42.803875974026 C 41.6351965517241,42.7277863636364 42.4433856321839,42.6136428571429 43.4401936781609,42.4614448051948 L 42.2279091954023,48.8991480519481 C 41.4196798850575,49.1426538961039 40.6451655172414,49.3252837662338 39.9043643678161,49.4470376623377 C 39.1634856321839,49.5687902597403 38.4428505747126,49.6296668831169 37.7424568965517,49.6296675324675 C 34.5635442528736,49.6296668831169 32.1591821839081,48.8534902597403 30.5293643678161,47.3011363636364 C 28.8994873563218,45.7487857142857 28.0845637931034,43.4506954545454 28.0845902298851,40.4068590909091 C 28.0845637931034,39.0067064935065 28.2259965517241,37.210848051948 28.5088902298851,35.0192779220779 C 28.7917287356322,32.8277357142857 29.3911356321839,29.281675974026 30.3071120689655,24.3810876623377 L 33.5398706896552,7.21387987012987 L 20.3663793103448,7.21387987012987 L 12.5269396551724,48.8991480519481 L 5.21282298850575,48.8991480519481 L 13.0926724137931,7.21387987012987 L 11.4358833333333,7.21387987012987 C 9.98113333333333,7.21392207792208 8.84966896551724,7.70093441558441 8.0414867816092,8.67491883116883 C 7.23329137931035,9.64898441558442 6.7079683908046,11.1861175324675 6.46551724137931,13.2863233766234 L 0,13.2863233766234 C 0.75431091954023,8.2336038961039 2.09455747126437,4.75603051948052 4.02074367816092,2.85359220779221 C 5.94692413793103,0.951245454545455 9.13253505747127,4.93506493506266e-05 13.5775862068966,0 L 49.5016189655172,0 L 48.0872856321839,7.21387987012987 z);
c8460469 » dorward 2008-12-28 Add Pirate Base symbol 64
65
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 66 my $style_text = qq(
67 .hex {
68 fill: white;
69 stroke: #000;
70 stroke-width: 5px;
71 stroke-linejoin: miter
72 }
73 .coords {
74 fill: #666;
32a50249 » David Dorward 2008-12-26 Add starport 75 stroke: none;
76 }
77 text {
78 fill: #000;
92ebfec0 » David Dorward 2008-12-26 System name and font styling 79 stroke: none;
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 80 font-family: helvetica, arial;
81 font-size: 85px;
82 text-anchor: middle;
83 }
92ebfec0 » David Dorward 2008-12-26 System name and font styling 84 .systemName {
85 stroke: #fff;
86 stroke-width: 1px;
87 font-weight: bold;
88 font-family: deja vu sans, verdana;
89 }
a954801a » David Dorward 2008-12-24 Add planets 90 .planet {
91 fill: #000;
92 stroke: none;
93 }
b76cb6e2 » David Dorward 2008-12-24 Add gas giant 94 .travel_zone,
95 .ring {
96 fill: none;
85bd15a7 » David Dorward 2008-12-24 New feature: travel zones 97 stroke: #000;
98 stroke-width: 3px;
99 }
100 .travel_zone.red {
101 fill: #ddd;
102 }
9c61c473 » David Dorward 2008-12-26 Add naval base 103 .base {
3f62e54a » David Dorward 2008-12-24 New feature: Scout station 104 fill: #000;
9c61c473 » David Dorward 2008-12-26 Add naval base 105 stroke: #fff;
106 stroke-width: 3px;
3f62e54a » David Dorward 2008-12-24 New feature: Scout station 107 }
74498bef » David Dorward 2008-12-26 Add TAS base 108 .TAS circle {
109 fill: #fff;
110 stroke: none;
111 }
112 .TAS polygon {
113 fill: #000;
114 stroke: #fff;
115 stroke-width: 3px;
116 }
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 117 );
118 my $style = $doc->createElementNS($svgns, 'style');
119 $style->setAttribute('type', 'text/css');
120 my $style_text_node = $doc->createTextNode($style_text);
121 $style->appendChild($style_text_node);
122 $root->appendChild($style);
123
124 my @systems = ();
125 for (1..10) {
126 $systems[$_] = ();
127 }
128
6c55847a » dorward 2008-12-28 Test tweaks needed to gener... 129 # For subsectors
c2f3fcc3 » David Dorward 2008-12-24 Make SVG a little more verb... 130 for my $col (1..10) {
131 for my $row (1..8) {
6c55847a » dorward 2008-12-28 Test tweaks needed to gener... 132
34e3da91 » dorward 2009-01-19 Make a start on reading wor... 133 my $uwp;
134 if ($system_data[$col] && $system_data[$col][$row]) {
135 $uwp = $system_data[$col][$row];
136 }
137
6c55847a » dorward 2008-12-28 Test tweaks needed to gener... 138 ## For sectors
139 #for my $col (1..40) {
140 # for my $row (1..32) {
141
34e3da91 » dorward 2009-01-19 Make a start on reading wor... 142 my $hex = createHex($col,$row, $uwp);
c2f3fcc3 » David Dorward 2008-12-24 Make SVG a little more verb... 143 $root->appendChild($hex);
144 }
145 }
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 146
147
c8460469 » dorward 2008-12-28 Add Pirate Base symbol 148 print $doc->toString(2);
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 149
150 sub createHex {
34e3da91 » dorward 2009-01-19 Make a start on reading wor... 151 my ($row, $col, $uwp) = @_;
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 152 my $id = sprintf("hex-%02d%02d", $col, $row);
153 my $hex = $doc->createElementNS($svgns, 'svg');
154 $hex->setAttribute('id', $id);
34e3da91 » dorward 2009-01-19 Make a start on reading wor... 155 my $x_shift = 350 * ($col - 1);
156 my $y_shift = 500 * ($row - 1);
c2f3fcc3 » David Dorward 2008-12-24 Make SVG a little more verb... 157 unless ($col % 2) {
158 $y_shift = $y_shift + 250;
159 }
160 $hex->setAttribute('x', $x_shift);
161 $hex->setAttribute('y', $y_shift);
a954801a » David Dorward 2008-12-24 Add planets 162
34e3da91 » dorward 2009-01-19 Make a start on reading wor... 163 my $hex_line = createHexLine();
164
165 $hex->appendChild($hex_line);
166
167 if (my $zone = $uwp->zone) {
168 $hex->appendChild(createTravelZone( ($zone eq "A") ? 'amber' : 'red'));
169 }
170
171 my $hex_label = createHexLabel($col, $row);
172 $hex->appendChild($hex_label);
173
174 $hex->appendChild(createPlanet());
175 # TODO - find out how to represent gas giants
176 #$hex->appendChild(createGasGiant());
177 $hex->appendChild(createScoutBase());
178 $hex->appendChild(createNavalBase());
179 $hex->appendChild(createImperialConsulateBase());
180 $hex->appendChild(createTASBase());
181 $hex->appendChild(createPirateBase());
182 $hex->appendChild(createResearchBase());
183 $hex->appendChild(createStarport('B'));
184 $hex->appendChild(createSystemName('Sol'));
4ed934fc » David Dorward 2008-12-26 Add Imperial Consulate 185
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 186 return $hex;
187 }
188
189 sub createHexLine {
190 my $hex_line;
c2f3fcc3 » David Dorward 2008-12-24 Make SVG a little more verb... 191 $hex_line = $doc->createElementNS($svgns, 'polygon');
192 $hex_line->setAttribute('class', 'hex');
193 $hex_line->setAttribute('points', '150,0 350,0 500,250 350,500 150,500 0,250');
a813b9e5 » David Dorward 2008-12-23 Generate use element properly 194 return $hex_line;
195 }
196
c2f3fcc3 » David Dorward 2008-12-24 Make SVG a little more verb... 197 sub createHexLabel {
198 my $col = shift;
199 my $row = shift;
200 my %attributes = (x => 250, y => 90, class => 'coords');
201 my $text = createSvgElement('text', %attributes);
202 my $tNode = $doc->createTextNode(sprintf("%02d%02d", $col, $row));
203 $text->appendChild($tNode);
204 return $text;
205 }
206
a954801a » David Dorward 2008-12-24 Add planets 207 sub createPlanet {
208 return createSvgElement('circle', cx => 250, cy => 250, r => 25, class => 'planet');
209 }
210
211 sub createTravelZone {
212 my $zone_type = shift;
85bd15a7 » David Dorward 2008-12-24 New feature: travel zones 213 return createSvgElement('circle', cx => 250, cy => 250, r => 150, class => "travel_zone $zone_type");
a954801a » David Dorward 2008-12-24 Add planets 214 }
215
216
c2f3fcc3 » David Dorward 2008-12-24 Make SVG a little more verb... 217 sub createSvgElement {
218 my $name = shift;
219 my %attributes = @_;
220 my $element = $doc->createElementNS($svgns, $name);
221 for my $key (keys %attributes) {
222 $element->setAttribute($key, $attributes{$key});
223 }
224 return $element;
225 }
226
3f62e54a » David Dorward 2008-12-24 New feature: Scout station 227
9c61c473 » David Dorward 2008-12-26 Add naval base 228 sub createScoutBase {
7e81aa01 » dorward 2008-12-28 Refactor scout base 229 my $container = createSvgElement('svg', x => 80, y => 175, height => 70, width => 70, class => "scout base");
230 $container->appendChild(createTitle('Scout base'));
231 my $s = createSvgElement('polygon', 'points' => '0,40 50,40 25,0');
232 $container->appendChild($s);
233 return $container;
3f62e54a » David Dorward 2008-12-24 New feature: Scout station 234 }
235
b76cb6e2 » David Dorward 2008-12-24 Add gas giant 236 sub createGasGiant {
237 my $container = createSvgElement('svg', x => 300, y => 100, height => 70, width => 70);
3e02367c » dorward 2008-12-28 Add more titles 238 $container->appendChild(createTitle('Gas giant'));
b76cb6e2 » David Dorward 2008-12-24 Add gas giant 239 my $e = createSvgElement('ellipse', cx => 35, cy => 35, rx => 35, ry => 12, class => 'ring',
240 transform => "rotate(-22 35 35)") ;
241 my $p = createSvgElement('circle', cx => 35, cy => 35, r => 20, class => 'planet');
242 $container->appendChild($e);
243 $container->appendChild($p);
244 return $container;
245 }
246
9c61c473 » David Dorward 2008-12-26 Add naval base 247 sub createNavalBase {
248 my $container = createSvgElement('svg', x => 145, y => 100, height => 50, width => 50);
3e02367c » dorward 2008-12-28 Add more titles 249 $container->appendChild(createTitle('Naval base'));
9c61c473 » David Dorward 2008-12-26 Add naval base 250 my $s = createSvgElement('polygon', class => 'naval base', points => '25,0 31.09,18.07 50,18.07 34.87,29.41 40.34,47.48 25,36.76 9.66,47.48 15.13,29.41 0,18.07 18.91,18.07');
251 $container->appendChild($s);
252 return $container;
253 }
254
4ed934fc » David Dorward 2008-12-26 Add Imperial Consulate 255 sub createImperialConsulateBase {
4892555d » dorward 2008-12-28 Refactor Imperial Consulate 256 my $container = createSvgElement('svg', x => 90, y => 290, height => 50, width => 50, class => "imperialConsulate base");
257 $container->appendChild(createTitle('Imperial Consulate base'));
258 my $s = createSvgElement('rect', class => 'imperialConsulate base', x => 5, y => 5, height => 40, width => 40);
259 $container->appendChild($s);
260 return $container;
4ed934fc » David Dorward 2008-12-26 Add Imperial Consulate 261 }
262
3f62e54a » David Dorward 2008-12-24 New feature: Scout station 263
74498bef » David Dorward 2008-12-26 Add TAS base 264 sub createTASBase {
265 my $container = createSvgElement('svg', x => 75, y => 230, height => 50, width => 50, class => "TAS");
e34a4174 » dorward 2008-12-28 Add more titles 266 $container->appendChild(createTitle('TAS base'));
74498bef » David Dorward 2008-12-26 Add TAS base 267 my $c = createSvgElement('circle', cx => 25, cy => 25, r => 12);
268 my @outer = pointsOnCircle(9,22,25,25);
269 my @inner = pointsOnCircle(9,14,25,25, 0.5);
270 my $points = '';
271 my $l = scalar @outer - 1 ;
272 for my $pos ( 0..$l) {
273 my $opoint = $outer[$pos]->{x} . ',' . $outer[$pos]->{y} . ' ';
274 my $ipoint = $inner[$pos]->{x} . ',' . $inner[$pos]->{y} . ' ';
275 $points .= $opoint . $ipoint;
276 }
277 my $p = createSvgElement('polygon', points => $points, style => 'fill: black;');
278 $container->appendChild($p);
279 $container->appendChild($c);
280 return $container;
281 }
282
c8460469 » dorward 2008-12-28 Add Pirate Base symbol 283 sub createPirateBase {
284 my $container = createSvgElement('svg', x => 110, y => 125, height => 55, width => 55, class => "Pirate");
9f72a8c7 » dorward 2008-12-28 Add title generating method... 285 $container->appendChild(createTitle('Pirate base'));
c8460469 » dorward 2008-12-28 Add Pirate Base symbol 286 my $p = createSvgElement('path', d => $pirate_path, style => "fill: #000");
287 $container->appendChild($p);
288 return $container;
289 }
290
5e20cece » dorward 2009-01-03 Add research base 291 sub createResearchBase {
292 my $container = createSvgElement('svg', x => 130, y => 340, height => 55, width => 55, class => "Research");
293 $container->appendChild(createTitle('Research base'));
294 my $p = createSvgElement('path', d => $research_path, style => "fill: #000");
295 $container->appendChild($p);
296 return $container;
297 }
298
9f72a8c7 » dorward 2008-12-28 Add title generating method... 299 sub createTitle {
300 my $title = shift;
301 my $e = createSvgElement('title');
302 my $n = $doc->createTextNode($title);
303 $e->appendChild($n);
304 return $e;
305 }
306
32a50249 » David Dorward 2008-12-26 Add starport 307 sub createStarport {
308 my $class = shift;
309 my $container = createSvgElement('svg', x => 0, y => 110, height => 250, width => 500, class => "starport");
e34a4174 » dorward 2008-12-28 Add more titles 310 $container->appendChild(createTitle('Starport Class'));
32a50249 » David Dorward 2008-12-26 Add starport 311 my %attributes = (x => 250, y => 85, class => 'starport');
312 my $text = createSvgElement('text', %attributes);
313 my $tNode = $doc->createTextNode($class);
314 $text->appendChild($tNode);
315 $container->appendChild($text);
316 return $container;
317 }
318
74498bef » David Dorward 2008-12-26 Add TAS base 319
92ebfec0 » David Dorward 2008-12-26 System name and font styling 320 sub createSystemName {
321 my $name = shift;
322 my $container = createSvgElement('svg', x => 0, y => 360, height => 250, width => 500, class => "starport");
e34a4174 » dorward 2008-12-28 Add more titles 323 $container->appendChild(createTitle('System name'));
92ebfec0 » David Dorward 2008-12-26 System name and font styling 324 my %attributes = (x => 250, y => 85, class => 'systemName');
325 my $text = createSvgElement('text', %attributes);
326 my $tNode = $doc->createTextNode($name);
327 $text->appendChild($tNode);
328 $container->appendChild($text);
329 return $container;
330 }
331
74498bef » David Dorward 2008-12-26 Add TAS base 332 use Math::Trig;
333 sub pointsOnCircle {
334 my $points = shift;
335 my $r = shift;
336 my $cx = shift;
337 my $cy = shift;
338 my $offset = shift || 0;
339
340 my @coords;
341
342 my $angle = 2 * pi / $points;
343 for (1..$points) {
344 my $t = ($_ + $offset) * $angle;
345 my $coord = {
346 x => $cy + cos($t) * $r,
347 y => $cx + sin($t) * $r
348 };
349 push @coords, $coord;
350 }
351 return @coords;
352 }
46e96cfc » dorward 2009-08-26 Add licensing terms 353
354 =head1 COPYRIGHT & LICENSE
355
356 Copyright 2008-2009 David Dorward
357
358 This program is free software; you can redistribute it and/or
359 modify it under the terms of the Artistic License version 2.0.
360
361 You are encouraged to contact the author if you wish to discuss
362 alternative licensing terms.
363
364 =back