File Coverage

blib/lib/SVG/Grid.pm

Criterion	Covered	Total	%
statement	107	110	97.2
branch	7	10	70.0
condition	21	40	52.5
subroutine	16	17	94.1
pod	7	9	77.7
total	158	186	84.9

line	stmt	bran	cond	sub	pod	time	code
1							package SVG::Grid;
2
3	2			2		31795	use strict;
	2					10
	2					43
4	2			2		7	use warnings;
	2					4
	2					45
5	2			2		6	use warnings qw(FATAL utf8);
	2					3
	2					82
6
7	2			2		399	use File::Slurper 'write_text';
	2					10990
	2					85
8
9	2			2		908	use Moo;
	2					19541
	2					9
10
11	2			2		4449	use SVG;
	2					24655
	2					13
12
13	2			2		2720	use Types::Standard qw/Any Int HashRef Str/;
	2					117129
	2					22
14
15							has cell_height =>
16							(
17							default => sub {return 40},
18							is => 'rw',
19							isa => Int,
20							required => 0,
21							);
22
23							has cell_width =>
24							(
25							default => sub {return 40},
26							is => 'rw',
27							isa => Int,
28							required => 0,
29							);
30
31							has colors =>
32							(
33							default => sub {return {} },
34							is => 'rw',
35							isa => HashRef,
36							required => 0,
37							);
38
39							has height =>
40							(
41							is => 'rw',
42							isa => Int,
43							required => 0,
44							);
45
46							has output_file_name =>
47							(
48							default => sub{return ''},
49							is => 'rw',
50							isa => Str,
51							required => 0,
52							);
53
54							has style =>
55							(
56							default => sub {return {} },
57							is => 'rw',
58							isa => HashRef,
59							required => 0,
60							);
61
62							has svg =>
63							(
64							is => 'rw',
65							isa => Any,
66							required => 0,
67							);
68
69							has x_cell_count =>
70							(
71							default => sub {return 30},
72							is => 'rw',
73							isa => Int,
74							required => 0,
75							);
76
77							has x_offset =>
78							(
79							default => sub {return 40},
80							is => 'rw',
81							isa => Int,
82							required => 0,
83							);
84
85							has width =>
86							(
87							is => 'rw',
88							isa => Int,
89							required => 0,
90							);
91
92							has y_cell_count =>
93							(
94							default => sub {return 30},
95							is => 'rw',
96							isa => Int,
97							required => 0,
98							);
99
100							has y_offset =>
101							(
102							default => sub {return 40},
103							is => 'rw',
104							isa => Int,
105							required => 0,
106							);
107
108							our $VERSION = '1.12';
109
110							# ------------------------------------------------
111
112							sub BUILD
113							{
114	1			1	0	74	my($self) = @_;
115
116	1					24	$self -> colors
117							({
118							black => 'rgb( 0, 0, 0)',
119							blue => 'rgb( 0, 0, 255)',
120							dimgray => 'rgb(105, 105, 105)',
121							indianred => 'rgb(205, 92, 92)',
122							red => 'rgb(255, 0, 0)',
123							silver => 'rgb(192, 192, 192)',
124							white => 'rgb(255, 255, 255)',
125							});
126	1					43	$self -> style
127							({
128							'fill-opacity' => 0,
129							font => 'Arial',
130							'font-size' => 14,
131							'font-weight' => 'normal',
132							stroke => 'rgb(0, 0, 0)',
133							'stroke-width' => 1,
134							});
135	1					37	$self -> width
136							(
137							$self -> x_cell_count * $self -> cell_width
138							+ 2 * $self -> x_offset
139							+ 2 * $self -> cell_width
140							);
141	1					103	$self -> height
142							(
143							$self -> y_cell_count * $self -> cell_height
144							+ 2 * $self -> y_offset
145							+ 2 * $self -> cell_height
146							);
147	1					101	$self -> svg(SVG -> new(width => $self -> width, height => $self -> height) );
148
149							} # End of BUILD.
150
151							# ----------------------------------------------
152
153							sub frame
154							{
155	1			1	1	2016	my($self, %options) = @_;
156	1					20	my($frame_x) = [0, $self -> width - 1, $self -> width - 1, 0, 0];
157	1					24	my($frame_y) = [0, 0, $self -> height - 1, $self -> height - 1, 0];
158	1					20	my($points) = $self -> svg -> get_path
159							(
160							-type => 'polyline',
161							x => $frame_x,
162							y => $frame_y,
163							);
164	1					59	my($defaults) = $self -> _get_defaults(%options);
165	1					14	my($id) = 'frame_' . $$frame_x[2] . '_' . $$frame_y[2]; # Try to make it unique.
166
167							$self -> svg -> polyline
168							(
169							%$points,
170							id => $id,
171							style =>
172							{
173	1					17	%{$self -> style},
174							'fill-opacity' => $$defaults{fill_opacity},
175							stroke => $$defaults{stroke},
176							'stroke-width' => $$defaults{stroke_width},
177							}
178	1					14	);
179
180							} # End of frame.
181
182							# ----------------------------------------------
183
184							sub _get_defaults
185							{
186	18			18		36	my($self, %options) = @_;
187
188							return
189							{
190							fill => $options{fill} \|\| ${$self -> style}{fill} \|\| 'rgb(205, 92, 92)', # Aka indianred.
191							fill_opacity => $options{'fill-opacity'} \|\| ${$self -> style}{'fill-opacity'} \|\| 0,
192							font_size => $options{'font-size'} \|\| ${$self -> style}{'font-size'} \|\| 14,
193							font_weight => $options{'font-weight'} \|\| $options{style}{'font-weight'} \|\| 'normal',
194							stroke => $options{stroke} \|\| ${$self -> colors}{dimgray} \|\| 'rgb(105, 105, 105)', # Aka dimgray.
195							stroke_width => $options{'stroke-width'} \|\| ${$self -> style}{'stroke-width'} \|\| 1,
196	18		50			38	text_color => $options{text_color} \|\| ${$self -> colors}{blue} \|\| 'rgb( 0, 0, 255)', # Aka blue.
			50
			50
			50
			50
			50
			50
197							};
198
199							} # End of _get_defaults.
200
201							# ----------------------------------------------
202
203							sub grid
204							{
205	1			1	1	98	my($self, %options) = @_;
206	1					2	my($count) = 0;
207	1					7	my($defaults) = $self -> _get_defaults(%options);
208	1					21	my($limit) = int( ($self -> width - 2 * $self -> x_offset) / $self -> cell_width);
209
210	1					33	my(%opts);
211
212	1					13	for (my $i = $self -> x_offset; $i <= ($self -> width - $self -> cell_width); $i += $self -> cell_width)
213							{
214	6					495	$count++;
215
216							# Draw vertical lines.
217
218							$self -> svg -> line
219							(
220							id => "grid_x_$i", # Try to make it unique.
221							x1 => $i,
222							y1 => $self -> cell_height,
223							x2 => $i,
224							y2 => $self -> height - $self -> y_offset - 1,
225							style =>
226							{
227	6					337	%{$self -> style},
228							stroke => $$defaults{stroke},
229							'stroke-width' => $$defaults{stroke_width},
230							}
231	6					84	);
232
233							# This 'if' stops the x-axis labels appearing on top/bottom of the y-axis labels.
234
235	6	100	100			508	if ( ($count > 1) && ($count < $limit) )
236							{
237							# Add x-axis labels across the top.
238
239	3					7	%opts = ();
240	3					4	$opts{x} = $i + $$defaults{font_size};
241	3					46	$opts{y} = $self -> y_offset + 2 * $$defaults{font_size};
242	3					16	$opts{stroke} = $$defaults{text_color};
243	3					6	$opts{text} = $count - 1;
244
245	3					10	$self -> text(%opts);
246
247							# Add x-axis labels across the bottom.
248
249	3					237	%opts = ();
250	3					13	$opts{x} = $i + $$defaults{font_size};
251	3					49	$opts{y} = $self -> height - $self -> y_offset - $$defaults{font_size};
252	3					58	$opts{stroke} = $$defaults{text_color};
253	3					4	$opts{text} = $count - 1;
254
255	3					7	$self -> text(%opts);
256							}
257							}
258
259	1					33	$count = 0;
260	1					12	$limit = int( ($self -> height - 2 * $self -> y_offset) / $self -> cell_height);
261
262	1					43	for (my $i = $self -> y_offset; $i <= ($self -> height - $self -> cell_height); $i += $self -> cell_height)
263							{
264	6					498	$count++;
265
266							# Draw horizontal lines.
267
268							$self -> svg -> line
269							(
270							id => "grid_y_$i", # Try to make it unique.
271							x1 => $self -> x_offset,
272							y1 => $i,
273							x2 => $self -> width - $self -> x_offset - 1,
274							y2 => $i,
275							style =>
276							{
277	6					320	%{$self -> style},
278							stroke => $$defaults{stroke},
279							'stroke-width' => $$defaults{stroke_width},
280							}
281	6					72	);
282
283							# This 'if' stops the y-axis labels appearing to the left/right of the x-axis labels.
284
285	6	100	100			444	if ( ($count > 1) && ($count < $limit) )
286							{
287							# Add y-axis labels down the left.
288
289	3					7	%opts = ();
290	3					53	$opts{x} = $self -> x_offset + $$defaults{font_size};
291	3					18	$opts{y} = $i + 2 * $$defaults{font_size};
292	3					6	$opts{stroke} = $$defaults{text_color};
293	3					4	$opts{text} = $count - 1;
294
295	3					9	$self -> text(%opts);
296
297							# Add y-axis labels down the right.
298
299	3					243	%opts = ();
300	3					49	$opts{x} = $self -> width - $self -> x_offset - 2 * $$defaults{font_size};
301	3					66	$opts{y} = $i + 2 * $$defaults{font_size};
302	3					6	$opts{stroke} = $$defaults{text_color};
303	3					3	$opts{text} = $count - 1;
304
305	3					7	$self -> text(%opts);
306							}
307							}
308
309							} # End of grid.
310
311							# ----------------------------------------------
312
313							sub image_link
314							{
315	1			1	1	42	my($self, %options) = @_;
316	1					5	my($image_id) = "image_$options{x}_$options{y}"; # Try to make it unique.
317							my(%anchor_options) =
318							(
319							-href => $options{href},
320							id => "anchor_$options{x}_$options{y}", # Try to make it unique.
321	1		50			8	-show => $options{show} \|\| 'new',
322							);
323	1	50	33			9	$anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
324
325							$self -> svg -> anchor(%anchor_options) -> image
326							(
327							-href => $options{image},
328							id => $image_id,
329							width => $self -> cell_width,
330							height => $self -> cell_height,
331							x => $self -> x_offset + $self -> cell_width * $options{x},
332							y => $self -> y_offset + $self -> cell_height * $options{y},
333	1					26	);
334
335	1					258	return $image_id;
336
337							} # End of image_link.
338
339							# ------------------------------------------------
340
341							sub report
342							{
343	0			0	0	0	my($self) = @_;
344
345	0					0	print sprintf("x_cell_count: %d. cell_width: %d. x_offset: %d. width: %d. \n",
346							$self -> x_cell_count, $self -> cell_width, $self -> x_offset, $self -> width);
347	0					0	print sprintf("y_cell_count: %d. cell_height: %d. y_offset: %d. height: %d. \n",
348							$self -> y_cell_count, $self -> cell_height, $self -> y_offset, $self -> height);
349
350							} # End of report.
351
352							# ----------------------------------------------
353
354							sub rectangle_link
355							{
356	1			1	1	8	my($self, %options) = @_;
357	1					4	my($defaults) = $self -> _get_defaults(%options);
358							my(%anchor_options) =
359							(
360							-href => $options{href},
361							id => "anchor_$options{x}_$options{y}", # Try to make it unique.
362	1		50			46	-show => $options{show} \|\| 'new',
363							);
364	1	50	33			9	$anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
365	1					5	my($rectangle_id) = "rectangle_$options{x}_$options{y}"; # Try to make it unique.
366
367							$self -> svg -> anchor(%anchor_options) -> rectangle
368							(
369							fill => $$defaults{fill},
370							'fill-opacity' => $$defaults{fill_opacity} \|\| 0.5, # We use 0.5 since the default is 0.
371							id => $rectangle_id,
372							stroke => $$defaults{stroke},
373							'stroke-width' => $$defaults{stroke_width},
374							width => $self -> cell_width,
375							height => $self -> cell_height,
376							x => $self -> x_offset + $self -> cell_width * $options{x},
377							y => $self -> y_offset + $self -> cell_height * $options{y},
378	1		50			32	);
379
380	1					270	return $rectangle_id;
381
382							} # End of rectangle_link.
383
384							# ----------------------------------------------
385
386							sub text
387							{
388	14			14	1	320	my($self, %options) = @_;
389	14					38	my($defaults) = $self -> _get_defaults(%options);
390
391							$self -> svg -> text
392							(
393							id => "note_$options{x}_$options{y}", # Try to make it unique.
394							x => $options{x},
395							y => $options{y},
396							style =>
397							{
398	14					235	%{$self -> style},
399							'fill-opacity' => $$defaults{fill_opacity},
400							'font-size' => $$defaults{font_size},
401							'font-weight' => $$defaults{font_weight},
402							stroke => $$defaults{stroke},
403							}
404	14					281	) -> cdata($options{text});
405
406							} # End of text.
407
408							# ----------------------------------------------
409
410							sub text_link
411							{
412	1			1	1	8	my($self, %options) = @_;
413	1					5	my($defaults) = $self -> _get_defaults(%options);
414	1					12	my($half_font) = int($$defaults{font_size} / 2);
415							my(%anchor_options) =
416							(
417							-href => $options{href},
418							id => "anchor_$options{x}_$options{y}", # Try to make it unique.
419	1		50			17	-show => $options{show} \|\| 'new',
420							);
421	1	50	33			7	$anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
422	1					4	my($text_id) = "text_$options{x}_$options{y}"; # Try to make it unique.
423
424							$self -> svg -> anchor(%anchor_options) -> text
425							(
426							id => $text_id,
427							x => $self -> x_offset + $self -> cell_width * $options{x} + $$defaults{font_size} - $half_font,
428							y => $self -> y_offset + $self -> cell_height * $options{y} + $$defaults{font_size} + $half_font,
429							style =>
430							{
431	1					162	%{$self -> style},
432							'fill-opacity' => $$defaults{fill_opacity},
433							'font-size' => $$defaults{font_size},
434							'font-weight' => $$defaults{font_weight},
435							stroke => $$defaults{stroke},
436							'stroke-width' => $$defaults{stroke_width},
437
438							}
439	1					19	) -> cdata($options{text});
440
441	1					91	return $text_id;
442
443							} # End of text_link.
444
445							# ------------------------------------------------
446
447							sub write
448							{
449	1			1	1	599	my($self, %options) = @_;
450	1		33			4	my($file_name) = $options{output_file_name} \|\| $self -> output_file_name;
451
452	1					20	write_text($file_name, $self -> svg -> xmlify);
453
454							} # End of write.
455
456							# ------------------------------------------------
457
458							1;
459
460							=pod
461
462							=encoding utf8
463
464							=head1 NAME
465
466							C - Address SVG images using cells of $n1 x $n2 pixels
467
468							=head1 Synopsis
469
470							This is scripts/synopsis.pl:
471
472							#!/usr/bin/env perl
473
474							use strict;
475							use utf8;
476							use warnings;
477
478							use SVG::Grid;
479
480							# ------------
481
482							my($cell_width) = 40;
483							my($cell_height) = 40;
484							my($x_cell_count) = 3;
485							my($y_cell_count) = 3;
486							my($x_offset) = 40;
487							my($y_offset) = 40;
488							my($svg) = SVG::Grid -> new
489							(
490							cell_width => $cell_width,
491							cell_height => $cell_height,
492							x_cell_count => $x_cell_count,
493							y_cell_count => $y_cell_count,
494							x_offset => $x_offset,
495							y_offset => $y_offset,
496							);
497
498							$svg -> frame('stroke-width' => 3);
499							$svg -> text
500							(
501							'font-size' => 20,
502							'font-weight' => '400',
503							text => 'Front Garden',
504							x => $svg -> x_offset, # Pixel co-ord.
505							y => $svg -> y_offset / 2, # Pixel co-ord.
506							);
507							$svg -> text
508							(
509							'font-size' => 14,
510							'font-weight' => '400',
511							text => '--> N',
512							x => $svg -> width - 2 * $svg -> cell_width, # Pixel co-ord.
513							y => $svg -> y_offset / 2, # Pixel co-ord.
514							);
515							$svg -> grid(stroke => 'blue');
516							$svg -> image_link
517							(
518							href => 'http://savage.net.au/Flowers/Chorizema.cordatum.html',
519							image => 'http://savage.net.au/Flowers/images/Chorizema.cordatum.0.jpg',
520							show => 'new',
521							title => 'MouseOver® an image',
522							x => 1, # Cell co-ord.
523							y => 2, # Cell co-ord.
524							);
525							$svg -> rectangle_link
526							(
527							href => 'http://savage.net.au/Flowers/Alyogyne.huegelii.html',
528							show => 'new',
529							title => 'MouseOver™ a rectangle',
530							x => 2, # Cell co-ord.
531							y => 3, # Cell co-ord.
532							);
533							$svg -> text_link
534							(
535							href => 'http://savage.net.au/Flowers/Aquilegia.McKana.html',
536							stroke => 'rgb(255, 0, 0)',
537							show => 'new',
538							text => '3,1',
539							title => 'MouseOvér some text',
540							x => 3, # Cell co-ord.
541							y => 1, # Cell co-ord.
542							);
543							$svg -> write(output_file_name => 'data/synopsis.svg');
544
545							Output: L
546
547							See also scripts/*.pl.
548
549							=head1 Description
550
551							C allows you to I use cell co-ordinates (like a spreadsheet) to place items on
552							an L
553							refer to the position of a cell within a row and a column. You define these rows and columns when
554							you call the L method. Cell co-ordinates are numbered 1 .. N.
555
556							Here, I means all method calls except adding text via the L method. With
557							C, you use pixels locations so that the text can be placed anywhere. Pixel co-ordinates are
558							numbered 0 .. N.
559
560							Note: Objects of type C are not daughters of L
561
562							=head1 Distributions
563
564							This module is available as a Unix-style distro (*.tgz).
565
566							See L
567							for help on unpacking and installing distros.
568
569							=head1 Installation
570
571							Install L as you would any C module:
572
573							Run:
574
575							cpanm SVG::Grid
576
577							or run:
578
579							sudo cpan SVG::Grid
580
581							And then:
582
583							perl Makefile.PL
584							make (or dmake or nmake)
585							make test
586							make install
587
588							=head1 Constructor and Initialization
589
590							C is called as C<< my($svg) = SVG::Grid -> new(k1 => v1, k2 => v2, ...) >>.
591
592							It returns a new object of type C.
593
594							Key-value pairs accepted in the parameter list (see corresponding methods for details
595							[e.g. L]:
596
597							=over 4
598
599							=item o cell_height => $integer
600
601							The height of each cell, in pixels.
602
603							Default: 40.
604
605							=item o cell_width => $integer
606
607							The width of each cell, in pixels.
608
609							Default: 40.
610
611							=item o colors => $hashref
612
613							The set of default colors, so you don't have to provide a C parameter to various methods.
614
615							It also means you can refer to colors by their names, rather than the awkward C<'rgb($R, $G, $B)'>
616							structures that the L
617
618							Default:
619
620							$self -> colors
621							({
622							black => 'rgb( 0, 0, 0)',
623							blue => 'rgb( 0, 0, 255)',
624							dimgray => 'rgb(105, 105, 105)',
625							indianred => 'rgb(205, 92, 92)',
626							red => 'rgb(255, 0, 0)',
627							silver => 'rgb(192, 192, 192)',
628							white => 'rgb(255, 255, 255)',
629							});
630
631							=item o output_file_name =>
632
633							The name of the SVG file to write, if the L method is called.
634
635							Default: ''.
636
637							=item o style => $hashref
638
639							The default style to use, so you don't have to provide a C