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

I again seek your wisdom fellow Monks...

As part of the website for my partner's artwork, I am producing two copies of each image that she will upload. One is a small thumbnail with quite high JPEG compression so that it is deliberately pixelated if it is enlarged. The other image is high resolution and large, but with a watermark copyright notice on it. I am using GD for the image processing and Image::Resize to make the sizing easier.

GD is being used because I know my way around it better than the alternatives like Image::Magick and I know GD better because it is available to me by default.

All the resizing works fine and I am able to add a watermark in two parts to get two different font sizes. However, regardless of what I add in the first parameter of ->stringFT() the text is always black. This is fine for some images...

this watermark looks fine

But the black watermark doesn't work very well on artwork where a significant amount of the background is black or close to black.

this watermark doesn't look right

My first thought was to try to have semi-transparent text for the watermark. However, searching suggests that this isn't possible although I haven't found anything which categorically rules it out. So instead I thought of trying to read the general "darkness" of areas of the background where the watermark is going to be and programmatically choose a colour that will contrast against this. Detecting the "darkness" seems far from trivial...

Here is the code...

sub XHRupload { no strict 'subs'; my $full; my $image = Image::Resize->new(GD::Image->new($file{'joolzimage', +'file'})); if ($image->width() > 1800) { $full = $image->resize(1800, 99999); } else { $full = $image->gd(); } my $year = (localtime)[5] + 1900; my $watermark = 'Artwork by Joolz'; my $copyright = "copyright $year"; # Centre text components and centre on image my @bounds = new GD::Image->stringFT('silver', "$ENV{'DOCUM +ENT_ROOT'}/cgi-bin/Image/watermark.ttf", 140, 0.18, 0, 0, $watermark) +; my $left = ($full->width() / 2) - (($bounds[2] - $bounds +[0]) / 2) + 5; my $top = ($full->height() / 2); $full->stringFT('white', "$ENV{'DOCUMENT_ROOT'}/cgi-bin/Image/wate +rmark.ttf", 140, 0.18, $left, $top, $watermark); @bounds = new GD::Image->stringFT('silver', "$ENV{'DOCUMENT +_ROOT'}/cgi-bin/Image/watermark.ttf", 80, 0.18, 0, 0, $copyright); $left = ($full->width() / 2) - (($bounds[2] - $bounds[0] +) / 2) + 5; $top = ($full->height() / 2) + 120; $full->stringFT('blue', "$ENV{'DOCUMENT_ROOT'}/cgi-bin/Image/water +mark.ttf", 80, 0.18, $left, $top, $copyright); open my $fh, '>', "$ENV{'DOCUMENT_ROOT'}/artwork/full/$data{'id'}. +jpg"; print $fh $full->jpeg(100); close $fh; my $thumb = $image->resize(300, 1000); open $fh, '>', "$ENV{'DOCUMENT_ROOT'}/artwork/thumbs/$data{'id'}.j +pg"; print $fh $thumb->jpeg(32); close $fh; print "Content-type: text/plain\n\n"; print $data{'id'}; exit 0; }
Can you suggest either a better way to accomplish what I am trying to do or a relatively simple way to detect how dark the background is, select a colour for the text that will show up on that background and then actually create text in that colour?

As always, any other advice on improving my code would be welcome.

Replies are listed 'Best First'.
Re: Adding a watermark to an image with GD::Image
by Fletch (Chancellor) on Jan 06, 2021 at 22:24 UTC

    Prossibly use Imager; it has methods like getcolorcount or getcolorusage where you could maybe look and see how used your watermark color is.

    Edit: rough sample finding a single color. You'd need to walk the color histogram hash and maybe look and find how many pixels are using below whatever threshold of "too dark" pixel.

    my $img = Imager->new->open( file => q{myfile.jpg} ); my $colors = $img->getcolorusagehash(); my $color_black = pack( q{CCC}, 0, 0, 0 ); say qq{True black used }, $colors->{$color_black}, qq{ times.}

    Edit again: More thinking about it what I'd do (vague handwaving, but I offer a link!) is use the histogram hash and sort the keys (they're packed RGB values so when you sort them asciibetically it should do the right thing). You can compute a luminance value you consider "too dark" and then figure out what percentage of the image pixels are less than that value; if it's over whatever threshold, swap to your backup light color. Theoretically you could even copy out the subsection of your image where you're contemplating putting the watermark and just get the color usage for that subsection.

    Another thought: Actually looking at your second sample image another option rather than changing the watermark color might be if it's too dark then just write it first 2 pixels larger in a lighter color and then write the dark version on top (so it'd be outlined).

    The cake is a lie.
    The cake is a lie.
    The cake is a lie.

      Another thought: Actually looking at your second sample image another option rather than changing the watermark color might be if it's too dark then just write it first 2 pixels larger in a lighter color and then write the dark version on top (so it'd be outlined).

      WoW! That's some selection of possible solutions from you Fletch. Thank you, it is certainly giving me some ideas to try out.

      The idea of an outline by printing the text twice in different colours certainly has plenty of merit. Potentially it would eliminate the need to sample the background at all. If there's a dark outer part to the text and a lighter inner then one or other should contrast with the background sufficiently.

      I may have to find two suitable TTF sources or find one and make a copy with slightly narrower font strokes so one sits inside the other. That shouldn't be a big problem.

      Prossibly use Image

      Nice thought and it looks like a very useful module...

      But it's not an option as installation requires access to the compiler which I don't have on the shared hosting. So I have to use what's there or pure Perl modules.

