samples/border.pl

   1 #!perl -w
   2 use strict;
   3 use Imager;
   4 use Imager::Fountain;
   5 use Getopt::Long;
   6
   7 Getopt::Long::Configure("bundling");
   8
   9 # see usage() for a description of the parameters we accept
  10 my $border_width = 10;
  11 my $border_height = 10;
  12 my $border_thickness; # sets width and height and overrides them
  13 my $fountain;
  14 my $color = 'red';
  15 GetOptions('width|w=i' => \$border_width,
  16            'height|h=i' => \$border_height,
  17            'thickness|t=i' => \$border_thickness,
  18            'fountain|f=s' => \$fountain,
  19            'color|c=s' => \$color)
  20   or usage();
  21
  22 # make sure we got sane values
  23 if (defined $border_thickness) {
  24   if ($border_thickness <= 0) {
  25     die "--thickness must be positive\n";
  26   }
  27   $border_width = $border_height = $border_thickness;
  28 }
  29 elsif ($border_width < 0) {
  30   die "--width must non-negative\n";
  31 }
  32 elsif ($border_height < 0) {
  33   die "--height must be non-negative\n";
  34 }
  35 elsif ($border_width == 0 && $border_height == 0) {
  36   # not much point if both are zero
  37   die "One of --width or --height must be positive\n";
  38 }
  39
  40 my $src_name = shift;
  41 my $out_name = shift
  42   or usage();
  43
  44 # treat extras as an error
  45 @ARGV
  46   and usage();
  47
  48 # load the source, let Imager work out the name
  49 my $src_image = Imager->new;
  50 $src_image->read(file=>$src_name)
  51   or die "Cannot read source image $src_name: ", $src_image->errstr, "\n";
  52
  53 my $out_image;
  54 if ($fountain) {
  55   # add a fountain fill border
  56   my ($out_color, $in_color) = split /,/, $fountain, 2;
  57   $in_color
  58     or die "--fountain '$fountain' invalid\n";
  59   $out_image = fountain_border($src_image, $out_color, $in_color,
  60                                $border_width, $border_height);
  61 }
  62 else {
  63   $out_image = solid_border($src_image, $color,
  64                             $border_width, $border_height);
  65 }
  66
  67 # write it out, and let Imager work out the output format from the
  68 # filename
  69 $out_image->write(file=>$out_name)
  70   or die "Cannot save $out_name: ", $out_image->errstr, "\n";
  71
  72 sub fountain_border {
  73   my ($src_image, $out_color_name, $in_color_name,
  74       $border_width, $border_height) = @_;
  75
  76   my $out_color = Imager::Color->new($out_color_name)
  77     or die "Cannot translate color $out_color_name: ", Imager->errstr, "\n";
  78   my $in_color = Imager::Color->new($in_color_name)
  79     or die "Cannot translate color $in_color_name: ", Imager->errstr, "\n";
  80   my $fountain = Imager::Fountain->new;
  81   $fountain->add
  82         (
  83          c0 => $out_color,
  84          c1 => $in_color,
  85         );
  86
  87   my $out = Imager->new(xsize => $src_image->getwidth() + 2 * $border_width,
  88                         ysize => $src_image->getheight() + 2 * $border_height,
  89                         bits => $src_image->bits,
  90                         channels => $src_image->getchannels);
  91
  92   my $width = $out->getwidth;
  93   my $height = $out->getheight;
  94   # these mark the corners of the inside rectangle, done here
  95   # to reduce the redundancy below
  96   my $in_left = $border_width - 1;
  97   my $in_right = $width - $border_width;
  98   my $in_top = $border_height - 1;
  99   my $in_bottom = $height - $border_height;
 100
 101   # four linear fountain fills, one for each side
 102   # Note: we overlap the sides with the top and bottom to avoid
 103   # having them both anti-alias against the black background where x==y
 104   # (and the other corners)
 105   # top
 106   $out->polygon(x => [ 0, $width-1, $width-1, 0  ],
 107                 y => [ 0, 0,        $in_top,  $in_top ],
 108                 fill => { fountain => 'linear',
 109                           segments => $fountain,
 110                           xa => 0, ya => 0,
 111                           xb => 0, yb => $border_height });
 112   # bottom
 113   $out->polygon(x => [ 0,         $width-1,  $width-1,  0 ],
 114                 y => [ $height-1, $height-1, $in_bottom, $in_bottom ],
 115                 fill => { fountain => 'linear',
 116                           segments => $fountain,
 117                           xa => 0, ya => $height-1,
 118                           xb => 0, yb => $height-$border_height });
 119   # left
 120   $out->polygon(x => [ 0, 0,         $in_left,   $in_left ],
 121                 y => [ 0, $height-1, $in_bottom, $in_top ],
 122                 fill => { fountain => 'linear',
 123                           segments => $fountain,
 124                           xa => 0, ya => 0,
 125                           xb => $border_width, yb => 0 });
 126   # right
 127   $out->polygon(x => [ $width-1, $width-1,  $in_right,  $in_right ],
 128                 y => [ 0,        $height-1, $in_bottom, $in_top ],
 129                 fill => { fountain => 'linear',
 130                           segments => $fountain,
 131                           xa => $width-1, ya => 0,
 132                           xb => $width-$border_width, yb => 0 });
 133
 134   # and put the source in
 135   $out->paste(left => $border_width,
 136               top => $border_height,
 137               img => $src_image);
 138
 139   return $out;
 140 }
 141
 142 sub solid_border {
 143   my ($source, $color, $border_width, $border_height) = @_;
 144
 145   my $out = Imager->new(xsize => $source->getwidth() + 2 * $border_width,
 146                         ysize => $source->getheight() + 2 * $border_height,
 147                         bits => $source->bits,
 148                         channels => $source->getchannels);
 149
 150   # we can do it the lazy way for a solid border - just fill the whole image
 151   $out->box(filled => 1, color=>$color)
 152     or die "Invalid color '$color':", $out->errstr, "\n";
 153
 154   $out->paste(left => $border_width,
 155               top => $border_height,
 156               img => $source);
 157
 158   return $out;
 159 }
 160
 161 sub usage {
 162   print <<EOS;
 163 Usage: $0 [options] sourceimage outimage
 164 Options are:
 165   --width <pixels> | -w <pixels>
 166     Set width of border (default 10)
 167       eg. --width 25
 168   --height <pixels> | -h <pixels>
 169     Set height of border (default 10)
 170       eg. --height 30
 171   --thickness <pixels> | -t <pixels>
 172     Sets width and height of border, overrides -w and -h
 173       eg. --thickness 20
 174   --fountain <outcolor>,<incolor> | -f outcolor,incolor
 175     Creates a border that's a linear fountain fill with outcolor at the
 176     outside and incolor at the inside.
 177       eg. --fountain red,black
 178   --color <color>
 179     Sets the color of the default solid border.  Ignored if --fountain
 180     is supplied.  (default red)
 181       eg. --color blue
 182 EOS
 183   exit 1;
 184 }
 185
 186 =head1 NAME
 187
 188 border.pl - sample to add borders to an image
 189
 190 =head1 SYNOPSIS
 191
 192   perl border.pl [options] input output
 193
 194 =head1 DESCRIPTION
 195
 196 Simple sample of adding borders to an image.
 197
 198 =head1 AUTHOR
 199
 200 Tony Cook <tony@develop-help.com>
 201
 202 =head1 REVISION
 203
 204 $Revision$
 205
 206 =cut