From 10bab7c95bcdaedbfdfeb1dea5599aa7edb63d90 Mon Sep 17 00:00:00 2001 From: Guilhem Moulin Date: Thu, 15 Aug 2013 04:10:37 +0200 Subject: "Shared" alpha channel accross intersecting borders. --- mkindex.pl | 127 +++++++++++++++++++++++++++++++++++++++++-------------------- 1 file changed, 85 insertions(+), 42 deletions(-) (limited to 'mkindex.pl') 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__ -- cgit v1.2.3