Commit | Line | Data |
---|---|---|
b1b509f4 MG |
1 | package SVG::SpriteMaker; |
2 | ||
3 | use 5.014000; | |
4 | use strict; | |
5 | use warnings; | |
6 | ||
7 | our $VERSION = '0.001'; | |
8 | our @EXPORT = qw/make_sprite make_sprite_prefix/; | |
9 | our @EXPORT_OK = @EXPORT; | |
10 | ||
11 | use parent qw/Exporter/; | |
12 | use re '/s'; | |
13 | ||
14 | use Carp; | |
15 | use File::Basename; | |
16 | ||
17 | use SVG -indent => '', -elsep => ''; | |
18 | use SVG::Parser; | |
19 | ||
20 | sub make_sprite { | |
21 | my ($prefix, @images) = @_; | |
22 | my $sub = ref $prefix eq 'CODE' ? $prefix : sub { | |
23 | my $base = scalar fileparse $_[0], qr/[.].*/; | |
24 | "$prefix-$base" | |
25 | }; | |
26 | my $sprite = SVG->new(-inline => 1); | |
27 | my $parser = SVG::Parser->new; | |
28 | @images = map {[ $sub->($_) => $parser->parse_file($_) ]} @images; | |
29 | my ($x, $mh) = (0, 0); | |
30 | ||
31 | for (@images) { | |
32 | my ($img, $doc) = @$_; | |
33 | my $svg = $doc->getFirstChild; | |
34 | my ($w) = $svg->attr('width') =~ /([0-9.]*)/ or carp "Image $img has no width"; | |
35 | my ($h) = $svg->attr('height') =~ /([0-9.]*)/ or carp "Image $img has no height"; | |
36 | $mh = $h if $h > $mh; | |
37 | $svg->attr(x => $x); | |
38 | $svg->attr(version => undef); | |
39 | my $view = $sprite->view(id => $img, viewBox => "$x 0 $w $h"); | |
40 | $x += $w + 5; | |
41 | $view->getParent->insertAfter($svg, $view); | |
42 | } | |
43 | ||
44 | # Keep a reference to the documents to prevent garbage collection | |
45 | $sprite->{'--images'} = \@images; | |
46 | $sprite->getFirstChild->attr(viewBox => "0 0 $x $mh"); | |
47 | $sprite | |
48 | } | |
49 | ||
50 | 1; | |
51 | __END__ | |
52 | ||
53 | =encoding utf-8 | |
54 | ||
55 | =head1 NAME | |
56 | ||
57 | SVG::SpriteMaker - Combine several SVG images into a single SVG sprite | |
58 | ||
59 | =head1 SYNOPSIS | |
60 | ||
61 | use File::Slurp qw/write_file/; | |
62 | use SVG::SpriteMaker; | |
63 | my $sprite = make_sprite img => '1.svg', '2.svg', '3.svg'; | |
64 | write_file 'sprite.svg', $sprite->xmlify; | |
65 | # You can now use <img src="sprite.svg#img-1" alt="..."> | |
66 | ||
67 | my @images = <dir/*>; # dir/ImageA.svg dir/ImageB.svg | |
68 | $sprite = make_sprite sub { | |
69 | my ($name) = $_[0] =~ m,/([^/.]*),; | |
70 | uc $name | |
71 | }, @images; # Sprite will have identifiers #IMAGEA #IMAGEB | |
72 | ||
73 | =head1 DESCRIPTION | |
74 | ||
75 | A SVG sprite is a SVG image that contains several smaller images that | |
76 | can be referred to using fragment identifiers. For example, this HTML | |
77 | fragment: | |
78 | ||
79 | <img src="/img/cat.svg" alt="A cat"> | |
80 | <img src="/img/dog.svg" alt="A dog"> | |
81 | <img src="/img/horse.svg" alt="A horse"> | |
82 | ||
83 | Can be replaced with | |
84 | ||
85 | <img src="/img/sprite.svg#cat" alt="A cat"> | |
86 | <img src="/img/sprite.svg#dog" alt="A dog"> | |
87 | <img src="/img/sprite.svg#horse" alt="A horse"> | |
88 | ||
89 | This module exports a single function: | |
90 | ||
91 | =head2 B<make_sprite>(I<$prefix>|I<$coderef>, I<@files>) | |
92 | ||
93 | Takes a list of filenames, combines them and returns the resulting | |
94 | sprite as a L<SVG> object. Each SVG must have width and height | |
95 | attributes whose values are in pixels. | |
96 | ||
97 | If the first argument is a coderef, it will be called with each | |
98 | filename as a single argument and it should return the desired | |
99 | fragment identifier. | |
100 | ||
101 | If the first argument is not a coderef, the following coderef will be | |
102 | used: | |
103 | ||
104 | sub { | |
105 | my $base = scalar fileparse $_[0], qr/\..*/s; | |
106 | "$prefix-$base" | |
107 | }; | |
108 | ||
109 | where I<$prefix> is the value of the first argument. | |
110 | ||
111 | =head1 SEE ALSO | |
112 | ||
39589141 | 113 | L<svg-spritemaker>, L<https://css-tricks.com/svg-fragment-identifiers-work/> |
b1b509f4 MG |
114 | |
115 | =head1 AUTHOR | |
116 | ||
117 | Marius Gavrilescu, E<lt>marius@ieval.roE<gt> | |
118 | ||
119 | =head1 COPYRIGHT AND LICENSE | |
120 | ||
121 | Copyright (C) 2015 by Marius Gavrilescu | |
122 | ||
123 | This library is free software; you can redistribute it and/or modify | |
124 | it under the same terms as Perl itself, either Perl version 5.20.2 or, | |
125 | at your option, any later version of Perl 5 you may have available. | |
126 | ||
127 | ||
128 | =cut |