diff options
| -rwxr-xr-x | mkindex.pl | 125 |
1 files changed, 116 insertions, 9 deletions
@@ -25,12 +25,16 @@ use Getopt::Long qw/:config posix_default no_ignore_case gnu_compat bundling auto_version auto_help/; use Pod::Usage; use File::Temp; +use File::Basename; +use File::Spec; +use Inline 'C'; # http://geoinformatics.aalto.fi/doc/Geo-GDAL-1.9/html/ use Geo::GDAL; use Geo::OSR; -use Inline 'C'; +# http://www.imagemagick.org/script/perl-magick.php +use Image::Magick; my %config = ( progress => Geo::GDAL->can('TermProgress_nocb') ? sub { Geo::GDAL::TermProgress_nocb(@_[0,1]) } : @@ -39,12 +43,17 @@ my %config = ( progress => Geo::GDAL->can('TermProgress_nocb') ? , rename => 's/\.[^.]+$//' , zoom => '1024x1024' , resampling => &resamplings('near') + , border => 10 + , bordercolor=> 'red' + , fontsize => 25 + , font => 'Helvetica' ); GetOptions( "q|quiet" => sub { delete $config{progress} } , "d|debug" => \$config{debug} - , "rename=s" => sub { $config{rename} = $_[1] # TODO: sanitize + , "rename=s" => sub { pod2usage(2) unless $_[1] =~ /^s(.).+\1[ixgcadlu]*$/; + $config{rename} = $_[1] } , "s|size=s" => sub { if ($_[1] =~ /^(\d*\.?\d+)(%?)$/) { $config{zoom} = $2 ? 100. / $1 : $1; @@ -57,6 +66,23 @@ GetOptions( "q|quiet" => sub { delete $config{progress} } } } , "r|resampling=s"=> sub { $config{resampling} = &resamplings($_[1]) } + , "b|border=s"=> sub { if ($_[1] =~ /^(?<b>\d*)(?<bc>:.*)?$/) { + $config{border} = $+{b} if $+{b}; + $config{bordercolor} = $1 if $+{bc} =~ /^:(.+)/; + } + else { + pod2usage(2); + } + } + , "f|font=s" => sub { if ($_[1] =~ /^(?<fs>\d*)(?<fc>:.*)?(?<f>:[^:]*)?$/) { + $config{fontsize} = $+{fs} if $+{fs}; + $config{fontcolor} = $1 if $+{fc} =~ /^:(.+)/; + $config{font} = $1 if $+{f} =~ /^:(.+)/; + } + else { + pod2usage(2); + } + } , "s_srs=s" => sub { $config{s_srs} = Geo::OSR::SpatialReference::->new(); $config{s_srs}->SetFromUserInput( $_[1] ) } , "t_srs=s" => sub { $config{t_srs} = Geo::OSR::SpatialReference::->new(); @@ -175,8 +201,8 @@ if ($config{zoom} =~ /^(\d+)x(\d+)$/) { my $yRatio = (0.+$lry-$uly) / ($yRes*$ySize); $config{zoom} = $xRatio < $yRatio ? $yRatio : $xRatio; - map { $_->{xRes} = $_->{transform}->[1] * $config{zoom} - ; $_->{yRes} = $_->{transform}->[5] * $config{zoom} + map { $_->{transform2}->[1] = $_->{transform}->[1] * $config{zoom} + ; $_->{transform2}->[5] = $_->{transform}->[5] * $config{zoom} } @mapset; } &debug( "Using zoom: $config{zoom}" ); @@ -203,7 +229,8 @@ foreach my $map (@mapset) { &debug ("Opening '$map->{filename}'"); my $ds = Geo::GDAL::Open($map->{filename}, 'ReadOnly') or exit 1; &expand_rgba( \$ds, $map ); - &reproject( \$ds, $map ); + my $f = &reproject( \$ds, $map ); + &annotate( $f, $map ); } @@ -313,13 +340,13 @@ sub reproject { my ($ul,$lr) = @{$map->{corners}}[0,3]; # TODO: it might be xSize that's determined from ySize - my $dst_xSize = int( ($lr->[0]-$ul->[0]) / $map->{xRes} ); + my $dst_xSize = int( ($lr->[0]-$ul->[0]) / $map->{transform2}->[1] ); my $dst_ySize = int( $dst_xSize / $config{ratio} ); my ($src_xSize, $src_ySize) = $src_ds->Size(); &debug("Reducing map from ${src_xSize}x${src_ySize} to ${dst_xSize}x${dst_ySize}."); - my $dst_filename = $index; #&tempfile(SUFFIX => '.tif'); + my $dst_filename = &tempfile(SUFFIX => '.tif'); my $dst_ds = Geo::GDAL::GetDriverByName($driver)->Create( $dst_filename , $dst_xSize , $dst_ySize @@ -328,8 +355,6 @@ sub reproject { , $driver_opts ); $dst_ds->SetProjection( $config{t_wkt} ); - $map->{transform2}->[1] = $map->{xRes}; - $map->{transform2}->[5] = $map->{yRes}; $dst_ds->SetGeoTransform( $map->{transform2} ); my $res = Geo::GDAL::ReprojectImage( $src_ds, $dst_ds, @@ -347,6 +372,88 @@ sub reproject { } +# Annotate the map (add border & caption). +sub annotate { + my $src_filename = shift; + my $map = shift; + + my $img = Image::Magick::->new(); + + $img->Read($src_filename); + my ($xSize, $ySize) = $img->Get(qw/width height/); + + &debug( "Border: $config{border}:$config{bordercolor}" ); + &debug( "Font: $config{fontsize}:". ($config{fontcolor} // $config{bordercolor}). + ":$config{font}" ); + &debug( "Text: $map->{text}"); + # To get the list of fonts: + # &debug( "Supported fonts:", map {"\t".$_} $img->QueryFont() ); + + my @draw = ( fill => 'none' + , stroke => $config{bordercolor} + , strokewidth => $config{border} + ); + my @ann = ( fill => $config{fontcolor} // $config{bordercolor} + , strokewidth => 0 + , font => $config{font} + , pointsize => $config{fontsize} + , gravity => 'Center' + , text => $map->{text} + ); + my @points; + + if ($config{t_srs}->IsSame($config{s_srs} // $map->{srs})) { + push @draw, primitive => 'rectangle'; + push @points, [ 0, 0 ], [ $xSize-1, $ySize-1 ]; + } + else { + # The projection changed. Since the map might have been rotated, + # we draw a polygon instead of a rectangle. Also, instead of + # adding the border *then* reproject we use a mask in order to + # have nice anti-aliasing and better looking fonts. + + my ($ul1,$ll1,$ur1,$lr1) = @{$map->{corners}}; + my ($rx,$ry) = @{$map->{transform2}}[1,5]; + my ($ul2,$ll2,$ur2,$lr2) = &pix2proj( $map->{transform2}, + ( [ 0, 0] + , [ 0, $ySize-1 ] + , [ $xSize-1, 0 ] + , [ $xSize-1, $ySize-1 ] + )); + push @draw, primitive => 'polygon'; + push @points, [ int(($ul1->[0]-$ul2->[0]) / $rx) + , int(($ul1->[1]-$ul2->[1]) / $ry) ] + , [ int(($ll1->[0]-$ll2->[0]) / $rx) + , int(($ll1->[1]-$ll2->[1]) / $ry) + $ySize ] + , [ int(($lr1->[0]-$lr2->[0]) / $rx) + $xSize + , int(($lr1->[1]-$lr2->[1]) / $ry) + $ySize ] + , [ int(($ur1->[0]-$ur2->[0]) / $rx) + $xSize + , int(($ur1->[1]-$ur2->[1]) / $ry) ] + ; + } + $img->Draw( @draw, points => join (' ', map {join ',', @$_} @points) ); + $img->Annotate( @ann ); + + my $dst_filename = &tempfile(SUFFIX => '.tif'); + $img->Write($dst_filename); + + # The georeference didn't change when annotating. Hence we simply + # link the former world file. + my ($src_tfw, $dst_tfw) = map { my ($name,$path) = fileparse($_, qr/\.tiff?$/); + File::Spec->catfile($path, $name.'.tfw'); + } + ($src_filename, $dst_filename); + + if (-f $src_tfw and not -f $dst_tfw) { + link $src_tfw, $dst_tfw; + &debug( "Linking worldfiles: $src_tfw -> $dst_tfw" ); + } + + undef $img; + $map->{thumbnail} = $dst_filename; +} + + __END__ __C__ |