comment on

I used ImageMagick based stuff for a long time. But i switched to GD for most of my stuff, because it also allows for ~~easy~~ acceptable pixel manipulation, even if it's painfully slow.

The basic calculation to calculate the new image dimension goes something like this, no matter which image manipulation module you end up using (from memory, untested):

# Check if we are limited by height or width of the source image
my $factor = $sourcewidth / $targetwidth;
if($sourceheight / $factor > $targetheight) {
    $factor = $sourceheight / $targetheight;
)
my $newwidth = int($sourcewidth / $factor);
my $newheight = int($sourceheight / $factor);
[download]

You can then, for example, use the copyResized method from GD:

$newpic->copyResized($sourcepic,
                              $destx, $desty, # DEST X Y
                              0, 0, # SRC X Y
                              $newwidth, $newheight, # DEST W H
                              $sourcewidth, $sourceheight, # SRC W H
                          );
[download]

It's also worth noting that there might be a lot more pixel massaging needed to be done, depending on what those resulting images are used for. For example, i have a use case where i have to print user provided logos onto thermal paper. I ended up having to implement multiple algorithms for transforming color images to black&white pixels from which the user can select. Here is the printAddGreyscaleImage() from my PageCamel Framework PrintProcessor.pm:

sub printAddGreyscaleImage {
    my ($self, $filename, $isbindata, $imagesoftness) = @_;
    
    my $reph = $self->{reph};
    
    if(!defined($imagesoftness)) {
        $imagesoftness = 1;
    }
    
    my $rawpic;
    if($isbindata) {
        $rawpic = GD::Image->newFromPngData($filename, 0);
    } else {
        $rawpic = GD::Image->newFromPng($filename, 0);
    }
            
    my ($w, $h) = $rawpic->getBounds();
    
    my $destw = $self->{width};
    my $scale = $w / $destw;
    my $desth = int($h / $scale);
    
    
    # Check if we got that image already cached
    my $cachekey = $imagesoftness . '_' . sha256_hex($rawpic->png);
    $reph->debuglog("   KEY $cachekey");
    if(defined($self->{imagecache}->{$cachekey})) {
        $reph->debuglog("   using cached greyscale image conversion");
        $self->{img}->copyResized($self->{imagecache}->{$cachekey},
                          0, $self->{imgoffs}, # DEST X Y
                          0, 0, # SRC X Y
                          $destw, $desth, # DEST W H
                          $destw, $desth, # SRC W H
                          );
        $self->{imgoffs} += $desth;
        return;
    }
    
    $reph->debuglog("   need to do image conversion");
    
    my $pic = GD::Image->new($destw, $desth);
    
    # Copy palette
    my $colorcount = $rawpic->colorsTotal;
    for(my $c = 0; $c < $colorcount; $c++) {
        my ($r,$g,$b) = $rawpic->rgb($c);
        $pic->colorAllocate($r, $g, $b);
    }
    
    $pic->copyResized($rawpic,
                      0, 0, # DEST X Y
                      0, 0, # SRC X Y
                      $destw, $desth, # DEST W H
                      $w, $h, # SRC W H
                    );
    
    # For caching converted images
    my $cachepic = GD::Image->new($destw, $desth);
    my $cachewhite = $cachepic->colorAllocate(255, 255, 255);
    my $cacheblack = $cachepic->colorAllocate(0, 0, 0);

    my @pixels;
    # Prepare for dithering
    for(my $y = 0; $y < $desth; $y++) {
        for(my $x = 0; $x < $destw; $x++) {
            my $index = $pic->getPixel($x, $y);
            my ($r,$g,$b) = $pic->rgb($index);
            my $greypixel = int(($r+$g+$b)/3);
            my $oldpixel = $greypixel * 1.0;

            $pixels[$x]->[$y] = $oldpixel;
        }
    }
    
    if($imagesoftness == 0) {
        for(my $y = 0; $y < $desth; $y++) {
            for(my $x = 0; $x < $destw; $x++) {
                my $oldpixel = $pixels[$x]->[$y];
    
                # Simple monochrome conversion
                if($oldpixel < 128) {
                    $self->{img}->setPixel($x, $y + $self->{imgoffs}, 
+$self->{imgblack});
                    $cachepic->setPixel($x, $y, $cacheblack);
                }
            }
        }
        $self->{imagecache}->{$cachekey} = $cachepic;
    } elsif($imagesoftness == 2) {
        # Floyd-Steinberg dithering
        my @dither = (
            [0, 0, 7],
            [3, 5, 1],
        );
        for(my $y = 0; $y < $desth; $y++) {
            for(my $x = 0; $x < $destw; $x++) {
                my $oldpixel = $pixels[$x]->[$y];
    
                # "Find closed palette/index value
                my $newpixel = 255.0;
                if($oldpixel < 128) {
                    $newpixel = 0.0;
                }
                $pixels[$x]->[$y] = $newpixel;
    
                my $quanterror = $oldpixel - $newpixel;
                for(my $ditherx = 0; $ditherx < 3; $ditherx++) {
                    for(my $dithery = 0; $dithery < 2; $dithery++) {
                        my $deltax = $x + $ditherx - 1;
                        my $deltay = $y + $dithery;
                        my $factor = $dither[$dithery]->[$ditherx];
                        next unless($factor);
                        next if($deltax < 0 || $deltax >= $destw);
                        next if($deltay < 0 || $deltay >= $desth);
                        my $change = $factor * $quanterror / 16.0;
    
                        #print "## $oldpixel $newpixel $factor $quante
+rror $change\n";
                        $pixels[$deltax]->[$deltay] += $change;
                    }
                }
            }
        }
    
        for(my $y = 0; $y < $desth; $y++) {
            for(my $x = 0; $x < $destw; $x++) {    
                if($pixels[$x]->[$y] < 128) {
                    #print "$x $y ", $pixels[$x]->[$y], "\n";
                    $self->{img}->setPixel($x, $y + $self->{imgoffs}, 
+$self->{imgblack});
                    $cachepic->setPixel($x, $y, $cacheblack);
                }
            }
        }
        
        $self->{imagecache}->{$cachekey} = $cachepic;
    } elsif($imagesoftness == 1) {

        # Dithering  https://en.wikipedia.org/wiki/Error_diffusion#min
+imized_average_error
        my @dither = (
            [0, 0, 0, 7, 5],
            [3, 5, 7, 5, 3],
            [1, 3, 5, 3, 1],
        );
        for(my $y = 0; $y < $desth; $y++) {
            for(my $x = 0; $x < $destw; $x++) {
                my $oldpixel = $pixels[$x]->[$y];
    
                # "Find closed palette/index value
                my $newpixel = 255.0;
                if($oldpixel < 128) {
                    $newpixel = 0.0;
                }
                $pixels[$x]->[$y] = $newpixel;
    
                my $quanterror = $oldpixel - $newpixel;
                for(my $ditherx = 0; $ditherx < 5; $ditherx++) {
                    for(my $dithery = 0; $dithery < 3; $dithery++) {
                        my $deltax = $x + $ditherx - 2;
                        my $deltay = $y + $dithery - 1;
                        my $factor = $dither[$dithery]->[$ditherx];
                        next unless($factor);
                        next if($deltax < 0 || $deltax >= $destw);
                        next if($deltay < 0 || $deltay >= $desth);
                        my $change = $factor * $quanterror / 48.0;
    
                        #print "## $oldpixel $newpixel $factor $quante
+rror $change\n";
                        $pixels[$deltax]->[$deltay] += $change;
                    }
                }
            }
        }
    
        for(my $y = 0; $y < $desth; $y++) {
            for(my $x = 0; $x < $destw; $x++) {    
                if($pixels[$x]->[$y] < 128) {
                    #print "$x $y ", $pixels[$x]->[$y], "\n";
                    $self->{img}->setPixel($x, $y + $self->{imgoffs}, 
+$self->{imgblack});
                    $cachepic->setPixel($x, $y, $cacheblack);
                }
            }
        }
        $self->{imagecache}->{$cachekey} = $cachepic;
    } elsif($imagesoftness == 3) {
    
        my @rawgreys = (
            '0000000000000000',
            '0000000001000000',
            '0000100000100000',
            '0010000001000001',
            '1000001000101000',
            '1010000000010110',
            '0001010001101010',
            '1010110010100100',
            '1010010101101010',
            '1001011001011011',
            '1001011110101101',
            '1101101001111110',
            '1011111001111011',
            '1011011111101111',
            '1111011111101111',
            '1111111110111111',
            '1111111111111111',
        );
        my $levels = scalar @rawgreys;
        my $bitlen = length($rawgreys[0]);
        
        my @greys;
        foreach my $rawgrey (@rawgreys) {
            my @parts = split//, $rawgrey;
            push @greys, \@parts;
        }
        
        for(my $y = 0; $y < $desth; $y++) {
            for(my $x = 0; $x < $destw; $x++) {    
                my $index = $pic->getPixel($x, $y);
                my ($r,$g,$b) = $pic->rgb($index);
                my $greypixel = int(($r+$g+$b)/3);
                my $level = int($greypixel / (255 / $levels));
                
                my $offs = int(rand($bitlen));
                my $bit = $greys[$level]->[($x + $offs) % $bitlen];
                
                if(!$bit) {
                    $self->{img}->setPixel($x, $y + $self->{imgoffs}, 
+$self->{imgblack});
                    $cachepic->setPixel($x, $y, $cacheblack);
                } else {
                }
            }
        }
        
        $self->{imagecache}->{$cachekey} = $cachepic;
    }
    
    $self->{imgoffs} += $desth;
    return;
}
[download]

Dithering by pixel manipulation is painfully slow (it can take multiple seconds per logo). But the software usually runs for days on end and has only a few different logos to deal with, so i did a simple in-memory caching. Once the system is up and running for a few minutes, no more slowdown.

perl -e 'use Crypt::Digest::SHA256 qw[sha256_hex]; print substr(sha256_hex("the Answer To Life, The Universe And Everything"), 6, 2), "\n";'

In reply to Re: graphicsmagick perl shrink image to size by cavac
in thread graphicsmagick perl shrink image to size by melutovich

Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!

Titles consisting of a single word are discouraged, and in most cases are disallowed outright.

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, details, 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, summary, 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:
	&		`&`
	<		`<`
	>		`>`
	[		`[`
	]		`]`

Link using PerlMonks shortcuts! What shortcuts can I use for linking?

See Writeup Formatting Tips and other pages linked from there for more info.