source: subversion/applications/rendering/orp/orp-select.pm @ 10980

Last change on this file since 10980 was 9707, checked in by frederik, 12 years ago

implemented minSize filter for orp

File size: 9.3 KB
Line 
1# OR/P - Osmarender in Perl
2# -------------------------
3#
4# Selection Module
5#
6# (See orp.pl for details.)
7#
8# This module contains the implementation for the various styles of
9# object selection supported in <rule> elements.
10
11use strict;
12use warnings;
13
14our $index_way_tags;
15our $index_node_tags;
16our $debug;
17
18# for collision avoidance / proximity filter
19my $used_boxes = {};
20
21sub select_elements_without_tags
22{
23    my ($oldsel, $e) = @_;
24    my $newsel = Set::Object->new();
25    foreach ($oldsel->members())
26    {
27        next if defined($e) and ref($_) != $e;
28        $newsel->insert($_) unless defined($_->{"tags"});
29    }
30    return $newsel;
31}
32
33
34sub select_elements_with_any_tag
35{
36    my ($oldsel, $e) = @_;
37    my $newsel = Set::Object->new();
38
39    foreach ($oldsel->members())
40    {
41        next if defined($e) and ref($_) != $e;
42        $newsel->insert($_) if defined($_->{"tags"});
43    }
44    return $newsel;
45}
46
47sub select_elements_with_given_tag_value
48{
49    my ($oldsel, $e, $v);
50    my $newsel = Set::Object->new();
51    my $seek = {};
52    $seek->{$_} = 1 foreach(split('\|', $v));
53outer:
54    foreach ($oldsel->members())
55    {
56        next if defined($e) and ref($_) ne $e;
57        foreach my $value(values(%{$_->{"tags"}}))
58        {
59            if (defined($seek->{$value}))
60            {
61                $newsel->insert($_);
62                next outer;
63            }
64        }
65    }
66    return $newsel;
67}
68
69sub select_elements_with_given_tag_key
70{
71    my ($oldsel, $e, $k) = @_;
72    my $newsel = Set::Object->new();
73    my @keys_wanted = split('\|', $k);
74
75outer:
76    foreach ($oldsel->members())
77    {
78        next if (defined($e) and ref($_) ne $e);
79        foreach my $key(@keys_wanted)
80        {
81            if (defined($_->{"tags"}->{$key}))
82            {
83                $newsel->insert($_);
84                next outer;
85            }
86        }
87    }
88
89    return $newsel;
90}
91
92sub select_elements_without_given_tag_key
93{
94    my ($oldsel, $e, $k) = @_;
95    my $newsel = Set::Object->new();
96    my @keys_wanted = split('\|', $k);
97
98
99outer:
100    foreach ($oldsel->members())
101    {
102        next if defined($e) and ref($_) ne $e;
103        foreach my $key(@keys_wanted)
104        {
105            next outer if (defined($_->{"tags"}->{$key}));
106        }
107        $newsel->insert($_);
108    }
109
110    return $newsel;
111}
112
113# e=way or node, s not supptd, v must not contain ~
114sub select_elements_with_given_tag_key_and_value_fast
115{
116    my ($oldsel, $e, $k, $v) = @_;
117    my @values_wanted = split('\|', $v);
118    my $newsel = Set::Object->new();
119    my @keys_wanted = split('\|', $k);
120
121    foreach my $key(split('\|', $k))
122    {
123        # retrieve list of objects with this key from index.
124        my @objects = 
125            ($e eq 'way') ? @{$index_way_tags->{$key}||[]} : 
126            ($e eq 'node') ? @{$index_node_tags->{$key}||[]} : 
127            (@{$index_way_tags->{$key}||[]}, @{$index_node_tags->{$key}||[]});
128
129        debug(sprintf('%d objects retrieved from index for e="%s" k="%s"', 
130            scalar(@objects), $e, $k)) if ($debug->{"indexes"});
131
132        # process only those from oldsel that have this key.
133outer:
134        foreach (@objects)
135        {   
136            next unless ($oldsel->contains($_));
137            foreach my $value(@values_wanted)
138            {   
139                if ($_->{"tags"}->{$key} eq $value)
140                {   
141                    $newsel->insert($_);
142                    next outer;
143                }   
144            }   
145        } 
146    }
147    return $newsel;
148}
149
150# e=node, s=way, v must not contain ~
151sub select_nodes_with_given_tag_key_and_value_for_way_fast
152{
153    my ($oldsel, $k, $v) = @_;
154    my @values_wanted = split('\|', $v);
155    my $newsel = Set::Object->new();
156    my @keys_wanted = split('\|', $k);
157
158    foreach my $key(split('\|', $k))
159    {
160        # process only those from oldsel that have this key.
161outer:
162        foreach my $way(@{$index_way_tags->{$key}||[]})
163        {   
164            foreach my $value(@values_wanted)
165            {   
166                if ($way->{"tags"}->{$key} eq $value)
167                {   
168                    foreach (@{$way->{'nodes'}})
169                    {
170                        next unless ($oldsel->contains($_));
171                        $newsel->insert($_);
172                    }   
173                }   
174            }
175        } 
176    }
177    return $newsel;
178}
179
180sub select_elements_with_given_tag_key_and_value_slow
181{
182    my ($oldsel, $e, $k, $v, $s) = @_;
183    my @values_wanted = split('\|', $v);
184    my $newsel = Set::Object->new();
185    my @keys_wanted = split('\|', $k);
186
187outer:
188    foreach ($oldsel->members())
189    {   
190        next if defined($e) and ref($_) ne $e; 
191        # determine whether we're comparing against the tags of the object
192        # itself or the tags selected with the "s" attribute.
193        my $tagsets;
194        if ($s eq "way")
195        {   
196            $tagsets = []; 
197            foreach my $way(@{$_->{"ways"}})
198            {   
199                push(@$tagsets, $way->{"tags"});
200            }   
201        }   
202        else
203        {   
204            $tagsets = [ $_->{"tags"} ];
205        }   
206
207        foreach my $key(@keys_wanted)
208        {   
209            foreach my $value(@values_wanted)
210            {   
211                foreach my $tagset(@$tagsets)
212                {   
213                    my $keyval = $tagset->{$k};
214                    if (($value eq '~' and !defined($keyval)) or
215                        ($value eq $keyval and defined($keyval)))
216                    {   
217                        $newsel->insert($_);
218                        next outer;
219                    }   
220                }   
221            }   
222        }   
223    } 
224   
225    return $newsel;
226}
227
228# this implements a very simple proximity selection. it works only for nodes and
229# draws an imaginary box around the node. then it checks all "used" boxes in the
230# same proximity class and unselects the object if a collision is detected.
231#
232# otherwise, the object remains selected and its box is stored.
233#
234# there are many FIXMEs:
235# 1. the box is computed based on lat/lon so will have different sizes on the map
236#    at different latitudes.
237# 2. any object that is selected is considered to have "used" its box. this mechanism
238#    only works when the proximity filter is on the last selection rule (which then
239#    only contains drawing code). If subsequent rules further reduce the object set,
240#    then the boxes are "used" nonetheless.
241# 3. the order in which the objects are processed is more or less random (as the
242#    storage is backed by a perl hash). it will be identical for identical input
243#    data, but as soon as input data varies a bit, the order might change completely.
244
245sub select_proximity
246{
247    my ($oldsel,$hp, $vp, $pc) = @_;
248    my $newsel = Set::Object->new();
249    $pc = "default" if ($pc eq "");
250    foreach ($oldsel->members())
251    {
252        # proximity stuff currently only works for nodes; copy others
253        if (ref($_) ne "node")
254        {
255            $newsel->insert($_);
256            next;
257        }
258       
259        my $bottom = $_->{'lat'} - $hp;
260        my $left = $_->{'lon'} - $vp;
261        my $top = $_->{'lat'} + $hp;
262        my $right = $_->{'lon'} + $vp;
263        my $intersect = 0;
264
265        foreach my $ub(@{$used_boxes->{$pc}})
266        {
267            if ((($ub->[0] > $bottom && $ub->[0] < $top) || ($ub->[2] > $bottom && $ub->[2] < $top) || ($ub->[0] <= $bottom && $ub->[2] >= $top)) &&
268               (($ub->[1] > $left && $ub->[1] < $right) || ($ub->[3] > $left && $ub->[3] < $right) || ($ub->[1] <= $left && $ub->[3] >= $right)))
269            {
270                # intersection detected; skip this object.
271                $intersect = 1;
272                # debug("object skipped due to collision in class '$pc'");
273                last;
274            }
275        }
276        next if ($intersect);
277        $newsel->insert($_);
278        #debug("object added in class '$pc'");
279        push(@{$used_boxes->{$pc}}, [ $bottom, $left, $top, $right ]);
280    }
281    delete $used_boxes->{$pc} if ($pc eq "default");
282    return $newsel;
283}
284
285# this implements a minimum size selection. it selects all objects whose bounding
286# box circumference exceeds the specified number.
287#
288# formula taken from osmarender.xsl, where it states
289# <!--
290#    cirfer = T + (N * [1.05 - ([t - 5] / 90)])
291#    T Latitude difference N Longitude difference t absolute Latitude
292#    The formula interpolates a cosine function with +10% error at the poles/equator and -10% error in the north Italy.
293# -->
294#
295# TODO: optionally replace with proper area computation? store computed area?
296
297sub select_minsize
298{
299    my ($oldsel,$minsize) = @_;
300    my $newsel = Set::Object->new();
301    foreach ($oldsel->members())
302    {
303        # minsize stuff currently only works for ways; copy others
304        if (ref($_) ne "way")
305        {
306            $newsel->insert($_);
307            next;
308        }
309
310        my ($minlat, $minlon, $maxlat, $maxlon);
311        foreach (@{$_->{"nodes"}})
312        {
313            $minlat = $_->{"lat"} if (!defined($minlat) or $_->{"lat"}<$minlat);
314            $minlon = $_->{"lon"} if (!defined($minlon) or $_->{"lon"}<$minlon);
315            $maxlat = $_->{"lat"} if (!defined($maxlat) or $_->{"lat"}>$maxlat);
316            $maxlon = $_->{"lon"} if (!defined($maxlon) or $_->{"lon"}>$maxlon);
317        }
318        next unless defined($minlat);
319        my $cirfer = ($maxlat-$minlat) + (($maxlon-$minlon) * (1.05-(($maxlat-5) / 90)));
320        $newsel->insert($_) if ($cirfer > $minsize);
321    }
322    return $newsel;
323}
324
3251;
Note: See TracBrowser for help on using the repository browser.