line
stmt
bran
cond
sub
pod
time
code
1
=head1 NAME
2
3
SVG::Plot - a simple module to take one or more sets of x,y points and plot them on a plane
4
5
=head1 SYNOPSIS
6
7
use SVG::Plot;
8
my $points = [ [0, 1, 'http://uri/'], [2, 3, '/uri/foo.png'] ];
9
my $plot = SVG::Plot->new(
10
points => $points,
11
debug => 0,
12
scale => 0.025,
13
max_width => 800,
14
max_height => 400,
15
point_size => 3,
16
point_style => {
17
fill => 'blue',
18
stroke => 'yellow',
19
},
20
line => 'follow',
21
margin => 6,
22
);
23
24
# -- or --
25
$plot->points($points);
26
$plot->scale(4);
27
28
print $plot->plot;
29
30
=head1 DESCRIPTION
31
32
a very simple module which allows you to give one or more sets of points [x co-ord, y co-ord and optional http uri]) and plot them in SVG.
33
34
$plot->points($points) where $points is a reference to an array of array references.
35
36
see B for a list of parameters you can give to the plot. (overriding the styles on the ponts; sizing a margin; setting a scale; optionally drawing a line ( line => 'follow' ) between the points in the order they are specified.
37
38
=cut
39
40
package SVG::Plot;
41
42
our $VERSION = '0.06';
43
3
3
1888
use strict;
3
4
3
130
44
3
3
2855
use SVG;
3
53540
3
21
45
3
3
3214
use Carp qw( croak );
3
6
3
198
46
3
3
3353
use Algorithm::Points::MinimumDistance;
3
2839
3
121
47
48
3
3
2873
use Class::MethodMaker new_hash_init => 'new', get_set => [ qw( debug grid scale points pointsets image point_style point_size min_point_size max_point_size margin line line_style max_width max_height svg_options) ];
3
62332
3
37
49
50
=head1 METHODS
51
52
=over 4
53
54
=item B
55
56
use SVG::Plot;
57
58
# Simple use - single set of points, all in same style.
59
my $points = [ [0, 1, 'http://uri/'], [2, 3, '/uri/foo.png'] ];
60
my $plot = SVG::Plot->new(
61
points => \@points,
62
point_size => 3,
63
point_style => {
64
fill => 'blue',
65
stroke => 'yellow',
66
},
67
line => 'follow',
68
debug => 0,
69
scale => 0.025,
70
max_width => 800,
71
max_height => 400,
72
margin => 6,
73
);
74
75
# Prepare to plot two sets of points, in distinct styles.
76
my $pubs = [
77
[ 522770, 179023, "http://example.com/?Andover_Arms" ],
78
[ 522909, 178232, "http://example.com/?Blue Anchor" ] ];
79
my $stations = [
80
[ 523474, 178483, "http://example.com/?Hammersmith" ] ];
81
my $pointsets = [ { points => $pubs,
82
point_size => 3,
83
point_style => { fill => "blue" }
84
},
85
{ points => $stations,
86
point_size => 5,
87
point_style => { fill => "red" }
88
} ];
89
my $plot = SVG::Plot->new(
90
pointsets => $pointsets,
91
scale => 0.025,
92
max_width => 800,
93
max_height => 400,
94
);
95
96
To pass options through to L, use the C parameter:
97
98
SVG::Plot->new( points => $points,
99
svg_options => { -nocredits => 1 }
100
);
101
102
You can define the boundaries of the plot:
103
104
SVG::Plot->new(
105
grid => { min_x => 1,
106
min_y => 2,
107
max_x => 15,
108
max_y => 16 }
109
);
110
111
or
112
113
$plot->grid($grid)
114
115
This is like a viewbox onto the plane of the plot. If it's not
116
specified, the module works out the viewbox from the highest and
117
lowest X and Y co-ordinates in the list(s) of points.
118
119
Note that the actual margin will be half of the value set
120
in C, since half of it goes to each side.
121
122
If C and/or C is set then C will be
123
reduced if necessary in order to keep the width down.
124
125
If C is set to true then debugging information is emitted as
126
warnings.
127
128
If C is set to C then
129
L will be used to make the point
130
circles as large as possible without overlapping, within the
131
constraints of C (which defaults to 1) and
132
C (which defaults to 10). Note that if you have multiple
133
pointsets then the point circle sizes will be worked out I.
134
135
All arguments have get_set accessors like so:
136
137
$plot->point_size(3);
138
139
The C, C attributes of the SVG::Plot object
140
will be used as defaults for any pointsets that don't have their own
141
style set.
142
143
=cut
144
145
=item B
146
147
print $plot->plot;
148
149
C will croak if the object has a C or C
150
attribute that is smaller than its C attribute, since this is
151
impossible.
152
153
=cut
154
155
sub plot {
156
5
5
1
9928
my $self = shift;
157
5
157
my $points = $self->points;
158
5
180
my $pointsets = $self->pointsets;
159
5
50
33
49
croak "no points to plot!" unless ( $points or $pointsets );
160
5
150
my $grid = $self->grid;
161
162
5
50
50
if (not $grid) {
163
5
17
$grid = $self->work_out_grid;
164
}
165
166
5
100
147
my $scale = $self->scale || 10;
167
5
50
197
my $m = $self->margin || 10;
168
169
# Reduce scale if necessary to fit to width constraint.
170
5
100
191
if ( $self->max_width ) {
171
1
37
my $max_plot_width = $self->max_width - $m; # Account for margin
172
1
50
11
croak "max_width must be larger than margin"
173
if $max_plot_width <= 0;
174
1
3
my $x_extent = $grid->{max_x} - $grid->{min_x};
175
1
3
my $max_width_scale = $max_plot_width / $x_extent;
176
1
50
6
$scale = $max_width_scale if $scale > $max_width_scale;
177
}
178
179
# Reduce scale further if necessary to fit to height constraint.
180
5
50
175
if ( $self->max_height ) {
181
0
0
my $max_plot_height = $self->max_height - $m; # Account for margin
182
0
0
0
croak "max_height must be larger than margin"
183
if $max_plot_height <= 0;
184
0
0
my $y_extent = $grid->{max_y} - $grid->{min_y};
185
0
0
my $max_height_scale = $max_plot_height / $y_extent;
186
0
0
0
$scale = $max_height_scale if $scale > $max_height_scale;
187
}
188
189
5
65
my $h = int(($grid->{max_y} - $grid->{min_y})*$scale);
190
5
14
my $w = int(($grid->{max_x} - $grid->{min_x})*$scale);
191
192
5
100
147
my $svg = SVG->new(
193
width => $w + $m,
194
height => $h + $m,
195
5
11
%{ $self->svg_options || {} },
196
);
197
198
5
50
1622
if (my $map = $self->image) {
199
0
0
my $img = $svg->image(
200
x=>0, y=>0,
201
'-href'=>$map, #may also embed SVG, e.g. "image.svg"
202
id=>'image_1'
203
);
204
}
205
206
# Process each pointset.
207
5
47
my @pointset_data;
208
209
5
50
142
if ( $self->points ) {
210
5
175
push @pointset_data, { points => $self->points,
211
point_size => $self->point_size,
212
min_point_size => $self->min_point_size,
213
max_point_size => $self->max_point_size,
214
point_style => $self->point_style,
215
line => $self->line,
216
line_style => $self->line_style };
217
}
218
219
5
50
213
foreach my $pointset ( @{$self->pointsets || []} ) {
5
141
220
0
0
push @pointset_data, $pointset;
221
}
222
223
5
191
my %defaults = ( point_size => $self->point_size,
224
min_point_size => $self->min_point_size,
225
max_point_size => $self->max_point_size,
226
point_style => $self->point_style );
227
228
5
109
foreach my $dataset ( @pointset_data ) {
229
5
30
$self->_plot_pointset( svg => $svg,
230
margin => $m,
231
grid => $grid,
232
scale => $scale,
233
%defaults, # can be overridden by %$dataset
234
%$dataset );
235
}
236
237
5
19
return $svg->xmlify;
238
}
239
240
# Adds a pointset to the SVG plot - pass in args svg, margin, grid, scale,
241
# points, point_size, min_point_size, max_point_size, point_style,
242
# line, line_style.
243
sub _plot_pointset {
244
5
5
27
my ($self, %args) = @_;
245
5
50
58
my $points = $args{points} or croak "no points in pointset!";
246
5
50
16
scalar @$points or croak "no points in pointset!";
247
5
50
15
my $svg = $args{svg} or croak "no SVG object passed";
248
5
50
14
my $scale = $args{scale} or croak "no scale passed";
249
5
50
31
my $point_style = $args{point_style} || { stroke => 'red',
250
fill => 'white' };
251
252
5
17
my $z = $svg->tag( 'g',
253
id => 'group_'.$self->random_id,
254
style => $point_style
255
);
256
257
5
320
my $point_size = $args{point_size};
258
5
100
66
27
if ( $point_size && $point_size eq "AUTO" ) {
259
4
100
16
my $min_size = $args{min_point_size} || 1;
260
4
100
16
my $max_size = $args{max_point_size} || 10;
261
# Make sure we don't send URIs to A::P::MD
262
4
6
my @coords = map { [ $_->[0], $_->[1] ] } @$points;
15
34
263
4
25
my $boxsize = 1 + sprintf("%d", $max_size/$scale);
264
4
26
my $dists = Algorithm::Points::MinimumDistance->new(
265
points => \@coords,
266
boxsize => $boxsize );
267
4
3799
my $min_dist = $dists->min_distance;
268
4
70
my $auto_size = sprintf("%d", $scale*$min_dist/2);
269
4
14
$point_size = $auto_size;
270
4
100
66
24
if ( $min_size and $point_size < $min_size ) {
271
1
2
$point_size = $min_size;
272
}
273
4
100
66
58
if ( $max_size and $point_size > $max_size ) {
274
1
12
$point_size = $max_size;
275
}
276
}
277
278
5
100
14
$point_size ||= 3;
279
5
7
my $plotted;
280
281
5
17
foreach (@$points) {
282
# adding a margin ...
283
17
1696
my $halfm = $args{margin} / 2;
284
285
17
31
my ($x,$y) = ($_->[0],$_->[1]);
286
17
66
58
my $href = $_->[2] || $self->random_id;
287
288
# svg is upside-down
289
17
56
$x = int(($x - $args{grid}->{min_x})*$scale) + $halfm;
290
17
28
$y = int(($args{grid}->{max_y} - $y)*$scale) + $halfm;
291
292
17
40
push @$plotted, [$x,$y,$href];
293
17
31
my $id = $self->random_id;
294
17
50
565
warn("anchor_$id") if $self->debug;;
295
296
17
208
$z->anchor(id => "anchor_".$id,
297
-href => $href,
298
-target => 'new_window_0')->circle(
299
cx => $x, cy => $y,
300
r => $point_size,
301
id => 'dot_'.$id,
302
);
303
}
304
305
5
50
749
if (my $line = $args{line}) {
306
0
0
my $style = $args{line_style};
307
0
0
0
$style ||= { 'stroke-width' => 2, stroke => 'blue' };
308
309
0
0
0
if ($line eq 'follow') {
310
0
0
for my $n (0..($#{$plotted}-1)) {
0
0
311
0
0
my $p1 = $plotted->[$n];
312
0
0
my $p2 = $plotted->[$n+1];
313
0
0
my $tag = $svg->line(
314
id => $self->random_id,
315
x1 => $p1->[0], y1 => $p1->[1],
316
x2 => $p2->[0], y2 => $p2->[1],
317
style => $style
318
);
319
}
320
}
321
}
322
}
323
324
sub work_out_grid {
325
5
5
0
8
my $self = shift;
326
5
140
my $all_points = $self->points;
327
5
169
my $pointsets = $self->pointsets;
328
329
5
50
42
if ( $pointsets ) {
330
0
0
foreach my $pointset ( map { $_->{points} } @$pointsets ) {
0
0
331
0
0
foreach my $point ( @$pointset ) {
332
0
0
push @$all_points, $point;
333
}
334
}
335
}
336
337
5
10
my $start = $all_points->[0];
338
5
8
my ($lx,$ly,$hx,$hy);
339
5
9
$lx = $start->[0];
340
5
7
$hx = $lx;
341
5
6
$ly = $start->[1];
342
5
6
$hy = $ly;
343
344
5
11
foreach (@$all_points) {
345
346
17
100
37
$lx = $_->[0] if ($_->[0] <= $lx);
347
17
100
33
$ly = $_->[1] if ($_->[1] <= $ly);
348
17
100
45
$hx = $_->[0] if ($_->[0] >= $hx);
349
17
100
41
$hy = $_->[1] if ($_->[1] >= $hy);
350
}
351
return {
352
5
31
min_x => $lx,
353
max_x => $hx,
354
min_y => $ly,
355
max_y => $hy
356
};
357
}
358
359
sub random_id {
360
37
37
0
79
my @t = (0..9);
361
37
61
return '_:id'.join '', (map { @t[rand @t] } 0..6);
259
726
362
}
363
364
=back
365
366
=cut
367
368
1;
369
370
=head1 NOTES
371
372
this is an early draft, released mostly so Kake can use it in OpenGuides without having non-CPAN dependencies.
373
374
for an example of what one should be able to do with this, see http://space.frot.org/rdf/tubemap.svg ... a better way of making meta-information between the lines, some kind of matrix drawing; cf the grubstreet link below, different styles according to locales, sets, conceptual contexts...
375
376
it would be fun to supply access to different plotting algorithms, not just for the cartesian plane; particularly the buckminster fuller dymaxion map; cf Geo::Dymaxion, when that gets released (http://iconocla.st/hacks/dymax/ )
377
378
to see work in progress, http://un.earth.li/~kake/cgi-bin/plot2.cgi?cat=Pubs&cat=Restaurants&cat=Tube&colour_diff_this=loc&action=display
379
380
=head1 BUGS
381
382
possibly. this is alpha in terms of functionality, beta in terms of code; the API won't break backwards, though.
383
384
385
=head1 AUTHOR
386
387
Jo Walsh ( jo@london.pm.org )
388
Kate L Pugh ( kake@earth.li )
389
390
=cut
391
392
393