File Coverage

blib/lib/Graphics/GVG/SVG.pm
Criterion Covered Total %
statement 34 36 94.4
branch n/a
condition n/a
subroutine 12 12 100.0
pod n/a
total 46 48 95.8


line stmt bran cond sub pod time code
1             # Copyright (c) 2016 Timm Murray
2             # All rights reserved.
3             #
4             # Redistribution and use in source and binary forms, with or without
5             # modification, are permitted provided that the following conditions are met:
6             #
7             # * Redistributions of source code must retain the above copyright notice,
8             # this list of conditions and the following disclaimer.
9             # * Redistributions in binary form must reproduce the above copyright
10             # notice, this list of conditions and the following disclaimer in the
11             # documentation and/or other materials provided with the distribution.
12             #
13             # THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
14             # AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
15             # IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
16             # ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
17             # LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
18             # CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
19             # SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
20             # INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
21             # CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
22             # ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
23             # POSSIBILITY OF SUCH DAMAGE.
24             package Graphics::GVG::SVG;
25             $Graphics::GVG::SVG::VERSION = '0.3';
26             # ABSTRACT: Convert GVG into SVG
27 4     4   916293 use strict;
  4         7  
  4         94  
28 4     4   13 use warnings;
  4         4  
  4         82  
29 4     4   1472 use Moose;
  4         866463  
  4         22  
30 4     4   19784 use namespace::autoclean;
  4         15814  
  4         18  
31 4     4   1400 use Graphics::GVG::AST;
  4         350234  
  4         121  
32 4     4   1658 use Graphics::GVG::AST::Line;
  4         93755  
  4         110  
33 4     4   1467 use Graphics::GVG::AST::Circle;
  4         66956  
  4         98  
34 4     4   1348 use Graphics::GVG::AST::Ellipse;
  4         76949  
  4         109  
35 4     4   1433 use Graphics::GVG::AST::Glow;
  4         62939  
  4         96  
36 4     4   1330 use Graphics::GVG::AST::Polygon;
  4         152785  
  4         110  
37 4     4   1676 use Graphics::GVG::AST::Rect;
  4         79387  
  4         106  
38 4     4   868 use SVG;
  0            
  0            
