File Coverage

blib/lib/SVG/Grid.pm

Criterion	Covered	Total	%
statement	106	109	97.2
branch	7	10	70.0
condition	21	40	52.5
subroutine	15	16	93.7
pod	7	9	77.7
total	156	184	84.7

line	stmt	bran	cond	sub	pod	time	code
1							package SVG::Grid;
2
3	2			2		44551	use strict;
	2					7
	2					81
4	2			2		18	use warnings;
	2					7
	2					94
5	2			2		17	use warnings qw(FATAL utf8);
	2					10
	2					129
6
7	2			2		946	use Moo;
	2					23773
	2					14
8
9	2			2		4305	use SVG;
	2					32866
	2					68
10
11	2			2		4573	use Types::Standard qw/Any Int HashRef Str/;
	2					163509
	2					35
12
13							has cell_height =>
14							(
15							default => sub {return 40},
16							is => 'rw',
17							isa => Int,
18							required => 0,
19							);
20
21							has cell_width =>
22							(
23							default => sub {return 40},
24							is => 'rw',
25							isa => Int,
26							required => 0,
27							);
28
29							has colors =>
30							(
31							default => sub {return {} },
32							is => 'rw',
33							isa => HashRef,
34							required => 0,
35							);
36
37							has height =>
38							(
39							is => 'rw',
40							isa => Int,
41							required => 0,
42							);
43
44							has output_file_name =>
45							(
46							default => sub{return ''},
47							is => 'rw',
48							isa => Str,
49							required => 0,
50							);
51
52							has style =>
53							(
54							default => sub {return {} },
55							is => 'rw',
56							isa => HashRef,
57							required => 0,
58							);
59
60							has svg =>
61							(
62							is => 'rw',
63							isa => Any,
64							required => 0,
65							);
66
67							has x_cell_count =>
68							(
69							default => sub {return 30},
70							is => 'rw',
71							isa => Int,
72							required => 0,
73							);
74
75							has x_offset =>
76							(
77							default => sub {return 40},
78							is => 'rw',
79							isa => Int,
80							required => 0,
81							);
82
83							has width =>
84							(
85							is => 'rw',
86							isa => Int,
87							required => 0,
88							);
89
90							has y_cell_count =>
91							(
92							default => sub {return 30},
93							is => 'rw',
94							isa => Int,
95							required => 0,
96							);
97
98							has y_offset =>
99							(
100							default => sub {return 40},
101							is => 'rw',
102							isa => Int,
103							required => 0,
104							);
105
106							our $VERSION = '1.05';
107
108							# ------------------------------------------------
109
110							sub BUILD
111							{
112	1			1	0	75	my($self) = @_;
113
114	1					26	$self -> colors
115							({
116							black => 'rgb( 0, 0, 0)',
117							blue => 'rgb( 0, 0, 255)',
118							dimgray => 'rgb(105, 105, 105)',
119							indianred => 'rgb(205, 92, 92)',
120							red => 'rgb(255, 0, 0)',
121							silver => 'rgb(192, 192, 192)',
122							white => 'rgb(255, 255, 255)',
123							});
124	1					56	$self -> style
125							({
126							'fill-opacity' => 0,
127							font => 'Arial',
128							'font-size' => 14,
129							'font-weight' => 'normal',
130							stroke => 'rgb(0, 0, 0)',
131							'stroke-width' => 1,
132							});
133	1					38	$self -> width
134							(
135							$self -> x_cell_count * $self -> cell_width
136							+ 2 * $self -> x_offset
137							+ 2 * $self -> cell_width
138							);
139	1					102	$self -> height
140							(
141							$self -> y_cell_count * $self -> cell_height
142							+ 2 * $self -> y_offset
143							+ 2 * $self -> cell_height
144							);
145	1					99	$self -> svg(SVG -> new(width => $self -> width, height => $self -> height) );
146
147							} # End of BUILD.
148
149							# ----------------------------------------------
150
151							sub frame
152							{
153	1			1	1	1896	my($self, %options) = @_;
154	1					20	my($frame_x) = [0, $self -> width - 1, $self -> width - 1, 0, 0];
155	1					24	my($frame_y) = [0, 0, $self -> height - 1, $self -> height - 1, 0];
156	1					21	my($points) = $self -> svg -> get_path
157							(
158							-type => 'polyline',
159							x => $frame_x,
160							y => $frame_y,
161							);
162	1					57	my($defaults) = $self -> _get_defaults(%options);
163	1					14	my($id) = 'frame_' . $$frame_x[2] . '_' . $$frame_y[2]; # Try to make it unique.
164
165							$self -> svg -> polyline
166							(
167							%$points,
168							id => $id,
169							style =>
170							{
171	1					17	%{$self -> style},
172							'fill-opacity' => $$defaults{fill_opacity},
173							stroke => $$defaults{stroke},
174							'stroke-width' => $$defaults{stroke_width},
175							}
176	1					16	);
177
178							} # End of frame.
179
180							# ----------------------------------------------
181
182							sub _get_defaults
183							{
184	18			18		37	my($self, %options) = @_;
185
186							return
187							{
188							fill => $options{fill} \|\| ${$self -> style}{fill} \|\| 'rgb(205, 92, 92)', # Aka indianred.
189							fill_opacity => $options{'fill-opacity'} \|\| ${$self -> style}{'fill-opacity'} \|\| 0,
190							font_size => $options{'font-size'} \|\| ${$self -> style}{'font-size'} \|\| 14,
191							font_weight => $options{'font-weight'} \|\| $options{style}{'font-weight'} \|\| 'normal',
192							stroke => $options{stroke} \|\| ${$self -> colors}{dimgray} \|\| 'rgb(105, 105, 105)', # Aka dimgray.
193							stroke_width => $options{'stroke-width'} \|\| ${$self -> style}{'stroke-width'} \|\| 1,
194	18		50			40	text_color => $options{text_color} \|\| ${$self -> colors}{blue} \|\| 'rgb( 0, 0, 255)', # Aka blue.
			50
			50
			50
			50
			50
			50
195							};
196
197							} # End of _get_defaults.
198
199							# ----------------------------------------------
200
201							sub grid
202							{
203	1			1	1	94	my($self, %options) = @_;
204	1					13	my($count) = 0;
205	1					4	my($defaults) = $self -> _get_defaults(%options);
206	1					22	my($limit) = int( ($self -> width - 2 * $self -> x_offset) / $self -> cell_width);
207
208	1					35	my(%opts);
209
210	1					14	for (my $i = $self -> x_offset; $i <= ($self -> width - $self -> cell_width); $i += $self -> cell_width)
211							{
212	6					491	$count++;
213
214							# Draw vertical lines.
215
216							$self -> svg -> line
217							(
218							id => "grid_x_$i", # Try to make it unique.
219							x1 => $i,
220							y1 => $self -> cell_height,
221							x2 => $i,
222							y2 => $self -> height - $self -> y_offset - 1,
223							style =>
224							{
225	6					334	%{$self -> style},
226							stroke => $$defaults{stroke},
227							'stroke-width' => $$defaults{stroke_width},
228							}
229	6					75	);
230
231							# This 'if' stops the x-axis labels appearing on top/bottom of the y-axis labels.
232
233	6	100	100			480	if ( ($count > 1) && ($count < $limit) )
234							{
235							# Add x-axis labels across the top.
236
237	3					5	%opts = ();
238	3					7	$opts{x} = $i + $$defaults{font_size};
239	3					51	$opts{y} = $self -> y_offset + 2 * $$defaults{font_size};
240	3					16	$opts{stroke} = $$defaults{text_color};
241	3					4	$opts{text} = $count - 1;
242
243	3					10	$self -> text(%opts);
244
245							# Add x-axis labels across the bottom.
246
247	3					273	%opts = ();
248	3					6	$opts{x} = $i + $$defaults{font_size};
249	3					49	$opts{y} = $self -> height - $self -> y_offset - $$defaults{font_size};
250	3					59	$opts{stroke} = $$defaults{text_color};
251	3					5	$opts{text} = $count - 1;
252
253	3					7	$self -> text(%opts);
254							}
255							}
256
257	1					33	$count = 0;
258	1					13	$limit = int( ($self -> height - 2 * $self -> y_offset) / $self -> cell_height);
259
260	1					44	for (my $i = $self -> y_offset; $i <= ($self -> height - $self -> cell_height); $i += $self -> cell_height)
261							{
262	6					590	$count++;
263
264							# Draw horizontal lines.
265
266							$self -> svg -> line
267							(
268							id => "grid_y_$i", # Try to make it unique.
269							x1 => $self -> x_offset,
270							y1 => $i,
271							x2 => $self -> width - $self -> x_offset - 1,
272							y2 => $i,
273							style =>
274							{
275	6					328	%{$self -> style},
276							stroke => $$defaults{stroke},
277							'stroke-width' => $$defaults{stroke_width},
278							}
279	6					85	);
280
281							# This 'if' stops the y-axis labels appearing to the left/right of the x-axis labels.
282
283	6	100	100			487	if ( ($count > 1) && ($count < $limit) )
284							{
285							# Add y-axis labels down the left.
286
287	3					6	%opts = ();
288	3					47	$opts{x} = $self -> x_offset + $$defaults{font_size};
289	3					17	$opts{y} = $i + 2 * $$defaults{font_size};
290	3					6	$opts{stroke} = $$defaults{text_color};
291	3					4	$opts{text} = $count - 1;
292
293	3					9	$self -> text(%opts);
294
295							# Add y-axis labels down the right.
296
297	3					253	%opts = ();
298	3					46	$opts{x} = $self -> width - $self -> x_offset - 2 * $$defaults{font_size};
299	3					58	$opts{y} = $i + 2 * $$defaults{font_size};
300	3					4	$opts{stroke} = $$defaults{text_color};
301	3					5	$opts{text} = $count - 1;
302
303	3					11	$self -> text(%opts);
304							}
305							}
306
307							} # End of grid.
308
309							# ----------------------------------------------
310
311							sub image_link
312							{
313	1			1	1	49	my($self, %options) = @_;
314	1					7	my($image_id) = "image_$options{x}_$options{y}"; # Try to make it unique.
315							my(%anchor_options) =
316							(
317							-href => $options{href},
318							id => "anchor_$options{x}_$options{y}", # Try to make it unique.
319	1		50			14	-target => $options{target} \|\| '',
320							);
321	1	50	33			14	$anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
322
323							$self -> svg -> anchor(%anchor_options) -> image
324							(
325							-href => $options{image},
326							id => $image_id,
327							width => $self -> cell_width,
328							height => $self -> cell_height,
329							x => $self -> x_offset + $self -> cell_width * $options{x},
330							y => $self -> y_offset + $self -> cell_height * $options{y},
331	1					31	);
332
333	1					278	return $image_id;
334
335							} # End of image_link.
336
337							# ------------------------------------------------
338
339							sub report
340							{
341	0			0	0	0	my($self) = @_;
342
343	0					0	print sprintf("x_cell_count: %d. cell_width: %d. x_offset: %d. width: %d. \n",
344							$self -> x_cell_count, $self -> cell_width, $self -> x_offset, $self -> width);
345	0					0	print sprintf("y_cell_count: %d. cell_height: %d. y_offset: %d. height: %d. \n",
346							$self -> y_cell_count, $self -> cell_height, $self -> y_offset, $self -> height);
347
348							} # End of report.
349
350							# ----------------------------------------------
351
352							sub rectangle_link
353							{
354	1			1	1	8	my($self, %options) = @_;
355	1					5	my($defaults) = $self -> _get_defaults(%options);
356							my(%anchor_options) =
357							(
358							-href => $options{href},
359							id => "anchor_$options{x}_$options{y}", # Try to make it unique.
360	1		50			15	-target => $options{target} \|\| '',
361							);
362	1	50	33			11	$anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
363	1					4	my($rectangle_id) = "rectangle_$options{x}_$options{y}"; # Try to make it unique.
364
365							$self -> svg -> anchor(%anchor_options) -> rectangle
366							(
367							fill => $$defaults{fill},
368							'fill-opacity' => $$defaults{fill_opacity} \|\| 0.5, # We use 0.5 since the default is 0.
369							id => $rectangle_id,
370							stroke => $$defaults{stroke},
371							'stroke-width' => $$defaults{stroke_width},
372							width => $self -> cell_width,
373							height => $self -> cell_height,
374							x => $self -> x_offset + $self -> cell_width * $options{x},
375							y => $self -> y_offset + $self -> cell_height * $options{y},
376	1		50			15	);
377
378	1					247	return $rectangle_id;
379
380							} # End of rectangle_link.
381
382							# ----------------------------------------------
383
384							sub text
385							{
386	14			14	1	315	my($self, %options) = @_;
387	14					32	my($defaults) = $self -> _get_defaults(%options);
388
389							$self -> svg -> text
390							(
391							id => "note_$options{x}_$options{y}", # Try to make it unique.
392							x => $options{x},
393							y => $options{y},
394							style =>
395							{
396	14					306	%{$self -> style},
397							'fill-opacity' => $$defaults{fill_opacity},
398							'font-size' => $$defaults{font_size},
399							'font-weight' => $$defaults{font_weight},
400							stroke => $$defaults{stroke},
401							}
402	14					287	) -> cdata($options{text});
403
404							} # End of text.
405
406							# ----------------------------------------------
407
408							sub text_link
409							{
410	1			1	1	8	my($self, %options) = @_;
411	1					4	my($defaults) = $self -> _get_defaults(%options);
412	1					12	my($half_font) = int($$defaults{font_size} / 2);
413							my(%anchor_options) =
414							(
415							-href => $options{href},
416							id => "anchor_$options{x}_$options{y}", # Try to make it unique.
417	1		50			7	-target => $options{target} \|\| '',
418							);
419	1	50	33			12	$anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
420	1					3	my($text_id) = "text_$options{x}_$options{y}"; # Try to make it unique.
421
422							$self -> svg -> anchor(%anchor_options) -> text
423							(
424							id => $text_id,
425							x => $self -> x_offset + $self -> cell_width * $options{x} + $$defaults{font_size} - $half_font,
426							y => $self -> y_offset + $self -> cell_height * $options{y} + $$defaults{font_size} + $half_font,
427							style =>
428							{
429	1					182	%{$self -> style},
430							'fill-opacity' => $$defaults{fill_opacity},
431							'font-size' => $$defaults{font_size},
432							'font-weight' => $$defaults{font_weight},
433							stroke => $$defaults{stroke},
434							'stroke-width' => $$defaults{stroke_width},
435
436							}
437	1					16	) -> cdata($options{text});
438
439	1					85	return $text_id;
440
441							} # End of text_link.
442
443							# ------------------------------------------------
444
445							sub write
446							{
447	1			1	1	612	my($self, %options) = @_;
448	1		33			4	my($file_name) = $options{output_file_name} \|\| $self -> output_file_name;
449
450	1					76	open(my $fh, '>:encoding(UTF-8)', $file_name);
451	1					233	print $fh $self -> svg -> xmlify;
452	1					4296	close $fh;
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							target => 'new_window',
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							target => 'new_window',
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							target => 'new_window',
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