Drawing a 2 color (monochrome/bilevel) image takes forever

[myicq]

I have made a Perl script to draw vertical lines at fixed distances. Output must be 2bit BMP (bilevel).
The image size is 600 DPI fixed.

Drawing and image generation works fine, and is super fast. It's the writing that is a time killer.

An image of 15000 pixel horizontal works OK, and is done in 7-10 sec. Acceptable. If I increase to 25000 pixel, the process just dies and will not finish. Unless I remove the bilevel part, and I get an image of 280 Mb (!).

What can I do to make this fast ? I simply do not understand why drawing pixels in a 2bit picture should take so long.

My code:

Code: Select all

use Image::Magick;
use Getopt::Long;
use Pod::Usage;

my $width = 5000;
my $height = 1200;
my $lineoffset = 50;  # mm - in metric version.. converts to pixel using int((600/ 25.4)*mm)
my $linewidth = 4;
my $fontheight = 75;
my $man = 0;
my $helpme = 0;

$res = GetOptions("width|w=i" => \$width,   # width
                  "height|h=i" => \$height,
                  "offset|o=i" => \$lineoffset,
                  "line|l=i"   => \$linewidth,
                  "font|f=i"   => \$fontheight,
                  "help|?"     => \$helpme)
   or pod2usage(2);
my($image, $p, $q);

pod2usage(-verbose => 2) if $helpme;


# change lineoffset to PIXEL

$width_mm = int(0.5+$width/((600/25.4)));

print STDERR <<DEB;
========================================
Parameters:
-------------
Width = $width       
Width mm = $width_mm
Height = $height
Offset = $lineoffset
Line = $linewidth
Font = $fontheight
========================================
DEB

# pixels between each line
my $cur_x = 0;                # current line pos


# create a new image
$image = Image::Magick->new (size=>$width . "x" . $height);
$image->Read('xc:white');


$r = $image->Set(			
         monochrome=>"True",
         colors => 2,
         );
     warn "$r" if "$r";
	
    $lineno = 0;


# VERTICAL LINES
while ($cur_x < $width_mm) {

    $cur_x = $lineno * $lineoffset;    # METRIC position of our line...
    $cur_x_pixel = int(0.5+(600/25.4)*$cur_x);
           print STDERR "\t\tLineno. $lineno  .. $cur_x   [$cur_x_pixel  px ] \n" ;
        my $pts =  $cur_x_pixel . ','  . 1;
        my $pts2 = $cur_x_pixel . ',' . $height;
        $image->Draw(
            primitive=>'line',
            points=> $pts . ' ' . $pts2,
            stroke=>'black',
            strokewidth=>$linewidth
          );
        $lineno++;
}

$r = $image->Set(			
            gravity=>"center"
            );
            warn "$r" if "$r";

$image->Annotate(
            text=>'Distance between lines is ' . $lineoffset . " mm ",
            font=> 'arial.ttf',
            fill=> 'black',
            pointsize => $fontheight,
            );


$r = $image->Set(			
         monochrome=>"True",
         colors => 2,
         antialias => "false",
         );
     warn "$r" if "$r";

my $ofn = "metric_grid_h".$height. "_" .$lineoffset."x".$linewidth.".bmp";
print STDERR "Writing to $ofn\n";
$image->Write($ofn);
undef $image;

__END__
=head1 NAME

sample - using my little grid script...
This is a test help message. My first POD!

=head1 OPTIONS

=over 8

=item B<-help>

Print a brief help message and exits.

=item B<-man>

Prints the manual page and exits.

=back

=head1 DESCRIPTION

B<This program> will read the given input file(s) and do something
useful with the contents thereof.