summaryrefslogtreecommitdiffstats
path: root/mkindex.pl
diff options
context:
space:
mode:
Diffstat (limited to 'mkindex.pl')
-rwxr-xr-xmkindex.pl127
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__