39             use XML::LibXML;
40              
41              
42             has 'width' => (
43             is => 'ro',
44             isa => 'Int',
45             default => 400,
46             writer => '_set_width',
47             );
48             has 'height' => (
49             is => 'ro',
50             isa => 'Int',
51             default => 400,
52             writer => '_set_height',
53             );
54              
55             sub make_svg
56             {
57             my ($self, $ast) = @_;
58             my $svg = SVG->new(
59             width => $self->width,
60             height => $self->height,
61             );
62             my $group = $svg->group(
63             id => 'main_group',
64             );
65             $self->_ast_to_svg( $ast, $group );
66              
67             return $svg;
68             }
69              
70             sub make_gvg
71             {
72             my ($self, $svg_data) = @_;
73             my $xml = XML::LibXML->load_xml( string => $svg_data );
74              
75             my ($svg_tag) = $xml->getElementsByTagName( 'svg' );
76             my $width = $svg_tag->getAttribute( 'width' );
77             my $height = $svg_tag->getAttribute( 'height' );
78             # Ignore units
79             ($width) = $width =~ /\A(\d+)/x;
80             ($height) = $height =~ /\A(\d+)/x;
81             $self->_set_width( $width );
82             $self->_set_height( $height );
83              
84             my $ast = $self->_svg_to_ast( $xml );
85             return $ast;
86             }
87              
88             sub _svg_to_ast
89             {
90             my ($self, $xml) = @_;
91             my $main_group = $xml->getElementById( 'main_group' );
92             my $ast = Graphics::GVG::AST->new;
93              
94             $self->_svg_to_ast_handle_lines( $xml, $ast );
95             $self->_svg_to_ast_handle_circles( $xml, $ast );
96             $self->_svg_to_ast_handle_polygons( $xml, $ast );
97             $self->_svg_to_ast_handle_rects( $xml, $ast );
98             $self->_svg_to_ast_handle_ellipses( $xml, $ast );
99              
100             return $ast;
101             }
102              
103             sub _svg_to_ast_handle_lines
104             {
105             my ($self, $xml, $ast) = @_;
106             my @nodes = $xml->getElementsByTagName( 'line' );
107            
108             foreach my $node (@nodes) {
109             my $x1 = $self->_svg_coord_convert_x( $node->getAttribute( 'x1' ) );
110             my $y1 = $self->_svg_coord_convert_y( $node->getAttribute( 'y1' ) );
111             my $x2 = $self->_svg_coord_convert_x( $node->getAttribute( 'x2' ) );
112             my $y2 = $self->_svg_coord_convert_y( $node->getAttribute( 'y2' ) );
113             my $cmd = Graphics::GVG::AST::Line->new({
114             x1 => $x1,
115             y1 => $y1,
116             x2 => $x2,
117             y2 => $y2,
118             color => $self->_get_color_for_element( $node ),
119             });
120              
121             my $push_to = $self->_svg_decide_type( $ast, $node );
122             $push_to->push_command( $cmd );
123             }
124             return;
125             }
126              
127             sub _svg_to_ast_handle_circles
128             {
129             my ($self, $xml, $ast) = @_;
130             my @nodes = $xml->getElementsByTagName( 'circle' );
131              
132             foreach my $node (@nodes) {
133             my $cmd = Graphics::GVG::AST::Circle->new({
134             cx => $self->_svg_coord_convert_x( $node->getAttribute( 'cx' ) ),
135             cy => $self->_svg_coord_convert_y( $node->getAttribute( 'cy' ) ),
136             # Arbitrarily use width
137             r => $self->_svg_convert_width( $node->getAttribute( 'r' ) ),
138             color => $self->_get_color_for_element( $node ),
139             });
140              
141             my $push_to = $self->_svg_decide_type( $ast, $node );
142             $push_to->push_command( $cmd );
143             }
144             return;
145             }
146              
147             sub _svg_to_ast_handle_polygons
148             {
149             my ($self, $xml, $ast) = @_;
150             my @nodes = $xml->getElementsByTagName( 'polygon' );
151              
152             foreach my $node (@nodes) {
153             my $color = $self->_get_color_for_element( $node );
154             $self->_svg_convert_polygon_to_lines( $node, $ast );
155             }
156             return;
157             }
158              
159             sub _svg_to_ast_handle_rects
160             {
161             my ($self, $xml, $ast) = @_;
162             my @nodes = $xml->getElementsByTagName( 'rect' );
163              
164             foreach my $node (@nodes) {
165             my $cmd = Graphics::GVG::AST::Rect->new({
166             x => $self->_svg_coord_convert_x( $node->getAttribute( 'x' ) ),
167             y => $self->_svg_coord_convert_y( $node->getAttribute( 'y' ) ),
168             width => $self->_svg_convert_width(
169             $node->getAttribute( 'width' ) ),
170             height => $self->_svg_convert_height(
171             $node->getAttribute( 'height' ) ),
172             color => $self->_get_color_for_element( $node ),
173             });
174              
175             my $push_to = $self->_svg_decide_type( $ast, $node );
176             $push_to->push_command( $cmd );
177             }
178             return;
179             }
180              
181             sub _svg_to_ast_handle_ellipses
182             {
183             my ($self, $xml, $ast) = @_;
184             my @nodes = $xml->getElementsByTagName( 'ellipse' );
185              
186             foreach my $node (@nodes) {
187             my $cmd = Graphics::GVG::AST::Ellipse->new({
188             cx => $self->_svg_coord_convert_x( $node->getAttribute( 'cx' ) ),
189             cy => $self->_svg_coord_convert_y( $node->getAttribute( 'cy' ) ),
190             rx => $self->_svg_convert_width( $node->getAttribute( 'rx' ) ),
191             ry => $self->_svg_convert_height( $node->getAttribute( 'ry' ) ),
192             color => $self->_get_color_for_element( $node ),
193             });
194              
195             my $push_to = $self->_svg_decide_type( $ast, $node );
196             $push_to->push_command( $cmd );
197             }
198             return;
199             }
200              
201             sub _svg_convert_polygon_to_lines
202             {
203             my ($self, $poly, $ast) = @_;
204             my $color = $self->_get_color_for_element( $poly );
205             my $points_str = $poly->getAttribute( 'points' );
206             my @points = split /\s+/, $points_str;
207              
208             foreach my $i (0 .. $#points) {
209             my $next_i = $i == $#points
210             ? 0
211             : $i + 1;
212             my ($x1, $y1) = $points[$i] =~ /\A (\d+),(\d+) \z/x;
213             my ($x2, $y2) = $points[$next_i] =~ /\A (\d+),(\d+) \z/x;
214              
215             my $cmd = Graphics::GVG::AST::Line->new({
216             x1 => $self->_svg_coord_convert_x( $x1 ),
217             y1 => $self->_svg_coord_convert_y( $y1 ),
218             x2 => $self->_svg_coord_convert_x( $x2 ),
219             y2 => $self->_svg_coord_convert_y( $y2 ),
220             color => $color,
221             });
222              
223             my $push_to = $self->_svg_decide_type( $ast, $poly );
224             $push_to->push_command( $cmd );
225             }
226              
227             return;
228             }
229              
230             sub _svg_decide_type
231             {
232             my ($self, $ast, $node) = @_;
233             my $class = $node->getAttribute( 'class' );
234             return $ast if ! defined $class;
235              
236             my $type = $ast;
237             my %classes = map { $_ => 1 }
238             split /\s+/, $class;
239              
240             if( exists $classes{glow} ) {
241             $type = Graphics::GVG::AST::Glow->new;
242             $ast->push_command( $type );
243             }
244              
245             return $type;
246             }
247              
248             sub _get_color_for_element
249             {
250             my ($self, $node) = @_;
251             # There are many ways to set the color in SVG, but Inkscape sets it in
252             # using the stroke selector using the CSS style attribute. Since we're
253             # mainly targeting Inkscape, we'll go with that.
254             my $style = $node->getAttribute( 'style' );
255             my ($hex_color) = $style =~ /stroke: \s* \#([0-9abcdefABCDEF]+)/x;
256             my $color = hex $hex_color;
257             $color <<= 8;
258             $color |= 0x000000ff;
259             return $color;
260             }
261              
262             sub _ast_to_svg
263             {
264             my ($self, $ast, $group) = @_;
265              
266             foreach my $cmd (@{ $ast->commands }) {
267             my $ret = '';
268             if(! ref $cmd ) {
269             warn "Not a ref, don't know what to do with '$_'\n";
270             }
271             elsif( $cmd->isa( 'Graphics::GVG::AST::Line' ) ) {
272             $self->_draw_line( $cmd, $group );
273             }
274             elsif( $cmd->isa( 'Graphics::GVG::AST::Rect' ) ) {
275             $self->_draw_rect( $cmd, $group );
276             }
277             elsif( $cmd->isa( 'Graphics::GVG::AST::Polygon' ) ) {
278             $self->_draw_poly( $cmd, $group );
279             }
280             elsif( $cmd->isa( 'Graphics::GVG::AST::Circle' ) ) {
281             $self->_draw_circle( $cmd, $group );
282             }
283             elsif( $cmd->isa( 'Graphics::GVG::AST::Ellipse' ) ) {
284             $self->_draw_ellipse( $cmd, $group );
285             }
286             elsif( $cmd->isa( 'Graphics::GVG::AST::Glow' ) ) {
287             $self->_ast_to_svg( $cmd, $group );
288             }
289             else {
290             warn "Don't know what to do with " . ref($_) . "\n";
291             }
292             }
293              
294             return;
295             }
296              
297             sub _draw_line
298             {
299             my ($self, $cmd, $group) = @_;
300             $group->line(
301             x1 => $self->_coord_convert_x( $cmd->x1 ),
302             y1 => $self->_coord_convert_y( $cmd->y1 ),
303             x2 => $self->_coord_convert_x( $cmd->x2 ),
304             y2 => $self->_coord_convert_y( $cmd->y2 ),
305             style => {
306             $self->_default_style,
307             stroke => $self->_color_to_style( $cmd->color ),
308             },
309             );
310             return;
311             }
312              
313             sub _draw_rect
314             {
315             my ($self, $cmd, $group) = @_;
316             $group->rect(
317             x => $self->_coord_convert_x( $cmd->x ),
318             y => $self->_coord_convert_y( $cmd->y ),
319             width => $self->_coord_convert_x( $cmd->x ),
320             height => $self->_coord_convert_y( $cmd->y ),
321             style => {
322             $self->_default_style,
323             stroke => $self->_color_to_style( $cmd->color ),
324             },
325             );
326             return;
327             }
328              
329             sub _draw_poly
330             {
331             my ($self, $cmd, $group) = @_;
332             my (@x_coords, @y_coords);
333             foreach my $coords (@{ $cmd->coords }) {
334             push @x_coords, $self->_coord_convert_x( $coords->[0] );
335             push @y_coords, $self->_coord_convert_y( $coords->[1] );
336             }
337              
338             my $points = $group->get_path(
339             x => \@x_coords,
340             y => \@y_coords,
341             -type => 'polygon',
342             );
343             $group->polygon(
344             %$points,
345             style => {
346             $self->_default_style,
347             stroke => $self->_color_to_style( $cmd->color ),
348             },
349             );
350             return;
351             }
352              
353             sub _draw_circle
354             {
355             my ($self, $cmd, $group) = @_;
356             $group->circle(
357             cx => $self->_coord_convert_x( $cmd->cx ),
358             cy => $self->_coord_convert_y( $cmd->cy ),
359             # Arbitrarily say the radius is according to the x coord.
360             r => $self->_coord_convert_abs( $cmd->r, $self->width / 2 ),
361             style => {
362             $self->_default_style,
363             stroke => $self->_color_to_style( $cmd->color ),
364             },
365             );
366             return;
367             }
368              
369             sub _draw_ellipse
370             {
371             my ($self, $cmd, $group) = @_;
372             $group->circle(
373             cx => $self->_coord_convert_x( $cmd->cx ),
374             cy => $self->_coord_convert_y( $cmd->cy ),
375             rx => $self->_coord_convert_x( $cmd->rx ),
376             ry => $self->_coord_convert_y( $cmd->ry ),
377             style => {
378             $self->_default_style,
379             stroke => $self->_color_to_style( $cmd->color ),
380             },
381             );
382             return;
383             }
384              
385             sub _default_style
386             {
387             my ($self) = @_;
388             my %style = (
389             fill => 'none',
390             );
391             return %style;
392             }
393              
394             sub _color_to_style
395             {
396             my ($self, $color) = @_;
397             my $rgb = $color >> 8;
398             my $hex = sprintf '%x', $rgb;
399             return '#' . $hex;
400             }
401              
402             sub _coord_convert_x
403             {
404             my ($self, $coord) = @_;
405             return $self->_coord_convert( $coord, $self->width );
406             }
407              
408             sub _coord_convert_y
409             {
410             my ($self, $coord) = @_;
411             return $self->_coord_convert( -$coord, $self->height );
412             }
413              
414             sub _coord_convert_abs
415             {
416             my ($self, $coord, $total_size) = @_;
417             return $coord * $total_size;
418             }
419              
420             sub _svg_coord_convert_x
421             {
422             my ($self, $coord) = @_;
423             my $new_coord = (($coord / $self->width) * 2) - 1;
424             return $new_coord;
425             }
426              
427             sub _svg_coord_convert_y
428             {
429             my ($self, $coord) = @_;
430             my $new_coord = (($coord / $self->height) * 2) - 1;
431             return $new_coord;
432             }
433              
434             sub _svg_convert_width
435             {
436             my ($self, $coord) = @_;
437             my $new_coord = $coord / ($self->width / 2);
438             return $new_coord;
439             }
440              
441             sub _svg_convert_height
442             {
443             my ($self, $coord) = @_;
444             my $new_coord = $coord / ($self->height / 2);
445             return $new_coord;
446             }
447              
448             sub _coord_convert
449             {
450             my ($self, $coord, $max) = @_;
451             my $percent = ($coord + 1) / 2;
452             my $final_coord = sprintf '%.0f', $max * $percent;
453             return $final_coord;
454             }
455              
456              
457             no Moose;
458             __PACKAGE__->meta->make_immutable;
459             1;
460             __END__
461              
462              
463             =head1 NAME
464              
465             Graphics::GVG::SVG - Convert GVG into SVG
466              
467             =head1 SYNOPSIS
468              
469             use Graphics::GVG;
470             use Graphics::GVG::SVG;
471            
472             my $SCRIPT = <<'END';
473             %color = #993399ff;
474             circle( %color, 0.5, 0.25, 0.3 );
475              
476             glow {
477             line( %color, 0.25, 0.25, 0.75, 0.75 );
478             line( %color, 0.75, 0.75, 0.75, -0.75 );
479             line( %color, 0.75, -0.75, 0.25, 0.25 );
480             }
481              
482             %color = #88aa88ff;
483             poly( %color, -0.25, -0.25, 0.6, 6, 0 );
484             END
485            
486            
487             my $gvg = Graphics::GVG->new;
488             my $ast = $gvg->parse( $SCRIPT );
489            
490             my $gvg_to_svg = Graphics::GVG::SVG->new;
491             my $svg = $gvg_to_svg->make_svg( $ast );
492              
493             =head1 DESCRIPTION
494              
495             Takes a L<Graphics::GVG::AST> and converts it into an SVG
496              
497             =head1 METHODS
498              
499             =head2 make_svg
500              
501             $gvg_to_svg->make_svg( $ast );
502              
503             Takes a L<Graphics::GVG::AST> object. Returns the same representation as an
504             L<SVG> object.
505              
506             =head1 SEE ALSO
507              
508             =over 4
509              
510             =item * L<Graphics::GVG>
511              
512             =item * L<SVG>
513              
514             =back
515              
516             =head1 LICENSE
517              
518             Copyright (c) 2016 Timm Murray
519             All rights reserved.
520              
521             Redistribution and use in source and binary forms, with or without
522             modification, are permitted provided that the following conditions are met:
523              
524             * Redistributions of source code must retain the above copyright notice,
525             this list of conditions and the following disclaimer.
526             * Redistributions in binary form must reproduce the above copyright
527             notice, this list of conditions and the following disclaimer in the
528             documentation and/or other materials provided with the distribution.
529              
530             THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
531             AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
532             IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
533             ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE
534             LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
535             CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
536             SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
537             INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN
538             CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE)
539             ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE
540             POSSIBILITY OF SUCH DAMAGE.
541              
542             =cut