File Coverage

blib/lib/CSS/SpriteMaker.pm
Criterion Covered Total %
statement 10 12 83.3
branch n/a
condition n/a
subroutine 4 4 100.0
pod n/a
total 14 16 87.5


line stmt bran cond sub pod time code
1             package CSS::SpriteMaker;
2              
3 1     1   13334 use strict;
  1         2  
  1         22  
4 1     1   3 use warnings;
  1         1  
  1         18  
5              
6 1     1   3 use File::Find;
  1         3  
  1         44  
7 1     1   172 use Image::Magick;
  0            
  0            
8             use List::Util qw(max);
9              
10             use Module::Pluggable
11             search_path => ['CSS::SpriteMaker::Layout'],
12             except => qr/CSS::SpriteMaker::Layout::Utils::.*/,
13             require => 1,
14             inner => 0;
15              
16             use POSIX qw(ceil);
17              
18              
19             =head1 NAME
20              
21             CSS::SpriteMaker - Combine several images into a single CSS sprite
22              
23             =head1 VERSION
24              
25             Version 1.01
26              
27             =cut
28              
29             our $VERSION = '1.01';
30              
31              
32             =head1 SYNOPSIS
33              
34             use CSS::SpriteMaker;
35              
36             my $SpriteMaker = CSS::SpriteMaker->new(
37             verbose => 1, # optional
38              
39             #
40             # Options that impact the lifecycle of css class name generation
41             #
42             # if provided will replace the default logic for creating css classnames
43             # out of image filenames. This filename-to-classname is the FIRST step
44             # of css classnames creation. It's safe to return invalid css characters
45             # in this subroutine. They will be cleaned up internally.
46             #
47             rc_filename_to_classname => sub { my $filename = shift; ... } # optional
48              
49             # ... cleaning stage happens (all non css safe characters are removed)
50              
51             # This adds a prefix to all the css class names. This is called after
52             # the cleaning stage internally. Don't mess with invalid CSS characters!
53             #
54             css_class_prefix => 'myicon-',
55              
56             # This is the last step. Change here whatever part of the final css
57             # class name.
58             #
59             rc_override_classname => sub { my $css_class = shift; ... } # optional
60             );
61              
62             $SpriteMaker->make_sprite(
63             source_images => ['/path/to/imagedir', '/images/img1.png', '/img2.png'];
64             target_file => '/tmp/test/mysprite.png',
65             layout_name => 'Packed', # optional
66             remove_source_padding => 1, # optional
67             enable_colormap => 1, # optional
68             add_extra_padding => 31, # optional +31px padding around all images
69             format => 'png8', # optional
70             );
71              
72             $SpriteMaker->print_css();
73              
74             $SpriteMaker->print_html();
75              
76             OR
77              
78             my $SpriteMaker = CSS::SpriteMaker->new();
79              
80             $SpriteMaker->make_sprite(
81             source_dir => '/tmp/test/images',
82             target_file => '/tmp/test/mysprite.png',
83             );
84              
85             $SpriteMaker->print_css();
86              
87             $SpriteMaker->print_html();
88              
89             OR
90              
91             my $SpriteMaker = CSS::SpriteMaker->new();
92              
93             $SpriteMaker->compose_sprite(
94             parts => [
95             { source_dir => 'sample_icons',
96             layout_name => 'Packed',
97             add_extra_padding => 32 # just add extra padding in one part
98             },
99             { source_dir => 'more_icons',
100             layout => {
101             name => 'FixedDimension',
102             options => {
103             'dimension' => 'horizontal',
104             'n' => 4,
105             }
106             }
107             },
108             ],
109             # the composing layout
110             layout => {
111             name => 'FixedDimension',
112             options => {
113             n => 2,
114             }
115             },
116             target_file => 'composite.png',
117             );
118              
119             $SpriteMaker->print_css();
120              
121             $SpriteMaker->print_html();
122              
123             ALTERNATIVELY
124              
125             you can generate a fake CSS only containing the original images...
126              
127             my $SpriteMakerOnlyCss = CSS::SpriteMaker->new();
128              
129             $SpriteMakerOnlyCss->print_fake_css(
130             filename => 'some/fake_style.css',
131             source_dir => 'sample_icons'
132             );
133              
134              
135             =head1 DESCRIPTION
136              
137             A CSS Sprite is an image obtained by arranging many smaller images on a 2D
138             canvas, according to a certain layout.
139              
140             Transferring one larger image is generally faster than transferring multiple
141             images separately as it greatly reduces the number of HTTP requests (and
142             overhead) necessary to render the original images on the browser.
143              
144             =head1 PUBLIC METHODS
145              
146             =head2 new
147              
148             Create and configure a new CSS::SpriteMaker object.
149              
150             The object can be initialised as follows:
151            
152             my $SpriteMaker = CSS::SpriteMaker->new(
153             rc_filename_to_classname => sub { my $filename = shift; ... }, # optional
154             css_class_prefix => 'myicon-', # optional
155             rc_override_classname => sub { my $css_class = shift; ... } # optional
156             source_dir => '/tmp/test/images', # optional
157             target_file => '/tmp/test/mysprite.png' # optional
158             remove_source_padding => 1, # optional
159             add_extra_padding => 1, # optional
160             verbose => 1, # optional
161             enable_colormap => 1, # optional
162             );
163            
164             Default values are set to:
165              
166             =over 4
167              
168             =item remove_source_padding : false,
169              
170             =item verbose : false,
171              
172             =item enable_colormap : false,
173              
174             =item format : png,
175              
176             =item css_class_prefix : ''
177              
178             =back
179              
180             The parameter rc_filename_to_classname is a code reference to a function that
181             allow to customize the way class names are generated. This function should take
182             one parameter as input and return a class name
183              
184             =cut
185              
186             sub new {
187             my $class = shift;
188             my %opts = @_;
189              
190             # defaults
191             $opts{remove_source_padding} //= 0;
192             $opts{add_extra_padding} //= 0;
193             $opts{verbose} //= 0;
194             $opts{format} //= 'png';
195             $opts{layout_name} //= 'Packed';
196             $opts{css_class_prefix} //= '';
197             $opts{enable_colormap} //= 0;
198            
199             my $self = {
200             css_class_prefix => $opts{css_class_prefix},
201             source_images => $opts{source_images},
202             source_dir => $opts{source_dir},
203             target_file => $opts{target_file},
204             is_verbose => $opts{verbose},
205             format => $opts{format},
206             remove_source_padding => $opts{remove_source_padding},
207             enable_colormap => $opts{enable_colormap},
208             add_extra_padding => $opts{add_extra_padding},
209             output_css_file => $opts{output_css_file},
210             output_html_file => $opts{output_html_file},
211              
212             # layout_name is used as default
213             layout => {
214             name => $opts{layout_name},
215             # no options by default
216             options => {}
217             },
218             rc_filename_to_classname => $opts{rc_filename_to_classname},
219             rc_override_classname => $opts{rc_override_classname},
220              
221             # the maximum color value
222             color_max => 2 ** Image::Magick->QuantumDepth - 1,
223             };
224              
225             return bless $self, $class;
226             }
227              
228             =head2 compose_sprite
229              
230             Compose many sprite layouts into one sprite. This is done by applying
231             individual layout separately, then merging the final result together using a
232             glue layout.
233              
234             my $is_error = $SpriteMaker->compose_sprite (
235             parts => [
236             { source_images => ['some/file.png', 'path/to/some_directory'],
237             layout_name => 'Packed',
238             },
239             { source_images => ['path/to/some_directory'],
240             layout => {
241             name => 'DirectoryBased',
242             }
243             include_in_css => 0, # optional
244             remove_source_padding => 1, # optional (defaults to 0)
245             enable_colormap => 1, # optional (defaults to 0)
246             add_extra_padding => 40, # optional, px (defaults to 0px)
247             },
248             ],
249             # arrange the previous two layout using a glue layout
250             layout => {
251             name => 'FixedDimension',
252             dimension => 'horizontal',
253             n => 2
254             }
255             target_file => 'sample_sprite.png',
256             format => 'png8', # optional, default is png
257             );
258              
259             Note the optional include_in_css option, which allows to exclude a group of
260             images from the CSS (still including them in the resulting image).
261              
262             =cut
263              
264             sub compose_sprite {
265             my $self = shift;
266             my %options = @_;
267              
268             if (exists $options{layout}) {
269             return $self->_compose_sprite_with_glue(%options);
270             }
271             else {
272             return $self->_compose_sprite_without_glue(%options);
273             }
274             }
275              
276             =head2 make_sprite
277              
278             Creates the sprite file out of the specifed image files or directories, and
279             according to the given layout name.
280              
281             my $is_error = $SpriteMaker->make_sprite(
282             source_images => ['some/file.png', path/to/some_directory],
283             target_file => 'sample_sprite.png',
284             layout_name => 'Packed',
285              
286             # all imagemagick supported formats
287             format => 'png8', # optional, default is png
288             );
289              
290             returns true if an error occurred during the procedure.
291              
292             Available layouts are:
293              
294             =over 4
295              
296             =item * Packed: try to pack together the images as much as possible to reduce the
297             image size.
298              
299             =item * DirectoryBased: put images under the same directory on the same horizontal
300             row. Order alphabetically within each row.
301              
302             =item * FixedDimension: arrange a maximum of B images on the same row (or
303             column).
304              
305             =back
306              
307             =cut
308              
309             sub make_sprite {
310             my $self = shift;
311             my %options = @_;
312              
313             my $rh_sources_info = $self->_ensure_sources_info(%options);
314             my $Layout = $self->_ensure_layout(%options,
315             rh_sources_info => $rh_sources_info
316             );
317              
318             return $self->_write_image(%options,
319             Layout => $Layout,
320             rh_sources_info => $rh_sources_info
321             );
322             }
323              
324             =head2 print_css
325              
326             Creates and prints the css stylesheet for the sprite that was previously
327             produced.
328              
329             You can specify the filename or the filehandle where the output CSS should be
330             written:
331              
332             $SpriteMaker->print_css(
333             filehandle => $fh,
334             );
335              
336             OR
337              
338             $SpriteMaker->print_css(
339             filename => 'relative/path/to/style.css',
340             );
341              
342             Optionally you can provide the name of the image file that should be included in
343             the CSS file instead of the default one:
344              
345             # within the style.css file, override the default path to the sprite image
346             # with "custom/path/to/sprite.png".
347             #
348             $SpriteMaker->print_css(
349             filename => 'relative/path/to/style.css',
350             sprite_filename => 'custom/path/to/sprite.png', # optional
351             );
352              
353              
354             NOTE: make_sprite() must be called before this method is called.
355              
356             =cut
357              
358             sub print_css {
359             my $self = shift;
360             my %options = @_;
361            
362             my $rh_sources_info = $self->_ensure_sources_info(%options);
363             my $Layout = $self->_ensure_layout(%options,
364             rh_sources_info => $rh_sources_info
365             );
366              
367             my $fh = $self->_ensure_filehandle_write(%options);
368              
369             $self->_verbose(" * writing css file");
370              
371             my $target_image_filename;
372             if (exists $options{sprite_filename} && $options{sprite_filename}) {
373             $target_image_filename = $options{sprite_filename};
374             }
375              
376             my $stylesheet = $self->_get_stylesheet_string({
377             target_image_filename => $target_image_filename,
378             use_full_images => 0
379             },
380             %options
381             );
382              
383             print $fh $stylesheet;
384              
385             return 0;
386             }
387              
388             =head2 print_fake_css
389              
390             Fake a css spritesheet by generating a stylesheet containing just the original
391             images (not the ones coming from the sprite!)
392              
393             $SpriteMaker->print_fake_css(
394             filename => 'relative/path/to/style.css',
395             fix_image_path => {
396             find: '/some/absolute/path', # a Perl regexp
397             replace: 'some/relative/path'
398             }
399             );
400              
401             NOTE: unlike print_css you don't need to call this method after make_sprite.
402              
403             =cut
404              
405             sub print_fake_css {
406             my $self = shift;
407             my %options = @_;
408            
409             my $rh_sources_info = $self->_ensure_sources_info(%options);
410              
411             my $fh = $self->_ensure_filehandle_write(%options);
412              
413             $self->_verbose(" * writing fake css file");
414              
415             if (exists $options{sprite_filename}) {
416             die "the sprite_filename option is incompatible with fake_css. In this mode the original images are used in the spritesheet";
417             }
418              
419             my $stylesheet = $self->_get_stylesheet_string({
420             use_full_images => 1
421             },
422             %options
423             );
424              
425             print $fh $stylesheet;
426              
427             return 0;
428             }
429              
430             =head2 print_html
431              
432             Creates and prints an html sample page containing informations about each sprite produced.
433              
434             $SpriteMaker->print_html(
435             filehandle => $fh,
436             );
437              
438             OR
439              
440             $SpriteMaker->print_html(
441             filename => 'relative/path/to/index.html',
442             );
443              
444             NOTE: make_sprite() must be called before this method is called.
445              
446             =cut
447             sub print_html {
448             my $self = shift;
449             my %options = @_;
450            
451             my $rh_sources_info = $self->_ensure_sources_info(%options);
452             my $Layout = $self->_ensure_layout(%options,
453             rh_sources_info => $rh_sources_info
454             );
455             my $fh = $self->_ensure_filehandle_write(%options);
456            
457             $self->_verbose(" * writing html sample page");
458              
459             my $stylesheet = $self->_get_stylesheet_string({}, %options);
460              
461             print $fh '

CSS::SpriteMaker Image Information

';
496              
497             # html
498             for my $id (sort { $a <=> $b } keys %$rh_sources_info) {
499             my $rh_source_info = $rh_sources_info->{$id};
500             my $css_class = $self->_generate_css_class_name($rh_source_info->{name});
501             $self->_verbose(
502             sprintf("%s -> %s", $rh_source_info->{name}, $css_class)
503             );
504              
505             $css_class =~ s/[.]//;
506              
507             my $is_included = $rh_source_info->{include_in_css};
508             my $width = $rh_source_info->{original_width};
509             my $height = $rh_source_info->{original_height};
510              
511             my $onclick = <
512             if (typeof current !== 'undefined' && current !== this) {
513             current.style.width = current.w;
514             current.style.height = current.h;
515             current.style.position = '';
516             delete current.w;
517             delete current.h;
518             }
519             if (typeof this.h === 'undefined') {
520             this.h = this.style.height;
521             this.w = this.style.width;
522             this.style.width = '';
523             this.style.height = '';
524             this.style.position = 'fixed';
525             current = this;
526             }
527             else {
528             this.style.width = this.w;
529             this.style.height = this.h;
530             this.style.position = '';
531             delete this.w;
532             delete this.h;
533             current = undefined;
534             }
535             EONCLICK
536              
537              
538             print $fh sprintf(
539             '
',
540             $is_included ? ' included' : ' not-included',
541             $onclick,
542             $width, $height
543             );
544              
545            
546             if ($is_included) {
547             print $fh "
";
548             }
549             else {
550             print $fh "
";
551             }
552             print $fh "
";
553             for my $key (sort keys %$rh_source_info) {
554             next if $key eq "colors";
555             print $fh "" . $key . ": " . ($rh_source_info->{$key} // 'none') . "
";
556             }
557              
558             print $fh '

Colors

';
559             print $fh "total: " . $rh_source_info->{colors}{total} . '
';
560              
561             if ($self->{enable_colormap}) {
562             for my $colors (sort keys %{$rh_source_info->{colors}{map}}) {
563             my ($r, $g, $b, $a) = split /,/, $colors;
564             my $rrgb = $r * 255 / $self->{color_max};
565             my $grgb = $g * 255 / $self->{color_max};
566             my $brgb = $b * 255 / $self->{color_max};
567             my $argb = 255 - ($a * 255 / $self->{color_max});
568             print $fh '
";
569             }
570             }
571              
572             print $fh " ";
573             print $fh '';
574             }
575              
576             print $fh "";
577              
578             return 0;
579             }
580              
581             =head2 get_css_info_structure
582              
583             Returns an arrayref of hashrefs like:
584              
585             [
586             {
587             full_path => 'relative/path/to/file.png',
588             css_class => 'file',
589             width => 16, # pixels
590             height => 16,
591             x => 173, # offset within the layout
592             y => 234,
593             },
594             ...more
595             ]
596              
597             This structure can be used to build your own html or css stylesheet for
598             example.
599              
600             NOTE: the x y offsets within the layout, will be always positive numbers.
601              
602             =cut
603              
604             sub get_css_info_structure {
605             my $self = shift;
606             my %options = @_;
607              
608             my $rh_sources_info = $self->_ensure_sources_info(%options);
609             my $Layout = $self->_ensure_layout(%options,
610             rh_sources_info => $rh_sources_info
611             );
612              
613             my $rh_id_to_class = $self->_generate_css_class_names($rh_sources_info);
614              
615             my @css_info;
616              
617             for my $id (sort { $a <=> $b } keys %$rh_sources_info) {
618             my $rh_source_info = $rh_sources_info->{$id};
619             my $css_class = $rh_id_to_class->{$id};
620              
621             my ($x, $y) = $Layout->get_item_coord($id);
622              
623             push @css_info, {
624             full_path => $rh_source_info->{pathname},
625             x => $x + $rh_source_info->{add_extra_padding},
626             y => $y + $rh_source_info->{add_extra_padding},
627             css_class => $css_class,
628             width => $rh_source_info->{original_width},
629             height => $rh_source_info->{original_height},
630             };
631             }
632              
633             return \@css_info;
634             }
635              
636             =head1 PRIVATE METHODS
637              
638             =head2 _generate_css_class_names
639              
640             Returns a mapping id -> class_name out of the current information structure.
641              
642             It guarantees unique class_name for each id.
643              
644             =cut
645              
646             sub _generate_css_class_names {
647             my $self = shift;
648             my $rh_source_info = shift;;
649              
650             my %existing_classnames_lookup;
651             my %id_to_class_mapping;
652              
653             PROCESS_SOURCEINFO:
654             for my $id (sort { $a <=> $b } keys %$rh_source_info) {
655            
656             next PROCESS_SOURCEINFO if !$rh_source_info->{$id}{include_in_css};
657              
658             my $css_class = $self->_generate_css_class_name(
659             $rh_source_info->{$id}{name}
660             );
661            
662             # keep modifying the css_class name until it doesn't exist in the hash
663             my $i = 0;
664             while (exists $existing_classnames_lookup{$css_class}) {
665             # ... we want to add an incremental suffix like "-2"
666             if (!$i) {
667             # the first time, we want to add the prefix only, but leave the class name intact
668             if ($css_class =~ m/-\Z/) {
669             # class already ends with a dash
670             $css_class .= '1';
671             }
672             else {
673             $css_class .= '-1';
674             }
675             }
676             elsif ($css_class =~ m/-(\d+)\Z/) { # that's our dash added before!
677             my $current_number = $1;
678             $current_number++;
679             $css_class =~ s/-\d+\Z/-$current_number/;
680             }
681             $i++;
682             }
683              
684             $existing_classnames_lookup{$css_class} = 1;
685             $id_to_class_mapping{$id} = $css_class;
686             }
687              
688             return \%id_to_class_mapping;
689             }
690              
691              
692             =head2 _image_locations_to_source_info
693              
694             Identify informations from the location of each input image, and assign
695             numerical ids to each input image.
696              
697             We use a global image identifier for composite layouts. Each identified image
698             must have a unique id in the scope of the same CSS::SpriteMaker instance!
699              
700             =cut
701              
702             sub _image_locations_to_source_info {
703             my $self = shift;
704             my $ra_locations = shift;
705             my $remove_source_padding = shift;
706             my $add_extra_padding = shift;
707             my $include_in_css = shift // 1;
708             my $enable_colormap = shift;
709              
710             my %source_info;
711            
712             # collect properties of each input image.
713             IMAGE:
714             for my $rh_location (@$ra_locations) {
715              
716             my $id = $self->_get_image_id;
717              
718             my %properties = %{$self->_get_image_properties(
719             $rh_location->{pathname},
720             $remove_source_padding,
721             $add_extra_padding,
722             $enable_colormap
723             )};
724              
725             # add whether to include this item in the css or not
726             $properties{include_in_css} = $include_in_css;
727              
728             # this is really for write_image, it should add padding as necessary
729             $properties{add_extra_padding} = $add_extra_padding;
730              
731             # skip invalid images
732             next IMAGE if !%properties;
733              
734             for my $key (keys %$rh_location) {
735             $source_info{$id}{$key} = $rh_location->{$key};
736             }
737             for my $key (keys %properties) {
738             $source_info{$id}{$key} = $properties{$key};
739             }
740             }
741              
742             return \%source_info;
743             }
744              
745             =head2 _get_image_id
746              
747             Returns a global numeric identifier.
748              
749             =cut
750              
751             sub _get_image_id {
752             my $self = shift;
753             $self->{_unique_id} //= 0;
754             return $self->{_unique_id}++;
755             }
756              
757             =head2 _locate_image_files
758              
759             Finds the location of image files within the given directory. Returns an
760             arrayref of hashrefs containing information about the names and pathnames of
761             each image file.
762              
763             The returned arrayref looks like:
764              
765             [ # pathnames of the first image to follow
766             {
767             name => 'image.png',
768             pathname => '/complete/path/to/image.png',
769             parentdir => '/complete/path/to',
770             },
771             ...
772             ]
773              
774             Dies if the given directory is empty or doesn't exist.
775              
776             =cut
777              
778             sub _locate_image_files {
779             my $self = shift;
780             my $source_directory = shift;
781              
782             if (!defined $source_directory) {
783             die "you have called _locate_image_files but \$source_directory was undefined";
784             }
785              
786             $self->_verbose(" * gathering files and directories of source images");
787              
788             my @locations;
789             find(sub {
790             my $filename = $_;
791             my $fullpath = $File::Find::name;
792             my $parentdir = $File::Find::dir;
793            
794             return if $filename eq '.';
795              
796             if (-f $filename) {
797             push @locations, {
798             # only the name of the file
799             name => $filename,
800              
801             # the full relative pathname
802             pathname => $fullpath,
803              
804             # the full relative path to the parent directory
805             parentdir => $parentdir
806             };
807             }
808              
809             }, $source_directory);
810              
811             return \@locations;
812             }
813              
814             =head2 _get_stylesheet_string
815              
816             Returns the stylesheet in a string.
817              
818             =cut
819              
820             sub _get_stylesheet_string {
821             my $self = shift;
822             my $rh_opts = shift // {};
823             my %options = @_;
824              
825             # defaults
826             my $target_image_filename = $self->{_cache_target_image_file};
827             if (exists $rh_opts->{target_image_filename} && defined $rh_opts->{target_image_filename}) {
828             $target_image_filename = $rh_opts->{target_image_filename};
829             }
830              
831             my $use_full_images = 0;
832             if (exists $rh_opts->{use_full_images} && defined $rh_opts->{use_full_images}) {
833             $use_full_images = $rh_opts->{use_full_images};
834             }
835              
836             my $rah_cssinfo = $self->get_css_info_structure(%options);
837              
838             my @classes = map { "." . $_->{css_class} }
839             grep { defined $_->{css_class} }
840             @$rah_cssinfo;
841              
842             my @stylesheet;
843              
844             if ($use_full_images) {
845             my ($f, $r);
846             my $is_path_to_be_fixed = 0;
847             if (exists $options{fix_image_path} &&
848             exists $options{fix_image_path}{find} &&
849             exists $options{fix_image_path}{replace}) {
850              
851             $is_path_to_be_fixed = 1;
852             $f = qr/$options{fix_image_path}{find}/;
853             $r = $options{fix_image_path}{replace};
854             }
855              
856             ##
857             ## use full images instead of the ones from the sprite
858             ##
859             for my $rh_info (@$rah_cssinfo) {
860              
861             # fix the path (maybe)
862             my $path = $rh_info->{full_path};
863             if ($is_path_to_be_fixed) {
864             $path =~ s/$f/$r/;
865             }
866              
867             if (defined $rh_info->{css_class}) {
868             push @stylesheet, sprintf(
869             ".%s { background-image: url('%s'); width: %spx; height: %spx; }",
870             $rh_info->{css_class},
871             $path,
872             $rh_info->{width},
873             $rh_info->{height},
874             );
875             }
876             }
877             }
878             else {
879             # write header
880             # header associates the sprite image to each class
881             push @stylesheet, sprintf(
882             "%s { background-image: url('%s'); background-repeat: no-repeat; }",
883             join(",", @classes),
884             $target_image_filename
885             );
886              
887             for my $rh_info (@$rah_cssinfo) {
888             if (defined $rh_info->{css_class}) {
889             push @stylesheet, sprintf(
890             ".%s { background-position: %spx %spx; width: %spx; height: %spx; }",
891             $rh_info->{css_class},
892             -1 * $rh_info->{x},
893             -1 * $rh_info->{y},
894             $rh_info->{width},
895             $rh_info->{height},
896             );
897             }
898             }
899             }
900              
901             return join "\n", @stylesheet;
902             }
903              
904              
905             =head2 _generate_css_class_name
906              
907             This method generates the name of the CSS class for a certain image file. Takes
908             the image filename as input and produces a css class name (excluding the
909             prepended ".").
910              
911             =cut
912              
913             sub _generate_css_class_name {
914             my $self = shift;
915             my $filename = shift;
916              
917             my $rc_filename_to_classname = $self->{rc_filename_to_classname};
918             my $rc_override_classname = $self->{rc_override_classname};
919              
920             if (defined $rc_filename_to_classname) {
921             my $classname = $rc_filename_to_classname->($filename);
922             if (!$classname) {
923             warn "custom sub to generate class names out of file names returned empty class for file name $filename";
924             }
925             if ($classname =~ m/^[.]/) {
926             warn sprintf('your custom sub should not include \'.\' at the beginning of the class name. (%s was generated from %s)',
927             $classname,
928             $filename
929             );
930             }
931            
932             if (defined $rc_override_classname) {
933             $classname = $rc_override_classname->($classname);
934             }
935              
936             return $classname;
937             }
938              
939             # prepare (lowercase)
940             my $css_class = lc($filename);
941              
942             # remove image extensions if any
943             $css_class =~ s/[.](tif|tiff|gif|jpeg|jpg|jif|jfif|jp2|jpx|j2k|j2c|fpx|pcd|png|pdf)\Z//;
944              
945             # remove @ [] +
946             $css_class =~ s/[+@\]\[]//g;
947              
948             # turn certain characters into dashes
949             $css_class =~ s/[\s_.]/-/g;
950              
951             # remove dashes if they appear at the end
952             $css_class =~ s/-\Z//g;
953              
954             # remove initial dashes if any
955             $css_class =~ s/\A-+//g;
956              
957             # add prefix if it was requested
958             if (defined $self->{css_class_prefix}) {
959             $css_class = $self->{css_class_prefix} . $css_class;
960             }
961              
962             # allow change (e.g., add prefix)
963             if (defined $rc_override_classname) {
964             $css_class = $rc_override_classname->($css_class);
965             }
966              
967             return $css_class;
968             }
969              
970              
971             =head2 _ensure_filehandle_write
972              
973             Inspects the input %options hash and returns a filehandle according to the
974             parameters passed in there.
975              
976             The filehandle is where something (css stylesheet for example) is going to be
977             printed.
978              
979             =cut
980              
981             sub _ensure_filehandle_write {
982             my $self = shift;
983             my %options = @_;
984              
985             return $options{filehandle} if defined $options{filehandle};
986              
987             if (defined $options{filename}) {
988             open my ($fh), '>', $options{filename};
989             return $fh;
990             }
991              
992             return \*STDOUT;
993             }
994              
995             =head2 _ensure_sources_info
996              
997             Makes sure the user of this module has provided a valid input parameter for
998             sources_info and return the sources_info structure accordingly. Dies in case
999             something goes wrong with the user input.
1000              
1001             Parameters that allow us to obtain a $rh_sources_info structure are:
1002              
1003             - source_images: an arrayref of files or directories, directories will be
1004             visited recursively and any image file in it becomes the input.
1005              
1006             If none of the above parameters have been found in input options, the cache is
1007             checked before giving up - i.e., the user has previously provided the layout
1008             parameter, and was able to generate a sprite.
1009              
1010             =cut
1011              
1012             sub _ensure_sources_info {
1013             my $self = shift;
1014             my %options = @_;
1015              
1016             ##
1017             ## Shall we remove source padding?
1018             ## - first check if an option is provided
1019             ## - otherwise default to the option in $self
1020             my $remove_source_padding = $self->{remove_source_padding};
1021             my $add_extra_padding = $self->{add_extra_padding};
1022             my $enable_colormap = $self->{enable_colormap};
1023             if (exists $options{remove_source_padding}
1024             && defined $options{remove_source_padding}) {
1025              
1026             $remove_source_padding = $options{remove_source_padding};
1027             }
1028             if (exists $options{add_extra_padding}
1029             && defined $options{add_extra_padding}) {
1030              
1031             $add_extra_padding = $options{add_extra_padding};
1032             }
1033             if (exists $options{enable_colormap}
1034             && defined $options{enable_colormap}) {
1035              
1036             $enable_colormap = $options{enable_colormap};
1037             }
1038              
1039             my $rh_source_info;
1040              
1041             return $options{source_info} if exists $options{source_info};
1042              
1043             my @source_images;
1044              
1045             if (exists $options{source_dir} && defined $options{source_dir}) {
1046             push @source_images, $options{source_dir};
1047             }
1048              
1049             if (exists $options{source_images} && defined $options{source_images}) {
1050             die 'source_images parameter must be an ARRAY REF' if ref $options{source_images} ne 'ARRAY';
1051             push @source_images, @{$options{source_images}};
1052             }
1053              
1054             if (@source_images) {
1055             # locate each file within each directory and then identify all...
1056             my @locations;
1057             for my $file_or_dir (@source_images) {
1058             my $ra_locations = $self->_locate_image_files($file_or_dir);
1059             push @locations, @$ra_locations;
1060             }
1061              
1062             my $include_in_css = exists $options{include_in_css}
1063             ? $options{include_in_css}
1064             : 1;
1065              
1066             $rh_source_info = $self->_image_locations_to_source_info(
1067             \@locations,
1068             $remove_source_padding,
1069             $add_extra_padding,
1070             $include_in_css,
1071             $enable_colormap
1072             );
1073             }
1074            
1075             if (!$rh_source_info) {
1076             if (exists $self->{_cache_rh_source_info}
1077             && defined $self->{_cache_rh_source_info}) {
1078              
1079             $rh_source_info = $self->{_cache_rh_source_info};
1080             }
1081             else {
1082             die "Unable to create the source_info_structure!";
1083             }
1084             }
1085              
1086             return $rh_source_info;
1087             }
1088              
1089              
1090              
1091             =head2 _ensure_layout
1092              
1093             Makes sure the user of this module has provided valid layout options and
1094             returns a $Layout object accordingly. Dies in case something goes wrong with
1095             the user input. A Layout actually runs over the specified items on instantiation.
1096              
1097             Parameters in %options (see code) that allow us to obtain a $Layout object are:
1098              
1099             - layout: a CSS::SpriteMaker::Layout object already;
1100             - layout: can also be a hashref like
1101              
1102             {
1103             name => 'LayoutName',
1104             options => {
1105             'Layout-Specific option' => 'value',
1106             ...
1107             }
1108             }
1109              
1110             - layout_name: the name of a CSS::SpriteMaker::Layout object.
1111              
1112             If none of the above parameters have been found in input options, the cache is
1113             checked before giving up - i.e., the user has previously provided the layout
1114             parameter...
1115              
1116             =cut
1117              
1118             sub _ensure_layout {
1119             my $self = shift;
1120             my %options = @_;
1121              
1122             die 'rh_sources_info parameter is required' if !exists $options{rh_sources_info};
1123              
1124             # Get the layout from the layout parameter in case it is a $Layout object
1125             my $Layout;
1126             if (exists $options{layout} && $options{layout} && ref $options{layout} ne 'HASH') {
1127             if (exists $options{layout}{_layout_ran}) {
1128             $Layout = $options{layout};
1129             }
1130             else {
1131             warn 'a Layout object was specified but strangely was not executed on the specified items. NOTE: if a layout is instantiated it\'s always ran over the items!';
1132             }
1133             }
1134              
1135             if (defined $Layout) {
1136             if (exists $options{layout_name} && defined $options{layout_name}) {
1137             warn 'the parameter layout_name was ignored as the layout parameter was specified. These two parameters are mutually exclusive.';
1138             }
1139             }
1140             else {
1141             ##
1142             ## We were unable to get the layout object directly, so we need to
1143             ## create the layout from a name if possible...
1144             ##
1145              
1146             $self->_verbose(" * creating layout");
1147              
1148             # the layout name can be specified in the options as layout_name
1149             my $layout_name = '';
1150             my $layout_options;
1151             if (exists $options{layout_name}) {
1152             $layout_name = $options{layout_name};
1153             # if this is the case this layout must support no options
1154             $layout_options = {};
1155             }
1156              
1157             # maybe a layout => { name => 'something' was specified }
1158             if (exists $options{layout} && exists $options{layout}{name}) {
1159             $layout_name = $options{layout}{name};
1160             $layout_options = $options{layout}{options} // {};
1161             }
1162              
1163             LOAD_LAYOUT_PLUGIN:
1164             for my $plugin ($self->plugins()) {
1165             my ($plugin_name) = reverse split "::", $plugin;
1166             if ($plugin eq $layout_name || $plugin_name eq $layout_name) {
1167             $self->_verbose(" * using layout $plugin");
1168             $Layout = $plugin->new($options{rh_sources_info}, $layout_options);
1169             last LOAD_LAYOUT_PLUGIN;
1170             }
1171             }
1172              
1173             if (!defined $Layout && $layout_name ne '') {
1174             die sprintf(
1175             "The layout you've specified (%s) couldn't be found. Valid layouts are:\n%s",
1176             $layout_name,
1177             join "\n", $self->plugins()
1178             );
1179             }
1180             }
1181              
1182             #
1183             # Still no layout, check the cache!
1184             #
1185             if (!defined $Layout) {
1186             # try checking in the cache before giving up...
1187             if (exists $self->{_cache_layout}
1188             && defined $self->{_cache_layout}) {
1189            
1190             $Layout = $self->{_cache_layout};
1191             }
1192             }
1193              
1194             #
1195             # Still nothing, then use default layout
1196             #
1197             if (!defined $Layout) {
1198             my $layout_name = $self->{layout}{name};
1199             my $layout_options = {};
1200             LOAD_DEFAULT_LAYOUT_PLUGIN:
1201             for my $plugin ($self->plugins()) {
1202             my ($plugin_name) = reverse split "::", $plugin;
1203             if ($plugin eq $layout_name || $plugin_name eq $layout_name) {
1204             $self->_verbose(" * using DEFAULT layout $plugin");
1205             $Layout = $plugin->new($options{rh_sources_info}, $layout_options);
1206             last LOAD_DEFAULT_LAYOUT_PLUGIN;
1207             }
1208             }
1209             }
1210              
1211             return $Layout;
1212             }
1213              
1214             sub _write_image {
1215             my $self = shift;
1216             my %options = @_;
1217              
1218             my $target_file = $options{target_file} // $self->{target_file};
1219             my $output_format = $options{format} // $self->{format};
1220             my $Layout = $options{Layout} // 0;
1221             my $rh_sources_info = $options{rh_sources_info} // 0;
1222              
1223             if (!$target_file) {
1224             die "the ``target_file'' parameter is required for this subroutine or you must instantiate Css::SpriteMaker with the target_file parameter";
1225             }
1226              
1227             if (!$rh_sources_info) {
1228             die "The 'rh_sources_info' parameter must be passed to _write_image";
1229             }
1230              
1231             if (!$Layout) {
1232             die "The 'layout' parameter needs to be specified for _write_image, and must be a CSS::SpriteMaker::Layout object";
1233             }
1234              
1235             $self->_verbose(" * writing sprite image");
1236              
1237             $self->_verbose(sprintf("Target image size: %s, %s",
1238             $Layout->width(),
1239             $Layout->height())
1240             );
1241              
1242             my $Target = Image::Magick->new();
1243              
1244             $Target->Set(size => sprintf("%sx%s",
1245             $Layout->width(),
1246             $Layout->height()
1247             ));
1248              
1249             # prepare the target image
1250             if (my $err = $Target->ReadImage('xc:white')) {
1251             warn $err;
1252             }
1253             $Target->Set(type => 'TruecolorMatte');
1254            
1255             # make it transparent
1256             $self->_verbose(" - clearing canvas");
1257             $Target->Draw(
1258             fill => 'transparent',
1259             primitive => 'rectangle',
1260             points => sprintf("0,0 %s,%s", $Layout->width(), $Layout->height())
1261             );
1262             $Target->Transparent('color' => 'white');
1263              
1264             # place each image according to the layout
1265             ITEM_ID:
1266             for my $source_id ($Layout->get_item_ids) {
1267             my $rh_source_info = $rh_sources_info->{$source_id};
1268             my ($layout_x, $layout_y) = $Layout->get_item_coord($source_id);
1269              
1270             $self->_verbose(sprintf(" - placing %s (format: %s size: %sx%s position: [%s,%s])",
1271             $rh_source_info->{pathname},
1272             $rh_source_info->{format},
1273             $rh_source_info->{width},
1274             $rh_source_info->{height},
1275             $layout_y,
1276             $layout_x
1277             ));
1278             my $I = Image::Magick->new();
1279             my $err = $I->Read($rh_source_info->{pathname});
1280             if ($err) {
1281             warn $err;
1282             next ITEM_ID;
1283             }
1284              
1285             my $padding = $rh_source_info->{add_extra_padding};
1286              
1287             my $destx = $layout_x + $padding;
1288             my $desty = $layout_y + $padding;
1289             $Target->Composite(image=>$I,compose=>'xor',geometry=>"+$destx+$desty");
1290             }
1291              
1292             # write target image
1293             my $err = $Target->Write("$output_format:".$target_file);
1294             if ($err) {
1295             warn "unable to obtain $target_file for writing it as $output_format. Perhaps you have specified an invalid format. Check http://www.imagemagick.org/script/formats.php for a list of supported formats. Error: $err";
1296              
1297             $self->_verbose("Wrote $target_file");
1298              
1299             return 1;
1300             }
1301              
1302             # cache the layout and the rh_info structure so that it hasn't to be passed
1303             # as a parameter next times.
1304             $self->{_cache_layout} = $Layout;
1305              
1306             # cache the target image file, as making the stylesheet can't be done
1307             # without this information.
1308             $self->{_cache_target_image_file} = $target_file;
1309              
1310             # cache sources info
1311             $self->{_cache_rh_source_info} = $rh_sources_info;
1312              
1313             return 0;
1314            
1315             }
1316              
1317             =head2 _get_image_properties
1318              
1319             Return an hashref of information about the image at the given pathname.
1320              
1321             =cut
1322              
1323             sub _get_image_properties {
1324             my $self = shift;
1325             my $image_path = shift;
1326             my $remove_source_padding = shift;
1327             my $add_extra_padding = shift;
1328             my $enable_colormap = shift;
1329              
1330             my $Image = Image::Magick->new();
1331              
1332             my $err = $Image->Read($image_path);
1333             if ($err) {
1334             warn $err;
1335             return {};
1336             }
1337              
1338             my $rh_info = {};
1339             $rh_info->{first_pixel_x} = 0,
1340             $rh_info->{first_pixel_y} = 0,
1341             $rh_info->{width} = $Image->Get('columns');
1342             $rh_info->{height} = $Image->Get('rows');
1343             $rh_info->{comment} = $Image->Get('comment');
1344             $rh_info->{colors}{total} = $Image->Get('colors');
1345             $rh_info->{format} = $Image->Get('magick');
1346              
1347             if ($remove_source_padding) {
1348             #
1349             # Find borders for this image.
1350             #
1351             # (RE-)SET:
1352             # - first_pixel(x/y) as the true point the image starts
1353             # - width/height as the true dimensions of the image
1354             #
1355             my $w = $rh_info->{width};
1356             my $h = $rh_info->{height};
1357              
1358             # seek for left/right borders
1359             my $first_left = 0;
1360             my $first_right = $w-1;
1361             my $left_found = 0;
1362             my $right_found = 0;
1363              
1364             BORDER_HORIZONTAL:
1365             for my $x (0 .. ceil(($w-1)/2)) {
1366             my $xr = $w-$x-1;
1367             for my $y (0..$h-1) {
1368             my $al = $Image->Get(sprintf('pixel[%s,%s]', $x, $y));
1369             my $ar = $Image->Get(sprintf('pixel[%s,%s]', $xr, $y));
1370            
1371             # remove rgb info and only get alpha value
1372             $al =~ s/^.+,//;
1373             $ar =~ s/^.+,//;
1374              
1375             if ($al != $self->{color_max} && !$left_found) {
1376             $first_left = $x;
1377             $left_found = 1;
1378             }
1379             if ($ar != $self->{color_max} && !$right_found) {
1380             $first_right = $xr;
1381             $right_found = 1;
1382             }
1383             last BORDER_HORIZONTAL if $left_found && $right_found;
1384             }
1385             }
1386             $rh_info->{first_pixel_x} = $first_left;
1387             $rh_info->{width} = $first_right - $first_left + 1;
1388              
1389             # seek for top/bottom borders
1390             my $first_top = 0;
1391             my $first_bottom = $h-1;
1392             my $top_found = 0;
1393             my $bottom_found = 0;
1394              
1395             BORDER_VERTICAL:
1396             for my $y (0 .. ceil(($h-1)/2)) {
1397             my $yb = $h-$y-1;
1398             for my $x (0 .. $w-1) {
1399             my $at = $Image->Get(sprintf('pixel[%s,%s]', $x, $y));
1400             my $ab = $Image->Get(sprintf('pixel[%s,%s]', $x, $yb));
1401            
1402             # remove rgb info and only get alpha value
1403             $at =~ s/^.+,//;
1404             $ab =~ s/^.+,//;
1405              
1406             if ($at != $self->{color_max} && !$top_found) {
1407             $first_top = $y;
1408             $top_found = 1;
1409             }
1410             if ($ab != $self->{color_max} && !$bottom_found) {
1411             $first_bottom = $yb;
1412             $bottom_found = 1;
1413             }
1414             last BORDER_VERTICAL if $top_found && $bottom_found;
1415             }
1416             }
1417             $rh_info->{first_pixel_y} = $first_top;
1418             $rh_info->{height} = $first_bottom - $first_top + 1;
1419             }
1420              
1421             if ($enable_colormap) {
1422             $self->_generate_colormap_for_image_properties($Image, $rh_info);
1423             }
1424              
1425             # save the original width as it may change later
1426             $rh_info->{original_width} = $rh_info->{width};
1427             $rh_info->{original_height} = $rh_info->{height};
1428              
1429             if ($add_extra_padding) {
1430             # fix the width of the image if a padding was added, as if the image
1431             # was actually wider
1432             $rh_info->{width} += 2 * $add_extra_padding;
1433             $rh_info->{height} += 2 * $add_extra_padding;
1434             }
1435              
1436             return $rh_info;
1437             }
1438              
1439             =head2 _compose_sprite_with_glue
1440              
1441             Compose a layout though a glue layout: first each image set is layouted, then
1442             it is composed using the specified glue layout.
1443              
1444             =cut
1445              
1446             sub _compose_sprite_with_glue {
1447             my $self = shift;
1448             my %options = @_;
1449              
1450             my @parts = @{$options{parts}};
1451              
1452             my $i = 0;
1453              
1454             # compose the following rh_source_info of Layout objects
1455             my $rh_layout_source_info = {};
1456              
1457             # also join each rh_sources_info_from the parts...
1458             my %global_sources_info;
1459              
1460             # keep all the layouts
1461             my @layouts;
1462              
1463             # layout each part
1464             for my $rh_part (@parts) {
1465              
1466             my $rh_sources_info = $self->_ensure_sources_info(%$rh_part);
1467             for my $key (sort { $a <=> $b } keys %$rh_sources_info) {
1468             $global_sources_info{$key} = $rh_sources_info->{$key};
1469             }
1470              
1471             my $Layout = $self->_ensure_layout(%$rh_part,
1472             rh_sources_info => $rh_sources_info
1473             );
1474              
1475             # we now do as if we were having images, but actually we have layouts
1476             # to do this we re-build a typical rh_sources_info.
1477             $rh_layout_source_info->{$i++} = {
1478             name => sprintf("%sLayout%s", $options{layout_name} // $options{layout}{name}, $i),
1479             pathname => "/fake/path_$i",
1480             parentdir => "/fake",
1481             width => $Layout->width,
1482             height => $Layout->height,
1483             first_pixel_x => 0,
1484             first_pixel_y => 0,
1485             };
1486              
1487             # save this layout
1488             push @layouts, $Layout;
1489             }
1490              
1491             # now that we have the $rh_source_info **about layouts**, we layout the
1492             # layouts...
1493             my $LayoutOfLayouts = $self->_ensure_layout(
1494             layout => $options{layout},
1495             rh_sources_info => $rh_layout_source_info,
1496             );
1497              
1498             # we need to adjust the position of each element of the layout according to
1499             # the positions of the elements in $LayoutOfLayouts
1500             my $FinalLayout;
1501             for my $layout_id ($LayoutOfLayouts->get_item_ids()) {
1502             my $Layout = $layouts[$layout_id];
1503             my ($dx, $dy) = $LayoutOfLayouts->get_item_coord($layout_id);
1504             $Layout->move_items($dx, $dy);
1505             if (!$FinalLayout) {
1506             $FinalLayout = $Layout;
1507             }
1508             else {
1509             # merge $FinalLayout <- $Layout
1510             $FinalLayout->merge_with($Layout);
1511             }
1512             }
1513              
1514             # fix width and height
1515             $FinalLayout->{width} = $LayoutOfLayouts->width();
1516             $FinalLayout->{height} = $LayoutOfLayouts->height();
1517              
1518             # now simply draw the FinalLayout
1519             return $self->_write_image(%options,
1520             Layout => $FinalLayout,
1521             rh_sources_info => \%global_sources_info,
1522             );
1523             }
1524              
1525             =head2 _compose_sprite_without_glue
1526              
1527             Compose a layout without glue layout: the previously lay-outed image set
1528             becomes part of the next image set.
1529              
1530             =cut
1531              
1532             sub _compose_sprite_without_glue {
1533             my $self = shift;
1534             my %options = @_;
1535              
1536             my %global_sources_info;
1537              
1538             my @parts = @{$options{parts}};
1539              
1540             my $LayoutOfLayouts;
1541              
1542             my $i = 0;
1543              
1544             for my $rh_part (@parts) {
1545             $i++;
1546            
1547             # gather information about images in the current part
1548             my $rh_sources_info = $self->_ensure_sources_info(%$rh_part);
1549              
1550             # keep composing the global sources_info structure
1551             # as we find new images... we will need this later
1552             # when we actually write the image.
1553             for my $key (sort { $a <=> $b } keys %$rh_sources_info) {
1554             $global_sources_info{$key} = $rh_sources_info->{$key};
1555             }
1556              
1557             if (!defined $LayoutOfLayouts) {
1558             # we keep the first layout
1559             $LayoutOfLayouts = $self->_ensure_layout(%$rh_part,
1560             rh_sources_info => $rh_sources_info
1561             );
1562             }
1563             else {
1564             # tweak the $rh_sources_info to include a new
1565             # fake image (the previously created layout)
1566             my $fake_img_id = $self->_get_image_id();
1567             $rh_sources_info->{$fake_img_id} = {
1568             name => 'FakeImage' . $i,
1569             pathname => "/fake/path_$i",
1570             parentdir => "/fake",
1571             width => $LayoutOfLayouts->width,
1572             height => $LayoutOfLayouts->height,
1573             first_pixel_x => 0,
1574             first_pixel_y => 0,
1575             };
1576              
1577             # we merge down this layout with the first
1578             # one, but first we must fix it, as it may
1579             # have been moved during this second
1580             # iteration.
1581             my $Layout = $self->_ensure_layout(%$rh_part,
1582             rh_sources_info => $rh_sources_info
1583             );
1584              
1585             # where was LayoutOfLayout positioned?
1586             my ($lol_x, $lol_y) = $Layout->get_item_coord($fake_img_id);
1587              
1588             # fix previous layout
1589             $LayoutOfLayouts->move_items($lol_x, $lol_y);
1590              
1591             # now remove it from $Layout and merge down!
1592             $Layout->delete_item($fake_img_id);
1593             $LayoutOfLayouts->merge_with($Layout);
1594              
1595             # fix the width that doesn't get updated with
1596             # the new layout...
1597             $LayoutOfLayouts->{width} = $Layout->width();
1598             $LayoutOfLayouts->{height} = $Layout->height();
1599             }
1600             }
1601              
1602             # draw it all!
1603             return $self->_write_image(%options,
1604             Layout => $LayoutOfLayouts,
1605             rh_sources_info => \%global_sources_info
1606             );
1607             }
1608              
1609              
1610             =head2 _generate_color_histogram
1611              
1612             Generate color histogram out of the information structure of all the images.
1613              
1614             =cut
1615              
1616             sub _generate_color_histogram {
1617             my $self = shift;
1618             my $rh_source_info = shift;
1619              
1620             if (!$self->{enable_colormap}) {
1621             die "cannot generate color histogram with enable_colormap option disabled";
1622             }
1623              
1624             my %histogram;
1625             for my $id (sort { $a <=> $b } keys %$rh_source_info) {
1626             for my $color (sort keys %{ $rh_source_info->{$id}{colors}{map} }) {
1627             my $rah_colors_info = $rh_source_info->{$id}{colors}{map}{$color};
1628              
1629             $histogram{$color} = scalar @$rah_colors_info;
1630             }
1631             }
1632              
1633             return \%histogram;
1634             }
1635              
1636             =head2 _verbose
1637              
1638             Print verbose output only if the verbose option was passed as input.
1639              
1640             =cut
1641              
1642             sub _verbose {
1643             my $self = shift;
1644             my $msg = shift;
1645              
1646             if ($self->{is_verbose}) {
1647             print "${msg}\n";
1648             }
1649             }
1650              
1651             =head2 _generate_colormap_for_image_properties
1652              
1653             Load the color map into the image properties hashref. This method takes 85% of
1654             the execution time when the sprite is generated with enable_colormap = 1.
1655              
1656             =cut
1657              
1658              
1659             sub _generate_colormap_for_image_properties {
1660             my($self, $Image, $rh_info) = @_;
1661             return 1 if ref $rh_info->{colors}{map};
1662             # Store information about the color of each pixel
1663             $rh_info->{colors}{map} = {};
1664             my $x = 0;
1665             for my $fake_x ($rh_info->{first_pixel_x} .. $rh_info->{width}) {
1666              
1667             my $y = 0;
1668             for my $fake_y ($rh_info->{first_pixel_y} .. $rh_info->{height}) {
1669              
1670             my $color = $Image->Get(
1671             sprintf('pixel[%s,%s]', $fake_x, $fake_y),
1672             );
1673              
1674             push @{$rh_info->{colors}{map}{$color}}, {
1675             x => $x,
1676             y => $y,
1677             };
1678              
1679             $y++;
1680             }
1681             }
1682             return 1;
1683             }
1684              
1685             =head1 LICENSE AND COPYRIGHT
1686              
1687             Copyright 2013 Savio Dimatteo.
1688              
1689             This program is free software; you can redistribute it and/or modify it
1690             under the terms of either: the GNU General Public License as published
1691             by the Free Software Foundation; or the Artistic License.
1692              
1693             See http://dev.perl.org/licenses/ for more information.
1694              
1695              
1696             =cut
1697              
1698             1; # End of CSS::SpriteMaker