"Shared" alpha channel accross intersecting borders.

1 files changed, 85 insertions, 42 deletions

diff --git a/mkindex.pl b/mkindex.pl
index 912fd55..c2d2bee 100755
--- a/mkindex.pl
+++ b/mkindex.pl
@@ -132,10 +132,11 @@ Show the manpage.
 Create an index with all TIFF files in the current directory; don't save
 the index, but pipe it to display(1).
 
-=item mkindex.pl -b '15:RGBA(255,0,0,.25)' --s_srs=epsg:3067 *.tif index.tif
+=item mkindex.pl -b '25:RGBA(255,0,0,.5)' -f ':RGBA(0,0,255,.33)' --s_srs=epsg:3067 *.tif index.tif
 
-Assume all map to be projected in EPSG:3067. Draw a 15-pixels wide , 25%
-transparent red around each tile.
+Assume all map to be projected in EPSG:3067. Draw a 25-pixels wide, 50%
+transparent red border around each tile, and write the caption in 67%
+transparent blue.
 
 =item mkindex.pl -f '75::DejaVu-Sans-Book' --rename='s/U(.*)_RVK_25\.tif/$1/' *.tif index.tif
 
@@ -496,69 +497,111 @@ sub merge {
 sub annotate {
     my $filename = shift;
 
+    # Inverse the transformation, so that we can convert from projected
+    # coordinates to pixel coordinates.
     my $ds = Geo::GDAL::Open($filename, 'ReadOnly') or exit 1;
+    my ($width, $height) = $ds->Size();
     my ($ok,@invt) = Geo::GDAL::InvGeoTransform([ $ds->GetGeoTransform() ]);
     undef $ds;
     die "Error: Couldn't inverse affine transformation\n" unless $ok;
 
-    my $img = Image::Magick::->new();
-    $img->Read( $filename );
-    my ($width, $height) = $img->Get(qw/width height/);
-
     my @draw = ( fill => 'none'
-               # list of supported colors: `convert -list color`
-               , stroke => $config{bordercolor}
                , strokewidth => $config{border}
                , primitive => 'polygon'
                );
-    my @ann = ( fill => $config{fontcolor} // $config{bordercolor}
-              , strokewidth => 0
-              # list of supported fonts: `convert -list font`
+    my @ann = ( stroke => 'none'
+              # To get the list of supported fonts: `convert -list font`.
               , font => $config{font}
               , pointsize => $config{fontsize}
               );
+
+    # Separate RGB and alpha channels. This complicated business is
+    # because we want all borders to share the same alpha channel
+    # instead of having more opaque intersections of semi-transparent
+    # areas (due to the default composition, which multiplies the
+    # values.
+    #
+    # To get the list of supported colors: `convert -list color`.
+    my ($b_rgb, $b_alpha) = &getRGB_Gray( $config{bordercolor} );
+    my ($f_rgb, $f_alpha) = &getRGB_Gray( $config{fontcolor} // $config{bordercolor} );
+    my $rgb= Image::Magick::->new( size => "${width}x${height}" );
+    $rgb->Read( 'xc:none' );
+
+    my $mask = Image::Magick::->new( size => "${width}x${height}" );
+    $mask->Read( 'xc:black' );
+    # We really want 'Gray', but a non-linear Gray. See
+    # http://www.imagemagick.org/script/color-management.php
+    # for the trick:
+    #   convert myimage.png -set colorspace RGB -colorspace gray myRGBimage.png
+    # (Also, setting the 'colorspace' during the object creation was
+    # useless.)
+    $mask->Set( colorspace => 'RGB' );
+
     foreach my $map (@mapset) {
         # In case the projection have changed, the map may have been rotated,
-        # so we draw a polygon instead of a rectangle. Also, we're using
-        # a mask to avoid the text to be out of bounds.
+        # so we draw a polygon instead of a rectangle.
 
         my @points = map {[ Geo::GDAL::ApplyGeoTransform(\@invt, @$_[0,1] ) ]}
-                          @{$map->{t_corners}}[0,1,3,2];
+                         @{$map->{t_corners}}[0,1,3,2];
         my $points = join (' ', map {join ',', @$_} @points);
         &debug( "Polygon: " . $points );
-        # TODO: when drawing a semi-transparent border, all borders
-        # should be in the same group so the corners are not "darker"
-        # than the rest.
-        $img->Draw( @draw, points => $points );
-
-        # Find the middle of the polygon; We add a Y-offset to be
-        # vertically centered.
-        my ($x,$y) = (0,0);
-        map { $x+= $_->[0] / (1.+$#points); $y+= $_->[1] / (1.+$#points); }
-            @points;
-        push @ann, x => $x, y => $y + $config{fontsize}/2., align=> 'Center';
-
-        my $text = Image::Magick::->new( size => "${width}x${height}" );
-        $text->ReadImage('xc:none');
-
-        my $mask = Image::Magick::->new( size => "${width}x${height}" );
-        $mask->ReadImage('xc:black');
-        $mask->Draw( primitive => 'polygon'
-                    , strokewidth => 0
-                    , fill => 'white'
-                    , points => $points );
-        $text->Mask( mask => $mask );
-        undef $mask;
-
-        $text->Annotate( @ann, text => $map->{text} );
-        $img->Composite( image => $text, compose => 'Over' );
-        undef $text;
+
+        # Get the extremes of this polygon.
+        my ($lx,$uy,$rx,$ly);
+        foreach (@points) {
+            $lx = int $_->[0] unless defined $lx and $lx < int $_->[0];
+            $uy = int $_->[1] unless defined $uy and $uy < int $_->[1];
+            $rx = int $_->[0] unless defined $rx and $rx > int $_->[0];
+            $ly = int $_->[1] unless defined $ly and $ly > int $_->[1];
+        };
+        # The region where to confine the caption.
+        my $cell = ($rx-$lx).'x'.($ly-$uy).'+'.$lx.'+'.$uy;
+        &debug( "Cell: $cell" );
+
+        # Add the caption. ('gravity' is relative to the 'geometry'.)
+        # Everithing that's not in the cell's region is trimmed away.
+        my @ann = ( @ann, geometry => $cell, gravity => 'Center'
+                  , text => $map->{text} );
+        $rgb->MogrifyRegion(  $cell, 'Annotate', @ann, fill => $f_rgb );
+        $mask->MogrifyRegion( $cell, 'Annotate', @ann, fill => $f_alpha );
+
+        # Add the borders. We do that after the text to draw over in
+        # case of intersection.
+        $rgb->Draw( @draw, stroke => $b_rgb,   points => $points );
+        $mask->Draw(@draw, stroke => $b_alpha, points => $points );
     }
+
+    # Change the colorspace (now to non-linear gray), and turn off
+    # the alpha channel. Then copy this (shared) channel back into the
+    # RGB annotation channel.
+    $mask->Set( colorspace => 'Gray', alpha => 'Off' );
+    $rgb->Composite( image => $mask, compose => 'CopyOpacity' );
+    undef $mask;
+
+    # Merge all the annotations into the mosaic.
+    my $img = Image::Magick::->new();
+    $img->Read( $filename );
+    $img->Composite( image => $rgb, compose => 'Over' );
+    undef $rgb;
+
     binmode STDOUT if $index =~ /^(?:[[:alnum:]]*:)?-$/; # Useful for pipes
     $img->Write($index);
     undef $img;
 }
 
+# Get the RGB and Gray values of the given color.
+sub getRGB_Gray {
+    my $color = shift;
+
+    my $pix = Image::Magick::->new();
+    my ($r, $g, $b, $a) = $pix->QueryColor($color);
+    my $max = (2 << ($pix->Get('depth') - 1)) - 1.;
+    undef $pix;
+
+    ($r,$g,$b,$a) = map { ($_ * 100. / $max).'%' } ($r,$g,$b,$a);
+    return ("RGB($r,$g,$b)", "GRAY($a)");
+}
+
 
 __END__