Someone on comp.lang.perl.tk wanted to know how to make a text, with a "mirror" of itself. Well I found a way with Imager, and it used so many commonly needed Imager methods, that it is actually a good general purpose demo of Imager capabilities. I post it for that purpose....a small script to illustrate alot of Imager's syntax. The Generic.tff font, can be any font you want, it is the path to the font file.

This code will take a quoted line of text as first commandline argument. It will then make an image of the text, crop it to size, mirror it, and combine it all into 1 file. 

#!/usr/bin/perl
use warnings;
use strict;
use Imager;


my $text = shift || 'Perlmonks Rule';

#make the xsize huge to accept alot of text 
#it will be cropped to text size later 
my $img = Imager->new(xsize=>900,ysize=>50,channels=>4);

my $blue = Imager::Color->new("#0000FF");
my $font = Imager::Font->new(
                file  => 'Generic.ttf', #path to any font file 
                color => $blue,
                size  => 40);

$img->string(font  => $font,
              text => $text,
             x     => 0,
             y     => 40,
             size  => 40,
             color => $blue,
             aa    => 1);

my ($neg_width, $global_descent, $pos_width, $global_ascent,
    $descent, $ascent) = $font->bounding_box(string => "$text");
print "$neg_width, $global_descent, $pos_width, $global_ascent,$descen
+t, $ascent\n";

my $img1 = $img->crop(left=>$neg_width, right=>$pos_width,
                      top=> -$global_descent, bottom=>$global_ascent +
+ 5); #fudge factor 

$img1->write(file=>$0.'.png', type=>'png')
           or die "Cannot write: ",$img1->errstr;

my $img_mirror = $img1->copy();
$img_mirror->flip( dir => "h" );

$img_mirror->write(file=>$0.'-mirror.png', type=>'png')
           or die "Cannot write: ",$img_mirror->errstr;

#make a unified image 
my $img_uni =  Imager->new(xsize=>$pos_width * 2,ysize=>$global_ascent
+,channels=>4);
$img_uni->paste(left=>$pos_width,top=>0,img=>$img1);
$img_uni->paste(left=>0,top=>0,img=>$img_mirror);

$img_uni->write(file=>$0.'-uni.png', type=>'png')
           or die "Cannot write: ",$img_uni->errstr;

[download]

Replies are listed 'Best First'.
Re: Mirrored text with Imager
by chanio (Priest) on Jul 27, 2005 at 07:37 UTC
    Hi Zentara,

    I tryied this script, but it complains the following... 

     
>perl mirroredTxt.pl
Can't call method "bounding_box" on an undefined value at mirroredTxt.
+pl line 30.
>Exit code: 2

    [download]
    Any idea what is missing? Imager.pm is installed.

    { \ ( ' v ' ) / }
    ( \ _ / ) _ _ _ _ ` ( ) ' _ _ _ _
    ( = ( ^ Y ^ ) = ( _ _ ^ ^ ^ ^
    _ _ _ _ \ _ ( m _ _ _ m ) _ _ _ _ _ _ _ _ _ ) c h i a n o , a l b e r t o
    Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established
[reply]
[d/l]
      It probably can't find the "Generic.ttf" file, and therefore can't make any text to get a bbox on. I have a file called "Generic.ttf" in the directory where I run the script. You can copy any ttf file into your current directory, or specify the full path to a ttf file in the script.

      Reading "perldoc Imager::Font" will show you how to do it.

      I'm not really a human, but I play one on earth. flash japh
[reply]
        Thank you, zentara!

        Sorry, I wasn't paying attention (it was too late at night).

        I changed ... 

        $img_mirror->flip( dir => "v" );  ## "h"

        [download]
        and... 
        #make a unified image


#~__ my $img_uni =  Imager->new(xsize=>$pos_width * 2,ysize=>$global_a
+scent,channels=>4);


#~__ $img_uni->paste(left=>$pos_width,top=>0,img=>$img1);

#~__ $img_uni->paste(left=>0,top=>0,img=>$img_mirror);


my $img_uni =  Imager->new(xsize=>$pos_width ,ysize=>$global_ascent * 
+2,channels=>4);

$img_uni->paste(left=>0,top=>$global_ascent,img=>$img_mirror);
$img_uni->paste(left=>0,top=>0,img=>$img1);

        [download]
        To get the reflection that I was looking for.

        Is it possible to overwrite the generated image with another one?

        That is a Graphic Design technique to obtain sort of 3D characters that are easy to read on any background:

        • 1) write the text in white (##FFFFFF),
        • 2) overwrite the same text but changing the y offset 3 pixels down and offset x 5 pixels right , and in blue, for the example.
        Or even, overwriting the text three times: step 1, then overwrite with y offset of 6 pixels down and offset x 10 pixels right and in black, and finally overwrite with y offset of 3 pixels down and offset x 5 pixels right in blue.

        Then, in the mirror image it should be done in the opposite way: offset y up instead of down and offset x left instead of right.

          A  \ \        / |                                        _ _|  __ \
<-|-> \ \  \   /  __ \   _ \  __| _ \     _` | __ `__ \      |      /
  V    \ \  \ /   | | |  __/ |    __/    (   | |   |   |     |    _|
        \_/\_/   _| |_|\___|_|  \___|   \__,_|_|  _|  _|   ___|   _)
        /"\/"\   "| |"|/"""|"|  /"""|   /""`"|"|  "|  "|   """|   ")
  A    / /  / \   | | |  ""\ |    ""\    (   | |   |   |     |    "|
<-|-> / /  /   \  "" /   " /  ""| " /     ", | "" ,"" /      |      \
  v  / /        \ |                                        " "|  "" /

        [download]
        (done with http://figlet.de)

        Anyway, thank you for the snipet.-

        { \ ( ' v ' ) / }
        ( \ _ / ) _ _ _ _ ` ( ) ' _ _ _ _
        ( = ( ^ Y ^ ) = ( _ _ ^ ^ ^ ^
        _ _ _ _ \ _ ( m _ _ _ m ) _ _ _ _ _ _ _ _ _ ) c h i a n o , a l b e r t o
        Wherever I lay my KNOPPIX disk, a new FREE LINUX nation could be established
[reply]
[d/l]
[select]

Back to Cool Uses for Perl