--- /dev/null
+#!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
projects / imager.git / commitdiff