Beefy Boxes and Bandwidth Generously Provided by pair Networks
go ahead... be a heretic
 
PerlMonks  

Creating Tiff's from perl

by JediWizard (Deacon)
on Jul 11, 2005 at 14:52 UTC ( [id://473962]=perlquestion: print w/replies, xml ) Need Help??

JediWizard has asked for the wisdom of the Perl Monks concerning the following question:

Thanks in advance for any wisdom shared.

I need (want) to dynamically create fairly simple tiff images in perl. I need tiffs of a specific demension, containing only text of a specified font (and size) at very specific locations. The images must be 600 DPI, one bit per sample (black text on a white background), with CCITT Group 4 Fax Compression.

I have tried using the Imager package, as it looked to best match my needs, but have not yet been able to get it to output 1 bit per sample, nor Group4 compression. Below is sample code using Imager:

#!/usr/local/bin/perl -w use strict; use Imager; my $impact = Imager::Font->new(file => '/home/me/test/IMPACT.ttf'); my $times = Imager::Font->new(file => '/home/me/test/times.ttf'); my $img = Imager->new(xsize=>5500, ysize=>6600, chanels=>1, class => ' +fax') || warn Imager->errstr; my $image = $img->to_paletted(colors=>[Imager::Color->new(255,255,255) +], class => 'fax', make_colors => 'none', translate => 'errdiff', errdiff => 'stucki') || die Imager->errstr; $image->string(text=>'14', x=>1750, 'y'=>1220, size=>1470, font=>$impa +ct, color=>'black', aa=>1, align=>0) or warn $image->errstr; $image->string(text=>'13716', x=>750, 'y'=>3100, size=>1450, font=>$im +pact, color=>'black', aa=>1, align=>0) or warn $image->errstr; $image->write(file=>'./foo.tif') or die $image->errstr; exit;

They say that time changes things, but you actually have to change them yourself.

—Andy Warhol

Replies are listed 'Best First'.
Re: Creating Tiff's from perl
by mpeters (Chaplain) on Jul 11, 2005 at 15:17 UTC
    Crazy as this sounds, I had to to almost the exact same thing recently. I too used Imager. Not only did my images need text in exact locations, but they also needed certain markings, etc. Here's how I did it:

    • First create a tiff of the desired size with any needed markings, at 600 dpi and black and white mode.
    • In perl, use Imager to open that image, create a font, and then write to it in the specified coordinates. Something like:
      my $img = Imager->new(); $img->open( file => '/path/to/tiff/file' ); my $color = Imager::Color->new("#000000"); my $font = Imager::Font->new( file => '/path/to/ttf/font', color => $color, ); $img->string( text => $stuff_to_write, x => $x, y => $y, font => $font, );
    My project also had the requirement that each letter of each word need to be in a certain place, so I just had a wrapper sub that would take a word and the x/y coords, split the word into individual letters and then use a 'spacing' var to increment the x value and print each letter one by one.

    HTH

    -- More people are killed every year by pigs than by sharks, which shows you how good we are at evaluating risk. -- Bruce Schneier

      Thank you for you advice. This code does come closer to what I want, but not quite there yet. Even with a one bit input image, with Group4 fax compression, the outputed image becomes 8 bit, without compression.


      They say that time changes things, but you actually have to change them yourself.

      —Andy Warhol

        I'm sorry, I forgot to show how to write out the image, silly me!
        $img->write( { file => $tmp->filename, type => 'tiff', class => 'fax', } );
        And then in order to get the Group4 compression I did resort to ImageMagick's convert util.
        system("convert -page Letter -compress Group4 $filename $filename") +;
        The last part I'm still not completely happy with, but since this is a batch process I didn't have to worry so much about having the extra system call.

        -- More people are killed every year by pigs than by sharks, which shows you how good we are at evaluating risk. -- Bruce Schneier
Re: Creating Tiff's from perl
by marto (Cardinal) on Jul 11, 2005 at 16:15 UTC

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: perlquestion [id://473962]
Approved by marto
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others scrutinizing the Monastery: (5)
As of 2024-04-19 01:27 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found