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

Hello,
I'm using the following snippet I found on perlmonks and have tried altering the code to transform a title image I have from color to black and white with the text being all black and the background being all white. I've had success doing this but when I save the file it still saves it using 256 colors.

Is there anyway to allocate just black and white before saving it to decrease the file size?

The code snippet is below: 

use warnings;
use strict;
use GD;

my $file = $ARGV[0];
chomp $file;

convert_to_bw($file);

sub convert_to_bw {

    my $in_file = shift;
    my $image = GD::Image->new("$in_file");

    unlink $in_file;
    my $ni_file = $in_file;

    my $i = 0;
    my $t = $image->colorsTotal();

    while($i < $t) {
    my( @c ) = $image->rgb( $i );
    
    # Convert the color image to black and white
    my $g = ( $c[0] + $c[1] + $c[2] ) / 3;

    $image->colorDeallocate($i);
    $image->colorAllocate( $g, $g, $g );

    my( @d ) = $image->rgb( $i );

    # Replace the background color with white 
    if ($d[0] > 150) {
        $image->colorDeallocate($i);
        $image->colorAllocate( 255, 255, 255 );
    }

    my( @e ) = $image->rgb( $i );

    # Replace the text with black 
    if ($e[0] > 10 && $e[0] < 255) {
        $image->colorDeallocate($i);
        $image->colorAllocate( 0, 0, 0 );
    }
        
    $i++;
    }

    my $colorsTotal = $image->colorsTotal();
    print "COLOR TOTAL: $colorsTotal\n";

    write_file( $ni_file, $image->png(9) );
}

sub write_file {
    
    my $i = shift;
    open DISPLAY, ">$i" or warn "can't clobber $i $!";
    binmode DISPLAY;
    print DISPLAY @_;
    close DISPLAY;
}

[download]

Replies are listed 'Best First'.
Re: GD - Two colors?
by BrowserUk (Patriarch) on Aug 06, 2007 at 21:12 UTC

    The script works by manipulating indexes, replacing the palette entries with one of two rgb values depending upon the threshhold calculation. GD doesn't make any attempt to compress the pallete. You've told it that the image contains 256 'colors'--despite that they all map to one of two sets of rgb values--so it doesn't attempt to discard any 'reduntant' palette entries.

    You can achieve what you want by creating a new image that has only two palette entries and mapping the pixels across yourself. This runs more slowly, but results in a 1-bit BW image output rather than a 8-bit color with all the entries mapped to black or white. Ie. Much smaller images.

    The following code does that, and produces an output file with the same name as the input prefixed with 'BW-'. I've also made the threashhold a command line parameter -T=nn: values range from 0 .. 255 per the original algorithm. 

    #! perl -slw
use strict;
use GD;

our $T ||= 150;

my $file = shift @ARGV;
die "$file not found" unless -e $file;

my $in = GD::Image->new( $file ) or die $!;
my( $w, $h ) = $in->getBounds;

## New palette image with just two colors
my $out = GD::Image->newPalette( $w, $h );
my $black = $out->colorAllocate( 0, 0, 0 );
my $white = $out->colorAllocate( 255, 255, 255 );

for my $y ( 0 .. $h - 1 ) {
    for my $x ( 0 .. $w -1 ) {
        my( $r, $g, $b ) = $in->rgb( $in->getPixel( $x, $y ) );
        ## Map the pixels relative to the threshhold 
        my $index = (( $r = $g +$b ) / 3) > $T ? $black : $white;
        $out->setPixel( $x, $y, $index );
    }
}

open OUT, '>:raw:perlio', "BW-$file" or die $!;
print OUT $out->png( 9 );
close OUT;

#system 1, "BW-$file"; ## display image

    [download]
    Examine what is said, not who speaks -- Silence betokens consent -- Love the truth but pardon error.
    "Science is about questioning the status quo. Questioning authority".
    In the absence of evidence, opinion is indistinguishable from prejudice.
[reply]
[d/l]
      Thanks, that works perfectly!
[reply]

Back to Seekers of Perl Wisdom