source: subversion/applications/rendering/orp/orp.pl @ 10980

Last change on this file since 10980 was 10965, checked in by jttt, 12 years ago

Refactor layer handling. Process all layers in one run, save required info for every drawing command. Sort commands by layer and write them to svg file

File size: 43.3 KB
Line 
1#!/usr/bin/perl
2
3# or/p - Osmarender in Perl
4# -------------------------
5#
6# Main Program
7#
8# This is a re-implementation of Osmarender in Perl.
9#
10# Usage:
11# perl orp.pl -r rule.xml data.osm
12#
13# creates a file named data.svg
14#
15# BUGS AND LIMITATIONS
16# --------------------
17#
18# Known bugs:
19# - something seems to be wrong with my implementation of bobkare's area
20#   center algorithm; it works "mostly" but sometimes it is a bit off. It
21#   doesn't support relations (polygons with holes) yet but even for those
22#   without holes it is not always right. I've switched to the old primitive
23#   "center of bbox" algorithm for the time being.
24#
25# Osmarender features not yet supported:
26# - "s" attribute on rules is unsupported in some esoteric cases
27#
28# Possible optimisations:
29# - generate more concise SVG output by naming things differently
30#   (not way_reverse_45363 but wr_123; possibly also renumber them
31#   1..n)
32# - include lines2curves
33# - simplify paths that have lots of nodes (specify something like
34#   an "output dpi" and then just round every position to the nearest
35#   possible output position - this will ultimately allow us to render
36#   complex level-12 or even larger tiles
37# - pre-process rules file to determine what needs to be read and
38#   ignore other data on input
39# - process multiple rules files into multiple out files (saves parsing
40#   time)
41# - use Proj.4 projection (will break compatibility)
42# - do proper clipping, i.e. suppress generating SVG instructions for stuff
43#   that is invisible anyway, thus enabling us to use one big OSM file and
44#   make several SVG "tiles" from it
45# - loads more
46#
47# Stuff supported by or/p but not by Osmarender/XSLT:
48# - gridSpacing variable (default 1000, grid spacing in metres)
49#
50# DATA STRUCTURE
51# --------------
52#
53# NODES:
54#   * represented as hashes with keys "id", "lat", "lon", "tags",
55#     "layer", and "ways"
56#     where "tags" is a hash ref and "ways" is an array ref,
57#     containing way references (not way ids)
58#   * stored in global hash $node_storage (key: node id)
59# WAYS:
60#   * represented as hashes with "id", "tags", "nodes"
61#     where "tags" is a hash ref and "nodes" is an array ref,
62#     containing node references (not node ids)
63#   * stored in global hash $way_storage (key: way id)
64# RELATIONS:
65#   * represented as hashes with "id", "tags", "members"
66#     where "tags" is a hash ref and "members" is an array ref,
67#     each element again an array reference with two elements
68#     (role and object reference)
69#   * stored in global hash $relation_storage (key: relation id)
70#
71# INDEXES:
72#   * $index_node_keys is a hash with one key for each tag key
73#     present in nodes, the value is an array of node references
74#   * $index_way_keys the same for way tag keys
75#   * each object has a "relations" hash element whose value is
76#     an array of ($role,$relation_ref) pairs
77#
78# SELECTION LISTS:
79#   * $selection is an array that contains references to
80#     all currently selected elements on various levels of rule
81#     recursion.
82#     element #0 has pointers to ALL elements.
83#     element #1 has pointers to all elements selected by the
84#       top-most rule on the current recursion stack.
85#     element #2 has pointers to the subset of #1 selected
86#       by the second rule on the current recursion stack
87#     etc.
88#   * each element in $selection is a Set::Object because
89#     we want the selection lists to be unique.
90#
91#
92# LICENSE
93# -------
94#
95# Written by Frederik Ramm <frederik@remote.org>, as a complete re-write
96# of osmarender.xsl.
97#
98# osmarender.xsl is Copyright (C) 2006-2007  Etienne Cherdlu, Jochen Topf
99# and released under GPL v2 or later.
100#
101# This program does not contain code from the original osmarender.xsl
102# but since the logic has been copied from Osmarender, it is safe to
103# assume that this triggers the viral element of the GPL, making orp.pl
104# GPL v2 or later also. (It would have been Public Domain otherwise.)
105#
106# -----------------------------------------------------------------------------
107use strict;
108use warnings;
109use bytes;
110
111use XML::Parser::PerlSAX ();
112use XML::XPath ();
113use XML::XPath::XMLParser ();
114use Math::Trig qw(great_circle_distance deg2rad pi);
115use Set::Object ();
116use Getopt::Long qw(GetOptions);
117use XML::Writer ();
118use IO::File ();
119use FindBin qw($Bin);
120use lib $Bin;
121use SAXOsmHandler ();
122use Math::Trig;
123
124require "orp-select.pm";
125require "orp-drawing.pm";
126
127# available debug flags:
128our $debug = { 
129    "general" => 0,  # general status messages
130    "rules" => 0,    # print all rules and how many matches
131    "indexes" => 0,  # print messages about the use of indexes
132    "drawing" => 0,  # print out all drawing instructions executed
133};
134
135our $node_storage = {};
136our $way_storage = {};
137our $relation_storage = {};
138our $text_index = {};
139our $meter2pixel = {};
140our %symbols = ();
141our $labelRelations = {};
142
143my $handler = SAXOsmHandler->new($node_storage, $way_storage, $relation_storage);
144my $parser = XML::Parser::PerlSAX->new(Handler => $handler);
145my $rule_file = "rule.xml";
146my $debug_opts = '';
147my $output_file;
148my $bbox;
149my %referenced_ways;
150
151# List of drawing commands which will make the map
152# Represented as hash of arrays. Key is layer, array item is hash with members:
153# instruction
154# array of elements
155my $drawing_commands;
156
157# Informations about drawing instructions. It will contain default layer and maybe some
158# other info in future.
159my %instructions = (
160  'line' => {'func' => \&draw_lines},
161  'area' => {'func' => \&draw_areas},
162  'text' => {'func' => \&draw_text},
163  'circle' => {'func' => \&draw_circles},
164  'symbol' => {'func' => \&draw_symbols},
165  'wayMarker' => {'func' => \&draw_way_markers},
166  'areaText' => {'func' => \&draw_area_text},
167  'areaSymbol' => {'func' => \&draw_area_symbols});
168
169GetOptions("rule=s"    => \$rule_file, 
170           "debug=s"   => \$debug_opts,
171           "outfile=s" => \$output_file,
172           "bbox=s"    => \$bbox);
173
174for my $key(split(/,/, $debug_opts))
175{
176    if (!defined($debug->{"$key"}))
177    {
178        usage("unknown debug option '$key'");
179    }
180    $debug->{$key} = 1;
181}
182
183my $rules = XML::XPath->new(filename => $rule_file); 
184my $data = get_variable("data", "");
185
186# if data file given in rule file, prepend rule file's path
187if ($rule_file =~ m!(.*[/\\])(.*)! && defined($data))
188{
189    $data = $1.$data;
190}
191
192usage ("data file must be specified in rule or on command line")
193    if (($data eq "") && (scalar(@ARGV) == 0));
194
195my $input_file = (defined $ARGV[0]) ? $ARGV[0] : $data;
196
197if (!defined($output_file))
198{
199    if ($input_file =~ /^(.*)\.osm$/)
200    {
201        $output_file = $1.".svg";
202    }
203    else
204    {
205        $output_file = "output.svg";
206    }
207}
208
209our $index_node_tags = {};
210our $index_way_tags = {};
211
212# parse the OSM input file and store data in $node_storage,
213# $way_storage, $relation_storage.
214my %parser_args = (Source => {SystemId => $input_file});
215$parser->parse(%parser_args);
216
217# initialise level-0 selection list with all available objects.
218# (relations are only there for specific reference; you cannot
219# have rules that match relations. if you want that, then add
220# relations to the initial selection here.)
221our $selection = [];
222$selection->[0] = Set::Object->new();
223$selection->[0]->insert(values(%$way_storage));
224$selection->[0]->insert(values(%$node_storage));
225
226# initialise the "ways" element of every node with the list of
227# ways it belongs to (creating a back reference)
228foreach (values(%$way_storage))
229{
230    foreach my $node(@{$_->{"nodes"}})
231    {
232        push(@{$node->{"ways"}}, $_);
233    }
234}
235
236# initialise the relation member lists (after parsing, these only
237# contain symbolic references of the form "way:1234" instead of
238# proper perl references - this is because relations may refer
239# to other relations that haven't been read yet); also add relations
240# to the "relations" element of every member (creating a back
241# reference)
242foreach (values(%$relation_storage))
243{
244    foreach my $member(@{$_->{"members"}})
245    {
246        my ($type, $id) = split(/:/, $member->[1]);
247        my $deref = 
248            ($type eq 'node') ? $node_storage->{$id} : 
249            ($type eq 'way') ? $way_storage->{$id} : 
250            ($type eq 'relation') ? $relation_storage->{$id} : 
251            undef;
252        $member->[1] = $deref;
253
254        if (defined($deref))
255        {
256            push(@{$deref->{'relations'}}, [ $member->[0], $_ ]);
257        }
258    }
259}
260
261# initialise the tag indexes. These will help us to quickly
262# find objects that have a given tag key.
263foreach (values(%$way_storage))
264{
265    foreach my $key(keys(%{$_->{"tags"}}))
266    {
267        push(@{$index_way_tags->{$key}}, $_);
268    }
269}
270foreach (values(%$node_storage))
271{
272    foreach my $key(keys(%{$_->{"tags"}}))
273    {
274        push(@{$index_node_tags->{$key}}, $_);
275    }
276}
277
278my $count = $selection->[0]->size();
279debug("$count objects in level-0 selection") if ($debug->{"general"});
280
281my $title = get_variable("title", "");
282my $showBorder = get_variable("showBorder", "no");
283my $showScale = get_variable("showScale", "no");
284my $showLicense = get_variable("showLicense", "no");
285our $textAttenuation = get_variable("textAttenuation");
286
287# the following conversion factor is required to support width tags in meters
288$meter2pixel = get_variable("meter2pixel", "0.1375");
289
290# extra height for marginalia
291my $marginaliaTopHeight = ($title ne "") ? 40 : 
292    ($showBorder eq "yes") ? 1.5 : 0;
293my $marginaliaBottomHeight = 
294    ($showScale eq "yes" or $showLicense eq "yes") ? 45 : 
295    ($showBorder eq "yes") ? 1.5 : 0;
296
297# extra width and height for border
298my $extraWidth = ($showBorder eq "yes") ? 3 : 0;
299my $extraHeight = ($title eq "" and $showBorder eq "yes") ? 3 : 0;
300
301#  Calculate the size of the bounding box based on data
302my $maxlon = -500; 
303my $maxlat = -500;
304my $minlon = 500;
305my $minlat = 500;
306
307foreach (values(%$node_storage))
308{
309    $maxlon = $_->{"lon"} if ($_->{"lon"} > $maxlon);
310    $maxlat = $_->{"lat"} if ($_->{"lat"} > $maxlat);
311    $minlon = $_->{"lon"} if ($_->{"lon"} < $minlon);
312    $minlat = $_->{"lat"} if ($_->{"lat"} < $minlat);
313}
314
315# if explicit bounds are given in the rules file, honour them
316if ($rules->find("//rules/bounds"))
317{
318    $minlat = get_variable("bounds/minlat");
319    $minlon = get_variable("bounds/minlon");
320    $maxlat = get_variable("bounds/maxlat");
321    $maxlon = get_variable("bounds/maxlon");
322}
323
324# FIXME find bound element in .osm file and honour it
325
326# if explicit bound are given on command line, honour them
327if (defined($bbox))
328{
329    ($minlat, $minlon, $maxlat, $maxlon) = split(/,/, $bbox);
330}
331
332our $scale = get_variable("scale", 1);
333our $symbolScale = get_variable("symbolScale", 1);
334our $projection = 1 / cos(($maxlat + $minlat) / 360 * pi);
335our $km = 0.0089928*$scale*10000*$projection;
336our $dataWidth = ($maxlon - $minlon) * 10000 * $scale;
337# original osmarender: our $dataHeight = ($maxlat - $minlat) * 10000 * $scale * $projection;
338our $dataHeight = (ProjectF($maxlat) - ProjectF($minlat)) * 180 / pi * 10000 * $scale; 
339our $minimumMapWidth = get_variable("minimumMapWidth", undef);
340our $minimumMapHeight = get_variable("minimumMapHeight", undef);
341our $documentWidth = ($dataWidth > $minimumMapWidth * $km) ? $dataWidth : $minimumMapWidth * $km;
342our $documentHeight = ($dataHeight > $minimumMapHeight * $km) ? $dataHeight : $minimumMapHeight * $km;
343
344# FIXME: what's the logic behind the following?
345our $width = ($documentWidth + $dataWidth) / 2;
346our $height = ($documentHeight + $dataHeight) / 2;
347
348# FIXME don't know what this is for but it seems to be unused
349my $style = get_variable("xml-stylesheet", undef);
350debug("XX STYLESHEET $style FIXME") if ($style);
351
352my $output = new IO::File(">$output_file");
353our $writer = new XML::Writer(OUTPUT => $output, UNSAFE => 1, 
354    DATA_MODE => 1, DATA_INDENT => 3, ENCODING => "utf-8");
355
356my $svgWidth = $documentWidth + $extraWidth;
357my $svgHeight = $documentHeight + $marginaliaBottomHeight + $marginaliaTopHeight;
358
359# start the SVG document
360$writer->startTag("svg",
361    "xmlns" => "http://www.w3.org/2000/svg",
362    "xmlns:svg" => "http://www.w3.org/2000/svg",
363    "xmlns:xlink" => "http://www.w3.org/1999/xlink",
364    "xmlns:xi" => "http://www.w3.org/2001/XInclude",
365    "xmlns:inkscape" => "http://www.inkscape.org/namespaces/inkscape",
366    "xmlns:cc" => "http://web.resource.org/cc/",
367    "xmlns:rdf" => "http://www.w3.org/1999/02/22-rdf-syntax-ns#",
368    "id" => "main", 
369    "version" => 1.1, 
370    "baseProfile" => get_variable("svgBaseProfile"), 
371    "width" => "${svgWidth}px", 
372    "height" => "${svgHeight}px", 
373    "preserveAspectRatio" => "none", 
374    "viewBox" => sprintf("%f %f %f %f", 
375       -$extraWidth/2, -$extraHeight/2, $svgWidth, $svgHeight));
376# FIXME add interactive stuff
377# fixme add metadata
378
379# copy definitions from rule file
380$writer->startTag("defs", "id" => "defs-rulefile");
381$writer->raw($rules->findnodes_as_string("//rules/defs/*[local-name() != 'svg' and local-name() != 'symbol']"));
382$writer->endTag("defs");
383
384# copy symbols
385sub registerSymbol
386{
387    (my $node, my $id, my $width, my $height) = @_;
388    $id = $node->getAttribute('id') unless defined $id;
389    $width = $node->getAttribute('width') unless defined $width;
390    $height = $node->getAttribute('height') unless defined $height;
391
392    $symbols{$id}{'width'} = $width ne ""?$width:0;
393    $symbols{$id}{'height'} = $height ne ""?$height:0;
394}
395
396$writer->startTag("defs", "id" => "defs-symbols");
397# ... from stylesheet, convert svg to symbol if necessary
398foreach my $node ($rules->find('//rules/defs/svg:symbol')->get_nodelist)
399{
400    $writer->raw($node->toString);
401    registerSymbol($node);
402}
403foreach my $node ($rules->find('//rules/defs/svg:svg')->get_nodelist)
404{
405    my $id = $node->getAttribute('id');
406    my %attributes = map {$_->getName => $_->getNodeValue} $node->getAttributes;
407    $writer->startTag("symbol", %attributes);
408    $writer->raw($rules->findnodes_as_string("//rules/defs/svg:svg[\@id='$id']/*"));
409    $writer->endTag("symbol");
410    registerSymbol($node);
411}
412# ... from symbols dir
413my $symbolsDir = get_variable("symbolsDir");
414if (defined($symbolsDir))
415{
416    $symbolsDir = File::Spec->catdir($Bin, '../osmarender/', $symbolsDir);
417    # get refs, then convert to hash so we can get only unique values
418    my %refs = map {$_, 1} map {$_->getNodeValue} $rules->find('/rules//symbol/@ref | /rules//areaSymbol/@ref')->get_nodelist;
419    foreach my $file (keys %refs) 
420    {
421        if (not exists $symbols{'symbol-'.$file})
422        {
423            my $symbolFile = XML::XPath->new(filename => $symbolsDir . "/" . $file . ".svg"); 
424            $symbolFile->set_namespace('svg', 'http://www.w3.org/2000/svg');
425            my $symbol = $symbolFile->find('/svg:svg/svg:defs/svg:symbol');
426            if ($symbol->size()==1)
427            {
428                $writer->raw($symbol->get_node(1)->toString);
429                registerSymbol($symbol->get_node(1));
430            } else
431            {
432                my $svgNode = $symbolFile->find("/svg:svg")->get_node(1);
433                my %namespaces = map {"xmlns:".$_->getPrefix => $_->getExpanded} $svgNode->getNamespaces;
434                $namespaces{'xmlns'} = $namespaces{'xmlns:#default'};
435                delete $namespaces{'xmlns:#default'};
436                my %attributes = map {$_->getName => $_->getValue} $svgNode->getAttributes;
437                $attributes{'id'} = "symbol-".$file; 
438                $writer->startTag("symbol", %attributes, %namespaces);
439                $writer->raw($symbolFile->findnodes_as_string("/svg:svg/*"));
440                $writer->endTag("symbol");
441                registerSymbol($svgNode, $attributes{'id'});
442            }
443        }
444    }
445}
446$writer->endTag("defs");
447
448#include referenced defs
449$writer->startTag("defs", "id" => "defs-included");
450foreach my $include ($rules->find("/rules//include")->get_nodelist)
451{
452    my $includeFile = XML::XPath->new(filename => File::Spec->catdir($Bin, '../osmarender/', $include->getAttribute("ref")));
453    $includeFile->set_namespace('svg', 'http://www.w3.org/2000/svg');
454    $writer->raw($includeFile->findnodes_as_string("/svg:svg/*"));
455}
456$writer->endTag("defs");
457
458# load label relations
459foreach my $relation (values(%$relation_storage))
460{
461    my $type = $relation->{'tags'}->{'type'};
462    next unless defined($type) && $type eq 'label';
463
464    my $labelRelationInfo = [];
465
466    # make list of labels
467    foreach my $relpair (@{$relation->{"members"}})
468    {
469        my ($role, $ref) = @$relpair;
470        if ($role eq 'label' && ref $ref eq 'node')
471        {
472            push @$labelRelationInfo, $ref;
473        }
474    }
475
476    # assing labels to first object, other object will be empty
477    my $first = 1;
478    foreach my $relpair (@{$relation->{"members"}})
479    {
480        my ($role, $ref) = @$relpair;
481
482        if ($role eq 'object')
483        {
484            if ($first)
485            {
486                $labelRelations->{$ref->{'id'}} = $labelRelationInfo;
487                $first = 0;
488            }
489            else
490            {
491                $labelRelations->{$ref->{'id'}} = [];
492            }
493        }
494    }
495}
496
497# Clipping rectangle for map
498
499$writer->startTag("clipPath", "id" => "map-clipping");
500$writer->emptyTag("rect", "id" => "map-clipping-rect", "x" => "0px", "y" => "0px", 
501    "height" => $documentHeight."px", "width" => $documentWidth."px");
502$writer->endTag("clipPath");
503
504# Start of main drawing
505
506$writer->startTag("g", "id" => "map", "clip-path"=> "url(#map-clipping)", 
507    "inkscape:groupmode" => "layer", "inkscape:label" => "Map", 
508    "transform" => "translate(0,$marginaliaTopHeight)");
509
510# Draw a nice background layer
511
512$writer->emptyTag("rect", "id" => "background", "x" => "0px", "y" => "0px", 
513    "height" => $documentHeight."px", "width" => $documentWidth."px",
514    "class" => "map-background");
515
516# Process all the rules drawing all map features
517
518# If the global var withOSMLayers is 'no', we don't care about layers and
519# draw everything in one go. This is faster and is sometimes useful. For
520# normal maps you want withOSMLayers to be 'yes', which is the default.
521
522my $rulelist = $rules->find('//rules/rule');
523
524if (get_variable("withOSMLayers", "yes") eq "no")
525{
526    # we have all elements in selection0, process rules for all of them.
527    process_rule($_, 0) foreach ($rulelist->get_nodelist());
528}
529else
530{
531    # process all layers
532    process_rule($_, 0) foreach ($rulelist->get_nodelist());
533
534    # draw layers
535    foreach my $layer(sort { $a <=> $b } keys %$drawing_commands)
536    {
537        my $layer_commands = $drawing_commands->{$layer};
538        $writer->startTag('g',
539           'inkscape:groupmode' => 'layer',
540           'id' => "layer$layer",
541           'inkscape:label' => "Layer $layer");
542
543        foreach my $command (@$layer_commands)
544        {
545            $instructions{$command->{'instruction'}->getName()}->{'func'}->($command->{'instruction'}, undef, $command->{'elements'});
546        }
547
548        $writer->endTag();
549    }
550}
551
552$writer->endTag('g');
553
554draw_map_decoration();
555draw_marginalia() if ($title ne "" || $showScale eq "yes" || $showLicense eq "yes");
556
557# Generate named path definitions for referenced ways
558
559generate_paths();
560
561# FIXME zoom controls from Osmarender.xsl
562
563$writer->endTag('svg');
564$writer->end();
565$output->close();
566
567exit;
568
569sub get_way_href
570{
571    my ($id, $type) = @_;
572
573    $referenced_ways{$id}->{$type} = 1;
574    return '#way_'.$type.'_'.$id;
575}
576
577# sub generate_paths()
578# --------------------
579#
580# Creates path definitions for all ways in the source.
581#
582sub generate_paths
583{
584    $writer->startTag("defs", "id" => "defs-ways");
585
586    foreach my $way_id (keys %referenced_ways)
587    {
588        # extract data into variables for convenience. the "points"
589        # array contains lat/lon pairs of the nodes.
590        my $way = $way_storage->{$way_id};
591        my $types = $referenced_ways{$way_id};
592        my $tags = $way->{"tags"};
593        my $points = [];
594        foreach (@{$way->{"nodes"}})
595        {
596            push(@$points, [ $_->{"lat"}, $_->{"lon"} ]) if (defined($_->{"lat"}) && defined($_->{"lon"}));
597        }
598
599        next if (scalar(@$points) < 2);
600
601
602        # generate a normal way path
603        if ($types->{'normal'})
604        {
605            $writer->emptyTag("path", "id" => "way_normal_$way_id", "d" => make_path(@$points));
606        }
607
608        # generate reverse path if needed
609        if ($types->{'reverse'})
610        {
611            $writer->emptyTag("path", "id" => "way_reverse_$way_id", 
612                "d" => make_path(reverse @$points));
613        }
614
615        # generate the start, middle and end paths needed for "smart linecaps".
616        # The first and last way segment are split in the middle.
617        my $n = scalar(@$points) -1;
618        my $midpoint_head = [ ($points->[0]->[0]+$points->[1]->[0])/2,
619                             ($points->[0]->[1]+$points->[1]->[1])/2 ];
620        my $midpoint_tail = [ ($points->[$n]->[0]+$points->[$n-1]->[0])/2,
621                             ($points->[$n]->[1]+$points->[$n-1]->[1])/2 ];
622        my $firstnode = shift @$points;
623        my $lastnode = pop @$points;
624
625        if ($types->{'start'})
626        {
627            $writer->emptyTag("path", "id" => "way_start_$way_id", 
628                "d" => make_path($firstnode, $midpoint_head));
629        }
630        if ($types->{'end'})
631        {
632            $writer->emptyTag("path", "id" => "way_end_$way_id", 
633                "d" => make_path($midpoint_tail, $lastnode));
634        }
635        if ($types->{'mid'})
636        {
637            $writer->emptyTag("path", "id" => "way_mid_$way_id", 
638                "d" => make_path($midpoint_head, @$points, $midpoint_tail)) if scalar(@$points);
639        }
640    };
641    $writer->endTag("defs");
642}
643
644
645# sub draw_map_decoration()
646# -------------------------
647#
648# Draws grids and stuff.
649#
650sub draw_map_decoration
651{
652    $writer->startTag('g', 
653        'inkscape:groupmode' => 'layer',
654        'inkscape:label' => 'Map decoration',
655        'transform' => "translate(0,$marginaliaTopHeight)");
656
657    # draw a grid if required
658    if (get_variable("showGrid") eq "yes")
659    {
660        # grid spacing in metres.
661        my $gridSpacing = get_variable("gridSpacing", 1000);
662        my $gridSpacingPx = $km / 1000 * $gridSpacing;
663        $writer->startTag('g', 
664            'inkscape:groupmode' => 'layer',
665            'inkscape:label' => 'Grid');
666        for (my $i=1; $i<$documentHeight / $gridSpacingPx; $i++)
667        {
668            $writer->emptyTag('line',
669                'id' => 'grid-hori-'.$i,
670                'x1' => '0px', 'y1' => sprintf('%fpx', $i * $gridSpacingPx),
671                'x2' => $documentWidth.'px', 'y2' => sprintf('%fpx', $i * $gridSpacingPx),
672                'class' => 'map-grid-line');
673        }
674        for (my $i=1; $i<$documentWidth / $gridSpacingPx; $i++)
675        {
676            $writer->emptyTag('line',
677                'id' => 'grid-vert-'.$i,
678                'x1' => sprintf('%fpx', $i * $gridSpacingPx), 'y1' => 0, 
679                'x2' => sprintf('%fpx', $i * $gridSpacingPx), 'y2' => $documentHeight.'px',
680                'class' => 'map-grid-line');
681        }
682        $writer->endTag('g');
683    }
684
685    # draw a border if required
686    if (get_variable("showBorder") eq "yes")
687    {
688        $writer->startTag('g', 
689            'id' => 'border',
690            'inkscape:groupmode' => 'layer',
691            'inkscape:label' => 'Map Border');
692        foreach my $type('casing', 'core')
693        {
694            $writer->emptyTag('line',
695                'id' => 'border-left-'.$type,
696                'x1' => 0, 'y1' => 0, x2 => 0, y2 => $documentHeight, 
697                'class' => 'map-border-'.$type,
698                'stroke-dasharray' => sprintf("%f,1", $km/10-1));
699            $writer->emptyTag('line',
700                'id' => 'border-top-'.$type,
701                'x1' => 0, 'y1' => 0, x2 => $documentWidth, y2 => 0,
702                'class' => 'map-border-'.$type,
703                'stroke-dasharray' => sprintf("%f,1", $km/10-1));
704            $writer->emptyTag('line',
705                'id' => 'border-bottom-'.$type,
706                'x1' => 0, 'y1' => $documentHeight, x2 => $documentWidth, y2 => $documentHeight,
707                'class' => 'map-border-'.$type,
708                'stroke-dasharray' => sprintf("%f,1", $km/10-1));
709            $writer->emptyTag('line',
710                'id' => 'border-right-'.$type,
711                'x1' => $documentWidth, 'y1' => 0, x2 => $documentWidth, y2 => $documentHeight, 
712                'class' => 'map-border-'.$type,
713                'stroke-dasharray' => sprintf("%f,1", $km/10-1));
714        }
715        $writer->endTag('g');
716    }
717    $writer->endTag('g');
718}
719
720# sub draw_map_decoration()
721# -------------------------
722#
723# Draws license and stuff.
724#
725sub draw_marginalia
726{
727    $writer->startTag('g', 
728        'id' => 'marginalia',
729        'inkscape:groupmode' => 'layer',
730        'inkscape:label' => 'Marginalia');
731    if ($title ne "")
732    {
733        $writer->startTag('g',
734            'inkscape:groupmode' => 'layer',
735            'inkscape:label' => 'Title');
736        $writer->emptyTag('rect',
737            'id' => 'marginalia-title-background', 
738            'class' => 'map-title-background', 
739            'x' => '0px', y => '0px', 
740            'width' => $documentWidth.'px', 'height' => sprintf('%fpx', $marginaliaTopHeight - 5));
741        $writer->dataElement('text', $title, 
742            'id' => 'marginalia-title-text', 
743            'class' => 'map-title',
744            'x' => $documentWidth/2, 'y' => 30);
745        $writer->endTag('g');
746    }
747    if ($showScale eq "yes" || $showLicense eq "yes")
748    {
749        $writer->startTag('g', 
750            'id' => 'marginalia-bottom',
751            'inkscape:groupmode' => 'layer',
752            'inkscape:label' => 'Marginalia (Bottom)');
753        $writer->emptyTag('rect',
754            'id' => 'marginalia-background',
755            'x' => '0px', y => sprintf('%fpx', $documentHeight + 5),
756            'height' => '40px', width => $documentWidth.'px',
757            'class' => 'map-marginalia-background');
758        if ($showScale eq 'yes')
759        {
760            my $x1 = 14;
761            my $y = int (28.5 + $documentHeight);
762            my $x2 = $x1 + $km;
763            $writer->startTag('g',
764                'id' => 'marginalia-scale',
765                'inkscape:groupmode' => 'layer',
766                'inkscape:label' => 'Scale');
767            $writer->emptyTag('line',
768                'class' => 'map-scale-casing',
769                'x1' => $x1, 'y1' => $y, 'x2' => $x2, 'y2' => $y);
770            $writer->emptyTag('line',
771                'class' => 'map-scale-core',
772                'stroke-dasharray' => $km/10,
773                'x1' => $x1, 'y1' => $y, 'x2' => $x2, 'y2' => $y);
774            $writer->emptyTag('line',
775                'class' => 'map-scale-bookend',
776                'x1' => $x1, 'y1' => $y+2, 'x2' => $x1, 'y2' => $y-10);
777            $writer->emptyTag('line',
778                'class' => 'map-scale-bookend',
779                'x1' => $x2, 'y1' => $y+2, 'x2' => $x2, 'y2' => $y-10);
780            $writer->dataElement('text', '0',
781                'class' => 'map-scale-caption', 
782                'x' => $x1, 'y' => $y-10);
783            $writer->dataElement('text', '1km',
784                'class' => 'map-scale-caption', 
785                'x' => $x2, 'y' => $y-10);
786            $writer->endTag('g');
787        }
788        if ($showLicense eq 'yes')
789        {
790            $writer->startTag('g',
791                'inkscape:groupmode' => 'layer',
792                'inkscape:label' => 'Copyright',
793                'transform' => sprintf('translate(%f,%f)', $documentWidth, $documentHeight));
794            open(CCLOGO, "cclogo.svg");
795            local $/;
796            $_ = <CCLOGO>;
797            $writer->raw($_);
798            close(CCLOGO);
799            $writer->endTag('g');
800        }
801        $writer->endTag('g');
802    }
803    $writer->endTag('g');
804}
805       
806
807# -------------------------------------------------------------------
808# sub process_layer()
809#
810# Used for layer instructions.
811#
812# -------------------------------------------------------------------
813sub process_layer
814{
815
816    my ($layernode, $depth, $layer) = @_;
817
818
819    my $lname = $layernode->getAttribute("name");
820    my $opacity = $layernode->getAttribute("opacity");
821
822    debug("layer: $lname") if ($debug->{'rules'});
823   
824    $writer->startTag("g", "name" => "Layer-$lname", $opacity eq ""?"":"opacity" => $opacity );
825
826    $selection->[$depth+1] = $selection->[$depth];
827
828   
829    foreach ($layernode->getChildNodes())
830    {
831        my $name = $_->getName() || "";
832
833        if($name eq "rule")
834        {
835            process_rule($_, $depth+1, $layer);
836        }
837        elsif ($name ne "")
838        {
839            debug("'$name' id not allowed layer instruction '$lname' ignored");
840        }
841    }
842    $writer->endTag("g");
843
844}
845
846
847# -------------------------------------------------------------------
848# sub process_rule()
849#
850# The main workhorse.
851#
852# This is called recursively if you have nested rule elements.
853#
854# Parameters:
855# $rulenode - the XML::XPath node for the <rule> or <else> element
856#   being processed.
857# $depth -    the recursion depth.
858# $layer -    the OSM layer being processed (undef for no layer restriction)
859# $previous - the XML::XPath node for the previous <rule> of the
860#   same depth; used only for debug messages.
861# -------------------------------------------------------------------
862sub process_rule
863{
864    my ($rulenode, $depth, $layer, $previous) = @_;
865
866    # normally, we pass on the given layer attribute unchanged, and it
867    # will the be honoured in the various drawing instruction handlers.
868    # However if the rule itself has a layer attribute, this means that
869    # - if we are on that layer, let that rule process ALL objects
870    #   (i.e. lift the "only objects on layer X" restriction)
871    # - if we are on another layer, ignore the rule.
872   
873    my $rule_layer = $rulenode->getAttribute('layer') || '';
874    if (($rule_layer ne '') && defined($layer))
875    {
876        if ($rule_layer != $layer)
877        {
878            debug("rule has layer '$rule_layer', ignored on layer '$layer': ".$rulenode->toString(1))
879                if ($debug->{"rules"});
880            return;
881        }
882        undef $layer;
883    }
884
885    # ----------------------------------------------------
886    # Part 1 of process_rule:
887    # create the new selection by applying the rule to 
888    # the current selection.
889    # ----------------------------------------------------
890
891    if ($rulenode->getName() eq "rule")
892    {
893        # normal selection
894        $selection->[$depth+1] = make_selection($rulenode, $selection->[$depth]);
895        if ($debug->{'rules'})
896        {
897            debug('rule "'.$rulenode->toString(1).'" matches '.
898                $selection->[$depth+1]->size().' elements');
899        }
900    }
901    elsif ($rulenode->getName() eq "else")
902    {
903        # "else" selection - a selection for our level of
904        # recursion already exists (from the previous rule) and
905        # we need to select all objects that are present in the
906        # selection one level up and not in the previous rule's
907        # selection (which is on our level of recursion).
908        $selection->[$depth+1] = $selection->[$depth] - $selection->[$depth+1];
909        if ($debug->{'rules'})
910        {
911            debug('"else" branch of rule "'.$previous->toString(1).
912                '" matches '.$selection->[$depth+1]->size().' elements');
913        }
914    }
915    else 
916    {
917        die("internal error, process_rule must not be called with '".
918            $rulenode->getName()."' node");
919    }
920
921    my $selected = $selection->[$depth+1];
922
923    # if no rows were inserted, we can leave now.
924    if ($selected->size() == 0)
925    {
926        return;
927    }
928
929    # ----------------------------------------------------
930    # Part 2 of process_rule:
931    # the selection is complete; iterate over child nodes
932    # of the rule and either do recursive rule processing,
933    # or execute drawing instructions.
934    # ----------------------------------------------------
935
936    my $previous_child;
937    foreach my $instruction ($rulenode->getChildNodes())
938    {
939        next unless ref $instruction eq 'XML::XPath::Node::Element';
940        my $name = $instruction->getName() || '';
941
942        if ($name eq "layer")
943        {
944              process_layer($instruction, $depth+1, $layer);
945        }
946        elsif ($name eq "rule")
947        {
948            # a nested rule; make recursive call.
949            process_rule($instruction, $depth+1, $layer);
950        }
951        elsif ($name eq "else")
952        {
953            # an "else" element.
954            if (!defined($previous_child) || $previous_child->getName() ne "rule")
955            {
956                debug("<else> not following <rule>, ignored: ".substr($instruction->toString(0), 0, 60)."...");
957            }
958            else
959            {
960                # make recursive call
961                process_rule($instruction, $depth+1, $layer, $previous_child);
962            }
963        }
964        elsif ($instructions{$name})
965        {
966            foreach my $element ($selected->members())
967            {
968                # Calculate layer
969                my $layer;
970                if ($instruction->getAttribute('layer') ne '')
971                {
972                    $layer = $instruction->getAttribute('layer');
973                }
974                elsif ($element->{'tags'}->{'layer'})
975                {
976                    $layer = $element->{'tags'}->{'layer'};
977                }
978                else
979                {
980                    $layer = 0;
981                }
982
983                # Create new entry for layer if it doesn't exist yet
984                if (not($drawing_commands->{$layer}))
985                {
986                    $drawing_commands->{$layer} = [{'instruction'=>$instruction}];
987                }
988
989                # Create new entry for instruction
990                if ($drawing_commands->{$layer}->[-1]->{'instruction'} ne $instruction)
991                {
992                   push @{$drawing_commands->{$layer}}, {'instruction' => $instruction, 'elements' => []};
993                }
994
995                # Add element
996                push @{$drawing_commands->{$layer}->[-1]->{'elements'}}, $element;
997            }
998        }
999        elsif ($name ne "")
1000        {
1001            debug("unknown drawing instruction '$name' ignored");
1002        }
1003        $previous_child = $_ unless ($name eq "");
1004    }
1005}
1006
1007# -------------------------------------------------------------------
1008# sub make_selection()
1009#
1010# Applies a rule to a selection, and returns the new (reduced)
1011# selection.
1012#
1013# Parameters:
1014#    $rulenode - the Xml::XPath node for the rule
1015#    $oldsel - the Set::Object reference for the current selection
1016#
1017# Returns:
1018#    a new Set::Object with the reduced selection.
1019# -------------------------------------------------------------------
1020sub make_selection
1021{
1022    my ($rulenode, $oldsel) = @_;
1023
1024    my $k = $rulenode->getAttribute("k");
1025    my $v = $rulenode->getAttribute("v");
1026
1027    # read the "e" attribute of the rule (type of element)
1028    # and execute the selection for these types. "e" is assumed
1029    # to be either "node", "way", or "node|way".
1030   
1031    my $e = $rulenode->getAttribute("e");
1032    my $s = $rulenode->getAttribute("s");
1033    my $rows_affected;
1034
1035    # make sure $e is either "way" or "node" or undefined (=selects both)
1036    my $e_pieces = {};
1037    $e_pieces->{$_}=1 foreach(split('\|', $e));
1038    if ($e_pieces->{'way'} && $e_pieces->{'node'})
1039    {
1040        undef $e;
1041    }
1042    elsif ($e_pieces->{'way'})
1043    {
1044        $e = 'way';
1045    }
1046    else
1047    {
1048        $e = 'node';
1049    }
1050    foreach(keys(%$e_pieces))
1051    {
1052        warn('ignored invalid value "'.$_.'" for e attribute in rule '.$rulenode->toString(1))
1053            unless($_ eq "way" or $_ eq "node");
1054    }
1055
1056    my $interim;
1057
1058    if ($k eq '*' or !defined($k))
1059    {
1060        # rules that apply to any key. these don't occur often
1061        # but are in theory supported by osmarender.
1062
1063        if ($v eq "~")
1064        {
1065            # k=* v=~ means elements without tags.
1066            # FIXME "s"
1067           $interim = select_elements_without_tags($oldsel, $e);
1068        }
1069        elsif ($v eq "*")
1070        {
1071            # k=* v=* means elements with any tag.
1072            # FIXME "s"
1073            $interim = select_elements_with_any_tag($oldsel, $e);
1074        }
1075        else
1076        {
1077            # k=* v=something means elements with a tag that has the
1078            # value "something". "something" may be a pipe-separated
1079            # list of values. The "~" symbol is not supported in the
1080            # list.
1081            # FIXME "s"
1082            $interim = select_elements_with_given_tag_value($oldsel, $e, $v);
1083        }
1084    }
1085    else
1086    {
1087        # rules that apply to the specifc key given in $k. This may
1088        # be a pipe-separated list of values.
1089       
1090        if ($v eq "*")
1091        {
1092            # objects that have the given key(s), with any value.
1093            # FIXME "s"
1094            $interim = select_elements_with_given_tag_key($oldsel, $e, $k);
1095        }
1096        elsif ($v eq "~")
1097        {
1098            # objects that don't have the key(s)
1099            # FIXME "s"
1100            $interim = select_elements_without_given_tag_key($oldsel, $e, $k);
1101        }
1102        elsif ($s eq "" and index($v, '~') == -1)
1103        {
1104            # objects that have the given keys and values, where none of the
1105            # values is "~"
1106            $interim = select_elements_with_given_tag_key_and_value_fast($oldsel, $e, $k, $v);
1107        }
1108        elsif ($s eq "way" and index($v, '~') == -1)
1109        {
1110            # nodes that belong to a way that has the given keys and values,
1111            # where none of the values is "~"
1112            $interim = select_nodes_with_given_tag_key_and_value_for_way_fast($oldsel, $k, $v);
1113        }
1114        else
1115        {
1116            # the code that can handle "~" in values (i.e. rules like "the
1117            # 'highway' tag must be 'bridleway' or not present at all)
1118            # is slower since it cannot use indexes.
1119            $interim = select_elements_with_given_tag_key_and_value_slow($oldsel, $e, $k, $v, $s);
1120        }
1121    }
1122
1123    # make assertion to help programmers who break the above
1124    die ("something is wrong") unless defined($interim);
1125
1126    # post-process the selection according to proximity filter, if set.
1127
1128    # the following control the proximity filter. horizontal and vertical proximity
1129    # control the size of the imaginary box drawn around the point where the label is
1130    # placed. proximityClass is a storage class; if it is shared by multiple rules,
1131    # then all these rules compete for the same space. If no class is set then the
1132    # filter only works on objects selected by this rule.
1133    # FIXME: proximity filtering does not take text length into account, and boxes
1134    # are currently based on lat/lon values to remain compatible to Osmarender,
1135    # yielding reduced spacings the closer you get to the poles.
1136
1137    my $hp = $rulenode->getAttribute("horizontalProximity");
1138    my $vp = $rulenode->getAttribute("verticalProximity");
1139    my $pc = $rulenode->getAttribute("proximityClass");
1140    if ($hp ne "" && $vp ne "")
1141    {
1142        #debug("activating proximity filter for rule");
1143        $interim = select_proximity($interim, $hp, $vp, $pc);
1144    }
1145
1146
1147    # post-process with minSize filter, if set
1148    my $minsize = $rulenode->getAttribute("minSize");
1149    if ($minsize ne "")
1150    {
1151        $interim = select_minsize($interim, $minsize);
1152    }
1153
1154    return $interim;
1155}
1156
1157# -------------------------------------------------------------------
1158# sub make_path(@nodelist)
1159#
1160# returns an SVG path string for the given list of points.
1161# -------------------------------------------------------------------
1162sub make_path
1163{
1164    my $firstpoint = shift;
1165    my $path = sprintf("M".project_string($firstpoint));
1166    $path .= "L".project_string($_) foreach @_;
1167    return $path;
1168}
1169
1170# -------------------------------------------------------------------
1171# sub project_string($latlon)
1172#
1173# takes an array reference with a "lat" and a "lon" element
1174# and returns a string consisting of two space-separated floats
1175# for usage in SVG paths.
1176# -------------------------------------------------------------------
1177sub project_string
1178{
1179    my $latlon = shift;
1180    my $projected = project($latlon);
1181    return sprintf("%f %f", $projected->[0], $projected->[1]);
1182}
1183
1184# -------------------------------------------------------------------
1185# sub project($latlon)
1186#
1187# takes an array reference with a "lat" and a "lon" element
1188# and returns an array reference with "x" and "y" elements.
1189#
1190# SUPER BIG FIXME: switch to Proj.4 library to allow arbitrary
1191# (correct) projections instead of the current kludge. Also,
1192# possibly project stuff directly in the data base.
1193# -------------------------------------------------------------------
1194sub project
1195{
1196    my $latlon = shift;
1197    return [
1198        $width - ($maxlon-$latlon->[1])*10000*$scale, 
1199        # original osmarender (unused)
1200        # $height + ($minlat-$latlon->[0])*10000*$scale*$projection
1201        # new (proper merc.)
1202        $height + (ProjectF($minlat) - ProjectF($latlon->[0])) * 180/pi * 10000 * $scale 
1203    ];
1204}
1205
1206sub distance
1207{
1208    my ($p1, $p2) = @_;
1209    return great_circle_distance(deg2rad($p1->{"lon"}),
1210        deg2rad(90-$p1->{"lat"}), 
1211        deg2rad($p2->{"lon"}), 
1212        deg2rad(90-$p2->{"lat"}), 6378135);
1213}
1214
1215
1216# -------------------------------------------------------------------
1217# sub get_variable($name)
1218#
1219# helper that reads a variable value from the rule file.
1220# $name is a slash separated path, and the last element of
1221# $name is taken to be an attribute name.
1222#
1223# if the variable is not found, the given $default is returned.
1224# -------------------------------------------------------------------
1225sub get_variable
1226{
1227    my ($name, $default) = @_;
1228    my $fullname = "//rules/$name";
1229    $fullname =~ m!(.*)/(.*)!;
1230    my $find = "$1/\@$2";
1231    my $obj = $rules->findvalue($find);
1232    return $default unless $obj;
1233    return sprintf("%s", $obj);
1234}
1235
1236# -------------------------------------------------------------------
1237# sub copy_attributes_in_list($node, $list)
1238#
1239# returns an array that contains altarnating keys and values of each
1240# of $node's attributes, where the key is mentioned in the $list
1241# array reference.
1242#
1243# used to supply attributes to XML::Writer methods.
1244# -------------------------------------------------------------------
1245sub copy_attributes_in_list
1246{
1247    my ($node, $list) = @_;
1248    my $result = [];
1249    foreach my $key(@$list)
1250    {
1251        my $attr = $node->getAttribute($key);
1252        if ($attr ne "")
1253        {
1254            push @$result, $key, $attr;
1255        }
1256    }
1257    return @$result;
1258}
1259
1260# -------------------------------------------------------------------
1261# sub copy_attributes_not_in_list($node, $list)
1262#
1263# returns an array that contains altarnating keys and values of each
1264# of $node's attributes, where the key is not in the $list
1265# array reference.
1266#
1267# used to supply attributes to XML::Writer methods.
1268# -------------------------------------------------------------------
1269sub copy_attributes_not_in_list
1270{
1271    my ($node, $list) = @_;
1272    my $result = [];
1273    foreach my $attr($node->getAttributes())
1274    {
1275        my $k = $attr->getName();
1276        foreach(@$list)
1277        {
1278            if ($_ eq $k)
1279            {
1280                undef $attr;
1281                last;
1282            }
1283        }
1284        if ($attr)
1285        {
1286            push @$result, $k, $attr->getValue();
1287        }
1288    }
1289    return @$result;
1290}
1291
1292
1293# -------------------------------------------------------------------
1294# sub debug($msg)
1295#
1296# prints $msg to stdout.
1297# -------------------------------------------------------------------
1298sub debug
1299{
1300    my $msg = shift;
1301    print $msg."\n";
1302}
1303
1304# -------------------------------------------------------------------
1305# sub usage($msg)
1306#
1307# prints $msg and usage info, and exits.
1308# -------------------------------------------------------------------
1309sub usage
1310{
1311    my $msg = shift;
1312    print <<EOF;
1313$msg
1314
1315Usage:
1316
1317perl orp.pl [options] data.osm
1318
1319Options:
1320   -d|--debug=list      specify list of debug options
1321   -o|--outfile=name    specify output file (default: same as input, with .svg)
1322   -r|--rule=file.xml   specify the rule file to use (default: rule.xml)
1323   -b|--bbox=minLat,minLon,maxLat,maxLon specify bounding box
1324
1325EOF
1326    exit(1);
1327}
1328
1329# from tahproject.pm
1330sub ProjectF
1331{
1332    my $Lat = shift() / 180 * pi;
1333    my $Y = log(tan($Lat) + sec($Lat));
1334    return($Y);
1335}
1336
Note: See TracBrowser for help on using the repository browser.