use strict; use warnings; use Image::Magick; use File::Spec::Functions qw(splitpath); use File::Find; my $thumbX = 100; my $thumbY = 66; my $smallX = 443; my $smallY = 293; my $ratio = $smallX / $smallY; if (@ARGV == 0) { print "Prepares the graphics files from the folder passed on the command line\n". "for publication on a web site. The files are first renamed using\n". "the folder name as the name of the first image. A thumbnail image is\n". "then generated with the suffix _sm. Finally a small image is generated\n". "and overprinted with text provided as the first item on the command line.\n". "\n". "PrepPhotos \n". "\n". "The must be quoted unless it is a single word.\n". "Only .jpg and .gif files are processed. Multiple folders may be supplied.\n". "Folder names should not include punctuation. Folder names should contain\n". "as many trailing 0's as are to be used in the serial number. For example\n". "BAR000 would allow images BAR000 - BAR999 to be generated. Odd things\n". "will happen if too few digits are allowed for. The images are numbered\n". "starting with the given sequence number.\n"; exit (1); } my $overText = shift; my $overL = Image::Magick->new(); my $overP = Image::Magick->new(); my $points = 50; $overL->Set (size=>"1x1"); $overL->ReadImage('xc:#808080'); # Nochange colour for Hardlight my ($x_ppem, $y_ppem, $ascender, $descender, $width, $height, $max_advance) = $overL->QueryFontMetrics ( pointsize => $points, text => "$overText", '@C:/WINDOWS/Fonts/times.ttf', # Omit for default font ); $width *= 1.2; $overL->Resize (width => $width, height => $height); $overL->Annotate ( pointsize => $points, text => "$overText", gravity=>'center', stroke => '#C0C0C0', # Increase to make stroke more white fill => '#505050', # Decrease to make fill more black '@C:/WINDOWS/Fonts/times.ttf', # Omit for default font ); $height /= $width / $smallX; # Maintain font aspect ratio $overL->Resize (width=>$smallX, height=>$height); # Scale width to image size $overP = $overL->Clone (); $overP->Resize (width=>$smallY, height=>$height * $smallY / $smallX); my $imageNumber; for (@ARGV) { ($imageNumber) = $_ =~ /(\w+)$/; find (\&process, $_); } print "Finished\n"; sub process {# process each file my $filename = $File::Find::name; my ($ext) = $filename =~ /(\..*?)$/; return if $filename !~ /\.(?:jpg|gif)$/i; return if -d $filename; my ($drive, $dir, $file) = splitpath ($filename); print "\nProcessing: $filename -> $imageNumber$ext\n"; my $image = Image::Magick->new (); my $thumb = Image::Magick->new (); $image->ReadImage ($filename); $thumb = $image->Clone (); my ($height, $width) = $image->Get ('height', 'width'); my $portrait = $height > $width; my ($x, $y) = ! $portrait ? ($thumbX, $thumbY) : ($thumbY, $thumbX); my $scaleX = $x / $width; my $scaleY = $y / $height; my $scale = $scaleX < $scaleY ? $scaleX : $scaleY; $thumb->Resize (width=>$width * $scale+0.5, height=>$height * $scale+0.5); $thumb->Write ("$drive$dir${imageNumber}_sm$ext"); ($x, $y) = ! $portrait ? ($smallX, $smallY) : ($smallY, $smallX); $scaleX = $x / $width; $scaleY = $y / $height; $scale = $scaleX < $scaleY ? $scaleX : $scaleY; $image->Resize (width=>$width * $scale+0.5, height=>$height * $scale+0.5); $image->Composite ( compose=>'Hardlight', image=> $portrait ? $overP : $overL, gravity=>'center' ); $image->Write ("$drive${dir}${imageNumber}$ext"); ++$imageNumber; }