Beefy Boxes and Bandwidth Generously Provided by pair Networks
Your skill will accomplish
what the force of many cannot
 
PerlMonks  

Comment on

( #3333=superdoc: print w/ replies, xml ) Need Help??

This script uses Image::Magick to generate pairs of images for each image in a directory tree. The names for the images are generated using the given directory name as a template. Text provided on the command line is used to overstrike each small image (but not the thumbnail) using translucent text.

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 c +ommand line\n". "for publication on a web site. The files are first renamed usin +g\n". "the folder name as the name of the first image. A thumbnail ima +ge is\n". "then generated with the suffix _sm. Finally a small image is ge +nerated\n". "and overprinted with text provided as the first item on the com +mand line.\n". "\n". "PrepPhotos <brand text> <folders list>\n". "\n". "The <brand text> 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 shoul +d contain\n". "as many trailing 0's as are to be used in the serial number. Fo +r 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 n +umbered\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_adv +ance) = $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 ima +ge 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; }

The code is somewhat Windows oriented. The font used by Annotate may need to be fixed and the file extension management (look for $ext) are likely to need attention on other platforms.


Perl is Huffman encoded by design.

In reply to Generate thumbnail and small overstruck images for web publication by GrandFather

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":



  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?
    Username:
    Password:

    What's my password?
    Create A New User
    Chatterbox?
    and the web crawler heard nothing...

    How do I use this? | Other CB clients
    Other Users?
    Others chanting in the Monastery: (13)
    As of 2015-07-31 09:24 GMT
    Sections?
    Information?
    Find Nodes?
    Leftovers?
      Voting Booth?

      The top three priorities of my open tasks are (in descending order of likelihood to be worked on) ...









      Results (276 votes), past polls