Beefy Boxes and Bandwidth Generously Provided by pair Networks
XP is just a number
 
PerlMonks  

GD colorAllocate not changing colour

by Bod (Curate)
on May 15, 2021 at 21:18 UTC ( #11132636=perlquestion: print w/replies, xml ) Need Help??

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

Whilst refactoring some code, I'm trying to solve a long time minor bug.

The code takes an image which is $file{'image', 'file'}. It creates a blank background image of 600x450 pixels then places the original image on top. If the aspect ratio of the original image is too tall it gets cropped, if it is too wide then the width is maintained so the background forms a band top and bottom. The background is set to white but it nearly always comes out as black and occasionally dark green.

my $white; # Create background my $image = new GD::Image(600, 450); $white = $image->colorAllocate(255, 255, 255); # Resize uploaded image to 600 wide my $picture = GD::Image->new($file{'image', 'file'}); my ($srcw, $srch) = $picture->getBounds(); my $newh = ($srch * 600 / $srcw) - 1; my $resize = GD::Image->new(599, $newh - 1); $resize->copyResized($picture, 0, 0, 0, 0, 600, $newh, $srcw, $srch); # Copy onto background image offset to crop or center $image->copy($resize, 0, 0, 0, ($newh - 450) / 2, 600, 450); $white = $image->colorAllocate(255, 255, 255); open my $fh, '>' ,"$root/images/property/unit/$filename.png"; binmode $fh; print $fh $image->png; close $fh;

A second call to colorAllocate() has been added to check that copy() wasn't resetting the colour pallette. This makes no difference. When $white is checked it is always a positive number. 16777215 for colorAllocate(255, 255, 255) and different positive numbers for different colours.

Any ideas what else I can check?
The documentation for GD->colorAllocate is not very helpful.

Or, perhaps there is a better way to solve the problem...
To create images that are always 600px x 450px regardless of the original but without distorting them.

Replies are listed 'Best First'.
Re: GD colorAllocate not changing colour
by afoken (Canon) on May 15, 2021 at 23:18 UTC
    my $white; # Create background my $image = new GD::Image(600, 450); $white = $image->colorAllocate(255, 255, 255); # Resize uploaded image to 600 wide my $picture = GD::Image->new($file{'image', 'file'}); my ($srcw, $srch) = $picture->getBounds(); my $newh = ($srch * 600 / $srcw) - 1; my $resize = GD::Image->new(599, $newh - 1); $resize->copyResized($picture, 0, 0, 0, 0, 600, $newh, $srcw, $srch); # Copy onto background image offset to crop or center $image->copy($resize, 0, 0, 0, ($newh - 450) / 2, 600, 450); $white = $image->colorAllocate(255, 255, 255); open my $fh, '>' ,"$root/images/property/unit/$filename.png"; binmode $fh; print $fh $image->png; close $fh;

    The background is set to white but it nearly always comes out as black and occasionally dark green.

    So, you bought a can of white color and a brush, but for some strange reason, the walls of the room you are standing in still show a nasty 1960s style flower decor. What has gone wrong?

    Hint: $white, as shown in your code, is a write-only variable. You assign to it, twice, but you do not use it.


    When $white is checked it is always a positive number. 16777215 for colorAllocate(255, 255, 255) and different positive numbers for different colours.

    Sure. 16777215 is 0x00FFFFFF, RGB for white. Other colors use other bit patterns. colorAllocate() is mainly needed for paletted image formats (like GIF), that can only display a limited selection ("palette") of colors. For those formats, colorAllocate() allocates one of the few possible palette entries (trueColor in GD speak is off). Other image formats allow using three (or four) color channels, each with a color depth of typically 8 bit (more or less bits are possible), and for those formats, colorAllocate() just translates RGB to a bit pattern (trueColor in GD speek is on).

    Alexander

    --
    Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)

      You could have given him a slightly wider hint

      $image->filledRectangle(0,0,$width,$height ,$white);
      So, you bought a can of white color and a brush, but for some strange reason, the walls of the room you are standing in still show a nasty 1960s style flower decor. What has gone wrong?

      OK - so the handyman has been summoned and instructed to use the brush to put the paint on the wall:

      my $white; # Create background my $image = new GD::Image(600, 450); $white = $image->colorAllocate(255, 255, 255); $image->filledRectangle(0, 0, 600, 450, $white);
      The wall looks much better in white than it did in the 1960's flower decor. However, much to the handyman's frustration, I've decided that for testing purposes I don't want white or black and will have grey instead. Grey makes it easy to know the black has gone without the white blending into the background:
      $white = $image->colorAllocate(127, 127, 127); $image->filledRectangle(0, 0, 600, 450, $white);
      Calling the grey $white ensures that the handyman knows he has to return the grey wall back to white someday!

      Now that there is a nice grey wall we can look at it and check it is indeed grey:

      open my $fh, '>' ,"$root/images/property/unit/$filename.png"; binmode $fh; print $fh $image->png; close $fh;
      And yes, it is grey as expected :)

      Next we get the handyman to take the picture that was hanging on the wall and resize it to it is 600px wide. Being good with a tape measure and a saw, our handyman is able to resize the picture without altering it's aspect ratio:

      # Resize uploaded image to 600 wide my $picture = GD::Image->new($file{'image', 'file'}); my ($srcw, $srch) = $picture->getBounds(); $newh = int ($srch * 600 / $srcw); my $resize = GD::Image->new(600, $newh); $resize->copyResized($picture, 0, 0, 0, 0, 600, $newh, $srcw, $srch);
      Despite having lots of faith in our handyman it's still a good idea to check his work occasionally...
      open my $fh, '>' ,"$root/images/property/unit/$filename.png"; binmode $fh; print $fh $resize->png; close $fh;
      And sure enough his tape measure and sawing skills live up to expectations and he has created a perfect resized picture all ready for the newly painted grey wall.

      Now for the final part of the redecoration. All that is left is to hang the picture of the wall and we are done.

      # Copy onto background image offset to crop or center $image->copy($resize, 0, 0, 0, ($newh - 450) / 2, 600, 450);
      All done but let's have a quick check again before the hammer is put away...
      open my $fh, '>' ,"$root/images/property/unit/$filename.png"; binmode $fh; print $fh $image->png; close $fh;
      Oh no!
      What's happened...it must be alchemy...

      As if by magic, the nice grey wall has turned into a black wall. Far better than the 1960's flower pattern but still not the lovely shade of grey that we tried so hard to use to paint the wall.

        As if by magic, the nice grey wall has turned into a black wall.

        What image formats do you use? I see you are writing a PNG, that can be both a paletted image and a non-paletted image. What formats do you read?

        (On palettes: A paletted image has a small array of colors, usually 24 bit RGB colors, and usually not more than 256 color entries. Each pixel is stored as an array index, typically one byte. A non-paletted image stores the color information directly in the pixel data, using 3 or 4 bytes per pixel.)

        "Magic" color changes usually happen with paletted images, especially if the tool is too simple-minded, or when you run out of palette entries. What happens is that the palette is silently modified or the color allocation fails because the palette array is full. Try to use non-paletted images, i.e. make sure GD is in "true color" mode. Call isTrueColor() on your GD objects, should return true. Pass a true value for the optional truecolor parameter to the GD constructors. That way, paletted images are automatically upgraded to non-paletted mode (as far as I understand GD.)

        Alexander

        --
        Today I will gladly share my knowledge and experience, for there are no sweeter words than "I told you so". ;-)
        Hello Bod,

        letting apart the humor (which incidentally make your post harder to understand for non native english speakers.. :), you never set $resize background to white! I didnt follow all your geometry calculus, but be aware the the default background for a GD image is black:

        perl -MGD -e"$im = new GD::Image(100,100);open $fh,'>','out.jpg';binmo +de $f; print $fh $im->jpeg"

        The above print a nice black image.

        Simplfying the whole I think you can start from something like the following code, which does what you are looking for

        use strict; use warnings; use GD; GD::Image->trueColor(1); # gray image 100x100 my $im_gray = new GD::Image(100,100); my $gray = $im_gray->colorAllocate(127,127,127); $im_gray->filledRectangle(0, 0, 100,100, $gray); open my $fh_gray,'>','gray.jpg'; binmode $fh_gray; print $fh_gray $im_gray->jpeg; # red image 100x100 my $im_red = new GD::Image(100,100); my $red = $im_red->colorAllocate(255,0,0); my $black = $im_red->colorAllocate(0,0,0); $im_red->filledRectangle(0, 0, 100,100, $red); # with a black circle $im_red->ellipse(50,50,100,100,$black); open my $fh_red,'>','red.jpg'; binmode $fh_red; print $fh_red $im_red->jpeg; # copy resized red image scaled 50% and centered inside the gray one $im_gray->copyResized($im_red,25,25,0,0,50,50,100,100); open my $fh_both,'>','both.jpg'; binmode $fh_both; print $fh_both $im_gray->jpeg;

        L*

        There are no rules, there are no thumbs..
        Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.

        The problem may be here

        $image->copy($resize, 0, 0, 0, ($newh - 450) / 2, 600, 450);

        gd does nice cropping to viewports but this one may be too much if $newh<450

        if ($newh<450) { $image->copy($resize, 0, (450-$newh ) / 2, 0,0, 600, $newh); } else { $image->copy($resize, 0, 0, 0, ($newh - 450) / 2, 600, 450); ]

        Trying to copy from outside the bounds of the src image may have introduced the black, just a guess

Log In?
Username:
Password:

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

How do I use this? | Other CB clients
Other Users?
Others wandering the Monastery: (2)
As of 2021-10-20 16:11 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?
    My first memorable Perl project was:







    Results (81 votes). Check out past polls.

    Notices?