Re: Adding a watermark to an image with GD::Image
by kcott (Bishop) on Jan 07, 2021 at 01:45 UTC

    G'day Bod,

    In the documentation for stringFT() you'll see:

    ...stringFT($fgcolor, ...)

    and a little after that:

    fgcolor Color index to draw the string in

    In "GD: Color Control", you'll see how the create such an index.

    I tried using a string with a colour name in multiple methods requiring a colour index (stringFT(), rectangle(), fill(), and others) and all gave the warning:

    Argument "<colour name>" isn't numeric in subroutine entry at ...

    If I don't use the warnings pragma, I don't see those warnings. Are you using warnings? If so, have you checked in your web server's error log?

    [Complete guess: an invalid colour index defaults to black.]

    So, instead of the string 'silver', you want the return value of colorAllocate(192,192,192). If you're unfamiliar with that RGB format, take a look at "RGB Colour Code". You'll want to make similar changes for other named colours.

    A few of other points regarding your code:

    • You have used Indirect Object Syntax in the code you posted. Please follow that link, read the emboldened discouragement at the start of that section; then read on for the reasons to avoid it.
    • There are variables used that are (presumably) defined elsewhere (I noted %file and %data). This means that other code might also be using, and possibly modifying, them: there may be side-effects. Aim to pass needed data to subroutines as arguments and keep a tight rein on what's used and where.
    • As far as I can tell, $file{'joolzimage', 'file'} is a "Multi-dimensional array emulation". This is ancient code, used in Perl4, before references became available in Perl5. Aim to use "real" multidimensional arrays; e.g. $file{joolzimage}{file}.

    — Ken

      Thanks kcott. This is all very helpful.

      I shall have a good look at the colour points later today. No, I am not using warnings. I'm a relatively new convert to use strict; as you will see from Backdating strict posted just 2 months ago. As always, that was good advice from the Monastery!

      • There are variables used that are (presumably) defined elsewhere (I noted %file and %data). This means that other code might also be using, and possibly modifying, them: there may be side-effects. Aim to pass needed data to subroutines as arguments and keep a tight rein on what's used and where.
      • As far as I can tell, $file{'joolzimage', 'file'} is a "Multi-dimensional array emulation". This is ancient code, used in Perl4, before references became available in Perl5. Aim to use "real" multidimensional arrays; e.g. $file{joolzimage}{file}.

      Back in the 1990's I sort of learnt Perl by looking at other people's code which was in a CGI environment. I get the feeling the code I was looking at wasn't very well written to start with and I was trying to get things to work using that as a guide and no formal background in programming or computer science. I look back occasionally at code from those days and wonder how I ever got it working and amazement that some of it is still working today!

      The code that generates %data and %file sits in a require file on all my websites except this latest one. Here I have taken the advice of the Monastery and not only used Template, but also extracted the require *.pl; into a use *; module instead.

      package Site::Common; use strict; use DBI; use DBD::mysql; use Exporter; use Template; use Site::Variables; our @ISA = qw(Exporter); our @EXPORT = qw(%data %file $template); my %cookie = ($ENV{'HTTP_COOKIE'}.';') =~ /(\S+)=(\S+);/g; # Some subs removed... our (%data, %file); if ($ENV{'GATEWAY_INTERFACE'}) { my $query_string; $query_string = $ENV{'QUERY_STRING'} if $ENV{'QUERY_STRING'}; if ($ENV{'REQUEST_METHOD'} eq 'POST') { if ($ENV{'CONTENT_TYPE'} =~ /^multipart\/form-data/i) { my ($key, $name); my $boundary = <STDIN>; chomp $boundary; binmode STDIN; local $/; my @parts = split /$boundary?/, <STDIN>; foreach my $p(@parts) { if ( $p =~ /^\s*Content-Disposition: +form-data; +name +=\"(\w+)?\"(; +filename=\"(.+)?\")?\r\n/i ) { $key = $1; $name = $3; if ( $p =~ /Content-Type: +(\w+\/\w+)?\r\n/i ) { $file{$key, 'type'} = $1; $file{$key, 'name'} = $name; (undef, $file{$key, 'file'}) = split /\r\n\r\n +/, $p, 2; $data{$key} = 'FILE'; } else { (undef, $data{$key}) = split /\r\n\r\n/, $p, 2 +; $data{$key} =~ s/(\r|\n)+$//g; } } } } else { $query_string .= '&' if $query_string; $query_string .= <STDIN>; } } if ($query_string) { my @pairs = split /&/, $query_string; foreach my $p(@pairs) { $p =~ tr/+/ /; $p =~ s/%([a-fA-F0-9][a-fA-F0-9])/pack("C", hex($1))/eg; my ($key, $val) = split /=/, $p, 2; $data{$key} = $val; } } chomp %data; } 1;

      This is code I wrote a long time ago to deal with form uploads from websites. It followed much frustration with CGI. Essentially it puts all the upload parameters as key/value pairs into %data and any file uploads into %file with the first dimension of the hash being the web form's input name and the second being either 'file' for the actual binary file content or 'name' for the filename.

      So, no - this doesn't get changed by other code.

      With the knowledge I have gained in the past couple of months from the Monastery, I plan to refactor this code but in a way that it still exports those two variables so it doesn't break all the existing web scripts. At the same time I will add better methods to access the same data. Being extracted to a module should pave the way for it to be refactored.

      There is a lot of what can only be called legacy code on my webserver...refactoring it without breaking anything is going to be a challenge!

      Edit - corrected typo...thanks AnomalousMonk for pointing it out

