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   31127 use strict;
  2         4  
  2         54  
4 2     2   10 use warnings;
  2         4  
  2         55  
5 2     2   10 use warnings qw(FATAL utf8);
  2         5  
  2         76  
6              
7 2     2   682 use Moo;
  2         20155  
  2         10  
8              
9 2     2   3135 use SVG;
  2         24548  
  2         10  
10              
11 2     2   2589 use Types::Standard qw/Any Int HashRef Str/;
  2         117133  
  2         21  
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.06';
107              
108             # ------------------------------------------------
109              
110             sub BUILD
111             {
112 1     1 0 73 my($self) = @_;
113              
114 1         24 $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         41 $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         34 $self -> width
134             (
135             $self -> x_cell_count * $self -> cell_width
136             + 2 * $self -> x_offset
137             + 2 * $self -> cell_width
138             );
139 1         97 $self -> height
140             (
141             $self -> y_cell_count * $self -> cell_height
142             + 2 * $self -> y_offset
143             + 2 * $self -> cell_height
144             );
145 1         96 $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 1992 my($self, %options) = @_;
154 1         19 my($frame_x) = [0, $self -> width - 1, $self -> width - 1, 0, 0];
155 1         22 my($frame_y) = [0, 0, $self -> height - 1, $self -> height - 1, 0];
156 1         20 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         13 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         14 );
177              
178             } # End of frame.
179              
180             # ----------------------------------------------
181              
182             sub _get_defaults
183             {
184 18     18   38 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 89 my($self, %options) = @_;
204 1         10 my($count) = 0;
205 1         4 my($defaults) = $self -> _get_defaults(%options);
206 1         20 my($limit) = int( ($self -> width - 2 * $self -> x_offset) / $self -> cell_width);
207              
208 1         34 my(%opts);
209              
210 1         13 for (my $i = $self -> x_offset; $i <= ($self -> width - $self -> cell_width); $i += $self -> cell_width)
211             {
212 6         469 $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         326 %{$self -> style},
226             stroke => $$defaults{stroke},
227             'stroke-width' => $$defaults{stroke_width},
228             }
229 6         71 );
230              
231             # This 'if' stops the x-axis labels appearing on top/bottom of the y-axis labels.
232              
233 6 100 100     482 if ( ($count > 1) && ($count < $limit) )
234             {
235             # Add x-axis labels across the top.
236              
237 3         7 %opts = ();
238 3         6 $opts{x} = $i + $$defaults{font_size};
239 3         56 $opts{y} = $self -> y_offset + 2 * $$defaults{font_size};
240 3         21 $opts{stroke} = $$defaults{text_color};
241 3         6 $opts{text} = $count - 1;
242              
243 3         14 $self -> text(%opts);
244              
245             # Add x-axis labels across the bottom.
246              
247 3         263 %opts = ();
248 3         5 $opts{x} = $i + $$defaults{font_size};
249 3         46 $opts{y} = $self -> height - $self -> y_offset - $$defaults{font_size};
250 3         57 $opts{stroke} = $$defaults{text_color};
251 3         4 $opts{text} = $count - 1;
252              
253 3         7 $self -> text(%opts);
254             }
255             }
256              
257 1         32 $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         473 $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         319 %{$self -> style},
276             stroke => $$defaults{stroke},
277             'stroke-width' => $$defaults{stroke_width},
278             }
279 6         82 );
280              
281             # This 'if' stops the y-axis labels appearing to the left/right of the x-axis labels.
282              
283 6 100 100     469 if ( ($count > 1) && ($count < $limit) )
284             {
285             # Add y-axis labels down the left.
286              
287 3         6 %opts = ();
288 3         44 $opts{x} = $self -> x_offset + $$defaults{font_size};
289 3         18 $opts{y} = $i + 2 * $$defaults{font_size};
290 3         4 $opts{stroke} = $$defaults{text_color};
291 3         5 $opts{text} = $count - 1;
292              
293 3         9 $self -> text(%opts);
294              
295             # Add y-axis labels down the right.
296              
297 3         248 %opts = ();
298 3         44 $opts{x} = $self -> width - $self -> x_offset - 2 * $$defaults{font_size};
299 3         57 $opts{y} = $i + 2 * $$defaults{font_size};
300 3         6 $opts{stroke} = $$defaults{text_color};
301 3         4 $opts{text} = $count - 1;
302              
303 3         7 $self -> text(%opts);
304             }
305             }
306              
307             } # End of grid.
308              
309             # ----------------------------------------------
310              
311             sub image_link
312             {
313 1     1 1 41 my($self, %options) = @_;
314 1         4 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     11 -target => $options{target} || '',
320             );
321 1 50 33     8 $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         16 );
332              
333 1         247 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 7 my($self, %options) = @_;
355 1         3 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     6 $anchor_options{-title} = $options{title} if ($options{title} && (length($options{title}) > 0) );
363 1         5 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         279 return $rectangle_id;
379              
380             } # End of rectangle_link.
381              
382             # ----------------------------------------------
383              
384             sub text
385             {
386 14     14 1 328 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         238 %{$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         279 ) -> 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         3 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     10 $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         166 %{$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         84 return $text_id;
440              
441             } # End of text_link.
442              
443             # ------------------------------------------------
444              
445             sub write
446             {
447 1     1 1 536 my($self, %options) = @_;
448 1   33     4 my($file_name) = $options{output_file_name} || $self -> output_file_name;
449              
450 1         49 open(my $fh, '>:encoding(UTF-8)', $file_name);
451 1         225 print $fh $self -> svg -> xmlify;
452 1         4142 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 image. These co-ordinates are in the form (x, y) = (integer, integer), where x and y
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. They are stand-alone objects.
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 module uses.
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