scripts/image_maps.pl

   1 #!/usr/bin/perl
   2
   3 use strict;
   4 use GD;
   5 use Getopt::Long;
   6 use File::Basename;
   7
   8
   9 my $css_file   = 'generated.css';
  10 my $image_file = 'generated.png';
  11 my $class_for_map = 'icon';
  12
  13 GetOptions(
  14   'css-out=s'    => \$css_file,
  15   'image-out=s'  => \$image_file,
  16   'icon-class=s' => \$class_for_map,
  17 );
  18
  19 my @files = @ARGV;
  20 my @gd_images;
  21
  22 GD::Image->trueColor(1);
  23
  24 # read files
  25
  26 for my $filename (@files) {
  27   my $image = GD::Image->newFromPng($filename);
  28    if (!defined $image) {
  29      warn "warning: could not load image '$filename'. skpping...";
  30      next;
  31    }
  32   push @gd_images, {
  33     gd       => $image,
  34     filename => $filename,
  35   };
  36 }
  37
  38 # make target layout
  39 # for simplification thi will check if all the  images have the same dimensions
  40 # and croak if not
  41 my $first_height = $gd_images[0]->{gd}->height;
  42 my $first_width  = $gd_images[0]->{gd}->width;
  43
  44 use Data::Dumper;
  45
  46 for my $img (@gd_images) {
  47   die 'heights are not equal' if $first_height != $img->{gd}->height;
  48   die 'widths are not equal'  if $first_width  != $img->{gd}->width;
  49 }
  50
  51 # all equal? nice.
  52 # we'll be lazy and just put them all together left-to-right
  53 my $new_height = $first_height;
  54 my $new_width  = $first_width * @gd_images;
  55
  56 my $new_image = GD::Image->new($new_width, $new_height, 1);
  57 # now copy them all together, and keep a referende to;
  58
  59 $new_image->saveAlpha(1);
  60 $new_image->alphaBlending(0);
  61
  62 my $h_offset = 0;
  63 for (@gd_images) {
  64   $_->{h_offset} = $h_offset;
  65   $_->{v_offset} = 0;
  66   $new_image->copy($_->{gd}, $_->{h_offset}, $_->{v_offset}, 0, 0, $_->{gd}->width, $_->{gd}->height);
  67 } continue {
  68   $h_offset += $_->{gd}->width;
  69 }
  70
  71 # now write that png...
  72 {
  73   open my $file, '>:raw', $image_file or die "can't write to $image_file";
  74   print $file $new_image->png;
  75 }
  76
  77 # make css file
  78 {
  79   open my $file, ">", $css_file or die "can't write too $css_file";
  80   print $file ".$class_for_map { background: url(../$image_file) ${first_width}px 0px no-repeat; padding: 0; width: ${first_width}px; height: ${first_height}px; }\n";
  81
  82   for (@gd_images) {
  83     my $name = fileparse($_->{filename}, ".png");
  84
  85     # the full grammar for valid css class names is completely bonkers (to put it mildly).
  86     # so instead of trying to punch filenames into those class names, we'll
  87     # just reduce them to a nice minimal set of lower case /[a-z0-9_-]*/
  88     $name = lc $name;
  89     $name =~ s/[^a-z0-9_-]/-/g;
  90     print $file ".$class_for_map.$name { background-position: -$_->{h_offset}px 0px; }\n";
  91   }
  92 }
  93
  94 1;
  95
  96 __END__
  97
  98 =encoding utf-8
  99
 100 =head1 NAME
 101
 102 image_maps - generates image maps for css sprites from images in a directory
 103
 104 =head1 SYNOPSIS
 105
 106   scripts/image_maps.pl \
 107     --out-css=css/icons_16.css \
 108     --out-image= image/maps/icons_16.png \
 109     image/icons/16x16/*
 110
 111 =head1 DESCRIPTION
 112
 113 =head1 OPTIONS
 114
 115 =head1 BUGS
 116
 117 None yet. :)
 118
 119 =head1 AUTHOR
 120
 121 Sven Schoeling E<lt>s.schoeling@linet-services.deE<gt>
 122
 123 =cut
 124
 125