Re: Adding a watermark to an image with GD::Image
by bliako (Prior) on Jan 07, 2021 at 06:56 UTC

    Another approach is to create your watermark on a transparent image of the same size (for simplicity) as the original. Ending with 2 images. Then you overlay those images using an appropriate blending mode which GD maybe has it built-in or create your own (warning: this example uses PHP's GD API which I am not sure is the same as that provided for Perl). To experiment with blending modes use gimp or photoshop if you own one and check layer modes

    Another way similar to Fletch's is to sample a neighbourhood of original image's pixels around each of the watermark's non-transparent pixels. And pick the watermark pixel color (so no borders) to stand out using the color-wheel, there's a lot of theory about that and some simple equations to get "opposite" colors.

    bw, bliako

Re: Adding a watermark to an image with GD::Image
by Bod (Hermit) on Jan 08, 2021 at 00:03 UTC

    Thank you Monks for your suggestions...
    I now have the code working which I share in case anyone else needs to do something similar.

    ###################### # Upload artwork image sub XHRupload { no strict 'subs'; my $full; my $image = Image::Resize->new(GD::Image->new($file{'joolzimage', +'file'})); if ($image->width() > 1800) { $full = $image->resize(1800, 99999); } else { $full = $image->gd(); } my $year = (localtime)[5] + 1900; my $watermark = 'Artwork by Joolz'; my $copyright = "copyright $year"; # Centre text components on image my $colour = $full->colorAllocate(0, 0, 0); my @bounds = new GD::Image->stringFT($colour, "$ENV{'DOCUMENT_R +OOT'}/cgi-bin/Image/outline.ttf", 90, 0.18, 0, 0, $watermark); my $left = ($full->width() / 2) - (($bounds[2] - $bounds[0]) + / 2) + 5; my $top = ($full->height() / 2) - ($bounds[7] - $bounds[1]) + / 2; # Select colour my ($rd, $gn, $bl) = (0, 0, 0); for (my $x = $left; $x < $left + ($bounds[2] - $bounds[0]); $x += +20) { for (my $y = $top - 450; $y < $top + 130; $y += 20) { my ($r, $g, $b) = $full->getPixel($x, $y); $bl = 255 - $r if 255 - $r > $rd; $rd = 255 - $g if 255 - $g > $gn; $gn = 255 - $b if 255 - $b > $bl; } } $rd = 120 if $rd > 120; $gn = 120 if $gn > 120; $bl = 120 if $bl > 120; $colour = $full->colorAllocate($rd, $gn, $bl); $full->stringFT($colour, "$ENV{'DOCUMENT_ROOT'}/cgi-bin/Image/outl +ine.ttf", 90, 0.18, $left, $top, $watermark); @bounds = new GD::Image->stringFT($colour, "$ENV{'DOCUMENT_ +ROOT'}/cgi-bin/Image/watermark.ttf", 95, 0.18, 0, 0, $copyright); $left = ($full->width() / 2) - (($bounds[2] - $bounds[0]) / +2) + 5; $full->stringFT($colour, "$ENV{'DOCUMENT_ROOT'}/cgi-bin/Image/wate +rmark.ttf", 95, 0.18, $left, $top + 160, $copyright); open my $fh, '>', "$ENV{'DOCUMENT_ROOT'}/artwork/full/$data{'id'}. +jpg"; print $fh $full->jpeg(100); close $fh; my $thumb = $image->resize(300, 1000); open $fh, '>', "$ENV{'DOCUMENT_ROOT'}/artwork/thumbs/$data{'id'}.j +pg"; print $fh $thumb->jpeg(32); close $fh; print "Content-type: text/plain\n\n"; print $data{'id'}; exit 0; }

    I still have to change from Indirect Object Syntax as pointed out by kcott and there are some other parts that need tidying. Plus, the watermark code is not as clever as it could be. The text colour starts as black - RGB 0, 0, 0. The code samples the portion of the image where the text will be going and increases the RGB values as higher value pixels are found but the colours are staggered so greater RED increases the BLUE value. Finally these are capped at 120 so that the text cannot get too light as there will always be a white picture mount.

    Result one
    Result one

    To check the code was sampling in the correct place, I used setPixel($x, $y, $colour); so that I could see a grid of small black dots covering the area to be sampled. Once happy it was in the right place, I changed it to getPixel($x, $y)