The Perl Toolchain Summit needs more sponsors. If your company depends on Perl, please support this very important event.
#!perl -w
use strict;
use Imager;
use Imager::Fountain;
use Getopt::Long;

Getopt::Long::Configure("bundling");

# see usage() for a description of the parameters we accept
my $border_width = 10;
my $border_height = 10;
my $border_thickness; # sets width and height and overrides them
my $fountain;
my $color = 'red';
GetOptions('width|w=i' => \$border_width,
	   'height|h=i' => \$border_height,
	   'thickness|t=i' => \$border_thickness,
	   'fountain|f=s' => \$fountain,
	   'color|c=s' => \$color)
  or usage();

# make sure we got sane values
if (defined $border_thickness) {
  if ($border_thickness <= 0) {
    die "--thickness must be positive\n";
  }
  $border_width = $border_height = $border_thickness;
}
elsif ($border_width < 0) {
  die "--width must non-negative\n";
}
elsif ($border_height < 0) {
  die "--height must be non-negative\n";
}
elsif ($border_width == 0 && $border_height == 0) {
  # not much point if both are zero
  die "One of --width or --height must be positive\n";
}

my $src_name = shift;
my $out_name = shift
  or usage();

# treat extras as an error
@ARGV
  and usage(); 

# load the source, let Imager work out the name
my $src_image = Imager->new;
$src_image->read(file=>$src_name)
  or die "Cannot read source image $src_name: ", $src_image->errstr, "\n";

my $out_image;
if ($fountain) {
  # add a fountain fill border
  my ($out_color, $in_color) = split /,/, $fountain, 2;
  $in_color
    or die "--fountain '$fountain' invalid\n";
  $out_image = fountain_border($src_image, $out_color, $in_color, 
			       $border_width, $border_height);
}
else {
  $out_image = solid_border($src_image, $color, 
			    $border_width, $border_height);
}

# write it out, and let Imager work out the output format from the
# filename
$out_image->write(file=>$out_name)
  or die "Cannot save $out_name: ", $out_image->errstr, "\n";

sub fountain_border {
  my ($src_image, $out_color_name, $in_color_name, 
      $border_width, $border_height) = @_;

  my $out_color = Imager::Color->new($out_color_name)
    or die "Cannot translate color $out_color_name: ", Imager->errstr, "\n";
  my $in_color = Imager::Color->new($in_color_name)
    or die "Cannot translate color $in_color_name: ", Imager->errstr, "\n";
  my $fountain = Imager::Fountain->new;
  $fountain->add
	(
	 c0 => $out_color,
	 c1 => $in_color,
	);

  my $out = Imager->new(xsize => $src_image->getwidth() + 2 * $border_width,
                        ysize => $src_image->getheight() + 2 * $border_height,
                        bits => $src_image->bits,
                        channels => $src_image->getchannels);

  my $width = $out->getwidth;
  my $height = $out->getheight;
  # these mark the corners of the inside rectangle, done here
  # to reduce the redundancy below
  my $in_left = $border_width - 1;
  my $in_right = $width - $border_width;
  my $in_top = $border_height - 1;
  my $in_bottom = $height - $border_height;

  # four linear fountain fills, one for each side
  # Note: we overlap the sides with the top and bottom to avoid
  # having them both anti-alias against the black background where x==y
  # (and the other corners)
  # top
  $out->polygon(x => [ 0, $width-1, $width-1, 0  ],
		y => [ 0, 0,        $in_top,  $in_top ],
		fill => { fountain => 'linear',
			  segments => $fountain,
			  xa => 0, ya => 0,
			  xb => 0, yb => $border_height });
  # bottom
  $out->polygon(x => [ 0,         $width-1,  $width-1,  0 ],
		y => [ $height-1, $height-1, $in_bottom, $in_bottom ],
		fill => { fountain => 'linear',
			  segments => $fountain,
			  xa => 0, ya => $height-1,
			  xb => 0, yb => $height-$border_height });
  # left
  $out->polygon(x => [ 0, 0,         $in_left,   $in_left ],
		y => [ 0, $height-1, $in_bottom, $in_top ],
		fill => { fountain => 'linear',
			  segments => $fountain,
			  xa => 0, ya => 0, 
			  xb => $border_width, yb => 0 });
  # right
  $out->polygon(x => [ $width-1, $width-1,  $in_right,  $in_right ],
		y => [ 0,        $height-1, $in_bottom, $in_top ],
		fill => { fountain => 'linear',
			  segments => $fountain,
			  xa => $width-1, ya => 0,
			  xb => $width-$border_width, yb => 0 });

  # and put the source in
  $out->paste(left => $border_width,
              top => $border_height,
              img => $src_image);

  return $out;
}

sub solid_border {
  my ($source, $color, $border_width, $border_height) = @_;

  my $out = Imager->new(xsize => $source->getwidth() + 2 * $border_width,
                        ysize => $source->getheight() + 2 * $border_height,
                        bits => $source->bits,
                        channels => $source->getchannels);

  # we can do it the lazy way for a solid border - just fill the whole image
  $out->box(filled => 1, color=>$color)
    or die "Invalid color '$color':", $out->errstr, "\n";

  $out->paste(left => $border_width,
              top => $border_height,
              img => $source);

  return $out;
}

sub usage {
  print <<EOS;
Usage: $0 [options] sourceimage outimage
Options are:
  --width <pixels> | -w <pixels>
    Set width of border (default 10)
      eg. --width 25
  --height <pixels> | -h <pixels>
    Set height of border (default 10)
      eg. --height 30
  --thickness <pixels> | -t <pixels>
    Sets width and height of border, overrides -w and -h
      eg. --thickness 20
  --fountain <outcolor>,<incolor> | -f outcolor,incolor
    Creates a border that's a linear fountain fill with outcolor at the
    outside and incolor at the inside.
      eg. --fountain red,black
  --color <color>
    Sets the color of the default solid border.  Ignored if --fountain
    is supplied.  (default red)
      eg. --color blue
EOS
  exit 1;
}

=head1 NAME

border.pl - sample to add borders to an image

=head1 SYNOPSIS

  perl border.pl [options] input output

=head1 DESCRIPTION

Simple sample of adding borders to an image.

=head1 AUTHOR

Tony Cook <tony@develop-help.com>

=head1 REVISION

$Revision$

=cut