257 lines
9.6 KiB
Plaintext
257 lines
9.6 KiB
Plaintext
|
#------------------------------------------------------------------------------
|
||
|
|
# File: gps2utm.config
|
||
|
|
#
|
||
|
|
# Description: Generate UTM tags from GPS information
|
||
|
|
#
|
||
|
|
# Requires: ExifTool version 7.00 or later
|
||
|
|
#
|
||
|
|
# Notes: Uses GPSMapDatum, GPSLatitude and GPSLongitude to generate
|
||
|
|
# UTMCoordinates, UTMZone, UTMEasting and UTMNorthing. If
|
||
|
|
# GPSMapDatum is not available then "WGS84" is assumed.
|
||
|
|
#
|
||
|
|
# Example: > exiftool -config gps2utm.config "-utm*" t/images/GPS.jpg
|
||
|
|
# UTM Coordinates : 30U 569475.596m E 6094180.754m N
|
||
|
|
# UTM Easting : 569475.595558165
|
||
|
|
# UTM Northing : 6094180.75443061
|
||
|
|
# UTM Zone : 30U
|
||
|
|
#
|
||
|
|
# Caveats: When used to convert EXIF GPS coordinates, the reference
|
||
|
|
# direction tags (GPSLatitudeRef/GPSLongitudeRef) must exist or
|
||
|
|
# the calculated UTM coordinates may be in the wrong hemisphere
|
||
|
|
#
|
||
|
|
# Revisions: 2016/03/08 - Bryan K. Williams (aka StarGeek) Created
|
||
|
|
# 2016/03/09 - PH removed library dependency and re-organized
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
|
||
|
|
my $deg2rad = 3.14159265358979 / 180;
|
||
|
|
|
||
|
|
sub tan($)
|
||
|
|
{
|
||
|
|
return sin($_[0]) / cos($_[0]);
|
||
|
|
}
|
||
|
|
|
||
|
|
#===============================================================================
|
||
|
|
# the following code is by Graham Crookham:
|
||
|
|
# http://search.cpan.org/~grahamc/Geo-Coordinates-UTM/ (version 0.11)
|
||
|
|
|
||
|
|
# remove all markup from an ellipsoid name, to increase the chance
|
||
|
|
# that a match is found.
|
||
|
|
sub _cleanup_name($)
|
||
|
|
{ my $copy = lc(shift);
|
||
|
|
for($copy)
|
||
|
|
{ s/\([^)]+\)//g; # remove text between parentheses
|
||
|
|
s/[\s-]//g; # no blanks or dashes
|
||
|
|
}
|
||
|
|
$copy;
|
||
|
|
}
|
||
|
|
|
||
|
|
# Ellipsoid array (name,equatorial radius,square of eccentricity)
|
||
|
|
# Same data also as hash with key eq name (in variations)
|
||
|
|
|
||
|
|
my (@Ellipsoid, %Ellipsoid);
|
||
|
|
|
||
|
|
BEGIN { # Initialize this before other modules get a chance
|
||
|
|
@Ellipsoid =
|
||
|
|
( [ "Airy", 6377563, 0.00667054]
|
||
|
|
, [ "Australian National", 6378160, 0.006694542]
|
||
|
|
, [ "Bessel 1841", 6377397, 0.006674372]
|
||
|
|
, [ "Bessel 1841 Nambia", 6377484, 0.006674372]
|
||
|
|
, [ "Clarke 1866", 6378206, 0.006768658]
|
||
|
|
, [ "Clarke 1880", 6378249, 0.006803511]
|
||
|
|
, [ "Everest 1830 India", 6377276, 0.006637847]
|
||
|
|
, [ "Fischer 1960 Mercury", 6378166, 0.006693422]
|
||
|
|
, [ "Fischer 1968", 6378150, 0.006693422]
|
||
|
|
, [ "GRS 1967", 6378160, 0.006694605]
|
||
|
|
, [ "GRS 1980", 6378137, 0.00669438]
|
||
|
|
, [ "Helmert 1906", 6378200, 0.006693422]
|
||
|
|
, [ "Hough", 6378270, 0.00672267]
|
||
|
|
, [ "International", 6378388, 0.00672267]
|
||
|
|
, [ "Krassovsky", 6378245, 0.006693422]
|
||
|
|
, [ "Modified Airy", 6377340, 0.00667054]
|
||
|
|
, [ "Modified Everest", 6377304, 0.006637847]
|
||
|
|
, [ "Modified Fischer 1960", 6378155, 0.006693422]
|
||
|
|
, [ "South American 1969", 6378160, 0.006694542]
|
||
|
|
, [ "WGS 60", 6378165, 0.006693422]
|
||
|
|
, [ "WGS 66", 6378145, 0.006694542]
|
||
|
|
, [ "WGS-72", 6378135, 0.006694318]
|
||
|
|
, [ "WGS-84", 6378137, 0.00669438 ]
|
||
|
|
, [ "Everest 1830 Malaysia", 6377299, 0.006637847]
|
||
|
|
, [ "Everest 1956 India", 6377301, 0.006637847]
|
||
|
|
, [ "Everest 1964 Malaysia and Singapore", 6377304, 0.006637847]
|
||
|
|
, [ "Everest 1969 Malaysia", 6377296, 0.006637847]
|
||
|
|
, [ "Everest Pakistan", 6377296, 0.006637534]
|
||
|
|
, [ "Indonesian 1974", 6378160, 0.006694609]
|
||
|
|
, [ "Arc 1950", 6378249.145,0.006803481]
|
||
|
|
, [ "NAD 27",6378206.4,0.006768658]
|
||
|
|
, [ "NAD 83",6378137,0.006694384]
|
||
|
|
);
|
||
|
|
|
||
|
|
# calc ecc as
|
||
|
|
# a = semi major axis
|
||
|
|
# b = semi minor axis
|
||
|
|
# e^2 = (a^2-b^2)/a^2
|
||
|
|
# For clarke 1880 (Arc1950) a=6378249.145 b=6356514.966398753
|
||
|
|
# e^2 (40682062155693.23 - 40405282518051.34) / 40682062155693.23
|
||
|
|
# e^2 = 0.0068034810178165
|
||
|
|
|
||
|
|
foreach my $el (@Ellipsoid)
|
||
|
|
{ my ($name, $eqrad, $eccsq) = @$el;
|
||
|
|
$Ellipsoid{$name} = $el;
|
||
|
|
$Ellipsoid{_cleanup_name $name} = $el;
|
||
|
|
}
|
||
|
|
}
|
||
|
|
|
||
|
|
# Returns "official" name, equator radius and square eccentricity
|
||
|
|
# The specified name can be numeric (for compatibility reasons) or
|
||
|
|
# a more-or-less exact name
|
||
|
|
# Examples: my($name, $r, $sqecc) = ellipsoid_info 'wgs84';
|
||
|
|
# my($name, $r, $sqecc) = ellipsoid_info 'WGS 84';
|
||
|
|
# my($name, $r, $sqecc) = ellipsoid_info 'WGS-84';
|
||
|
|
# my($name, $r, $sqecc) = ellipsoid_info 'WGS-84 (new specs)';
|
||
|
|
# my($name, $r, $sqecc) = ellipsoid_info 22;
|
||
|
|
|
||
|
|
sub ellipsoid_info($)
|
||
|
|
{ my $id = shift;
|
||
|
|
|
||
|
|
my $el = $id !~ m/\D/
|
||
|
|
? $Ellipsoid[$id-1] # old system counted from 1
|
||
|
|
: $Ellipsoid{$id} || $Ellipsoid{_cleanup_name $id};
|
||
|
|
|
||
|
|
defined $el ? @$el : ();
|
||
|
|
}
|
||
|
|
|
||
|
|
# Expects Ellipsoid Number or name, Latitude, Longitude
|
||
|
|
# (Latitude and Longitude in decimal degrees)
|
||
|
|
# Returns UTM Zone, UTM Easting, UTM Northing
|
||
|
|
|
||
|
|
sub latlon_to_utm(@)
|
||
|
|
{ my ($ellips, $latitude, $longitude) = @_;
|
||
|
|
|
||
|
|
die("Longitude value ($longitude) invalid\n")
|
||
|
|
if $longitude < -180 || $longitude > 180;
|
||
|
|
|
||
|
|
my $long2 = $longitude - int(($longitude + 180)/360) * 360;
|
||
|
|
my $zone = _latlon_zone_number($latitude, $long2);
|
||
|
|
|
||
|
|
_latlon_to_utm($ellips || 'WGS84', $zone, $latitude, $long2);
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _latlon_zone_number
|
||
|
|
{ my ($latitude, $long2) = @_;
|
||
|
|
|
||
|
|
my $zone = int( ($long2 + 180)/6) + 1;
|
||
|
|
if($latitude >= 56.0 && $latitude < 64.0 && $long2 >= 3.0 && $long2 < 12.0)
|
||
|
|
{ $zone = 32;
|
||
|
|
}
|
||
|
|
if($latitude >= 72.0 && $latitude < 84.0) {
|
||
|
|
$zone = ($long2 >= 0.0 && $long2 < 9.0) ? 31
|
||
|
|
: ($long2 >= 9.0 && $long2 < 21.0) ? 33
|
||
|
|
: ($long2 >= 21.0 && $long2 < 33.0) ? 35
|
||
|
|
: ($long2 >= 33.0 && $long2 < 42.0) ? 37
|
||
|
|
: $zone;
|
||
|
|
}
|
||
|
|
return $zone;
|
||
|
|
}
|
||
|
|
|
||
|
|
sub _latlon_to_utm
|
||
|
|
{ my ($ellips, $zone, $latitude, $long2) = @_;
|
||
|
|
|
||
|
|
my ($name, $radius, $eccentricity) = ellipsoid_info $ellips
|
||
|
|
or die("Ellipsoid value ($ellips) invalid\n");
|
||
|
|
|
||
|
|
my $lat_radian = $deg2rad * $latitude;
|
||
|
|
my $long_radian = $deg2rad * $long2;
|
||
|
|
|
||
|
|
my $k0 = 0.9996; # scale
|
||
|
|
|
||
|
|
my $longorigin = ($zone - 1)*6 - 180 + 3;
|
||
|
|
my $longoriginradian = $deg2rad * $longorigin;
|
||
|
|
my $eccentprime = $eccentricity/(1-$eccentricity);
|
||
|
|
|
||
|
|
my $N = $radius / sqrt(1-$eccentricity * sin($lat_radian)*sin($lat_radian));
|
||
|
|
my $T = tan($lat_radian) * tan($lat_radian);
|
||
|
|
my $C = $eccentprime * cos($lat_radian)*cos($lat_radian);
|
||
|
|
my $A = cos($lat_radian) * ($long_radian - $longoriginradian);
|
||
|
|
my $M = $radius
|
||
|
|
* ( ( 1 - $eccentricity/4 - 3 * $eccentricity * $eccentricity/64
|
||
|
|
- 5 * $eccentricity * $eccentricity * $eccentricity/256
|
||
|
|
) * $lat_radian
|
||
|
|
- ( 3 * $eccentricity/8 + 3 * $eccentricity * $eccentricity/32
|
||
|
|
+ 45 * $eccentricity * $eccentricity * $eccentricity/1024
|
||
|
|
) * sin(2 * $lat_radian)
|
||
|
|
+ ( 15 * $eccentricity * $eccentricity/256 +
|
||
|
|
45 * $eccentricity * $eccentricity * $eccentricity/1024
|
||
|
|
) * sin(4 * $lat_radian)
|
||
|
|
- ( 35 * $eccentricity * $eccentricity * $eccentricity/3072
|
||
|
|
) * sin(6 * $lat_radian)
|
||
|
|
);
|
||
|
|
|
||
|
|
my $utm_easting = $k0*$N*($A+(1-$T+$C)*$A*$A*$A/6
|
||
|
|
+ (5-18*$T+$T*$T+72*$C-58*$eccentprime)*$A*$A*$A*$A*$A/120)
|
||
|
|
+ 500000.0;
|
||
|
|
|
||
|
|
my $utm_northing= $k0 * ( $M + $N*tan($lat_radian) * ( $A*$A/2+(5-$T+9*$C+4*$C*$C)*$A*$A*$A*$A/24 + (61-58*$T+$T*$T+600*$C-330*$eccentprime) * $A*$A*$A*$A*$A*$A/720));
|
||
|
|
|
||
|
|
$utm_northing += 10000000.0 if $latitude < 0;
|
||
|
|
|
||
|
|
my $utm_letter
|
||
|
|
= ( 84 >= $latitude && $latitude >= 72) ? 'X'
|
||
|
|
: ( 72 > $latitude && $latitude >= 64) ? 'W'
|
||
|
|
: ( 64 > $latitude && $latitude >= 56) ? 'V'
|
||
|
|
: ( 56 > $latitude && $latitude >= 48) ? 'U'
|
||
|
|
: ( 48 > $latitude && $latitude >= 40) ? 'T'
|
||
|
|
: ( 40 > $latitude && $latitude >= 32) ? 'S'
|
||
|
|
: ( 32 > $latitude && $latitude >= 24) ? 'R'
|
||
|
|
: ( 24 > $latitude && $latitude >= 16) ? 'Q'
|
||
|
|
: ( 16 > $latitude && $latitude >= 8) ? 'P'
|
||
|
|
: ( 8 > $latitude && $latitude >= 0) ? 'N'
|
||
|
|
: ( 0 > $latitude && $latitude >= -8) ? 'M'
|
||
|
|
: ( -8 > $latitude && $latitude >= -16) ? 'L'
|
||
|
|
: (-16 > $latitude && $latitude >= -24) ? 'K'
|
||
|
|
: (-24 > $latitude && $latitude >= -32) ? 'J'
|
||
|
|
: (-32 > $latitude && $latitude >= -40) ? 'H'
|
||
|
|
: (-40 > $latitude && $latitude >= -48) ? 'G'
|
||
|
|
: (-48 > $latitude && $latitude >= -56) ? 'F'
|
||
|
|
: (-56 > $latitude && $latitude >= -64) ? 'E'
|
||
|
|
: (-64 > $latitude && $latitude >= -72) ? 'D'
|
||
|
|
: (-72 > $latitude && $latitude >= -80) ? 'C'
|
||
|
|
: die("Latitude ($latitude) out of UTM range\n");
|
||
|
|
|
||
|
|
$zone .= $utm_letter;
|
||
|
|
|
||
|
|
($zone, $utm_easting, $utm_northing);
|
||
|
|
}
|
||
|
|
# End Graham Crookham code
|
||
|
|
#===============================================================================
|
||
|
|
|
||
|
|
%Image::ExifTool::UserDefined = (
|
||
|
|
'Image::ExifTool::Composite' => {
|
||
|
|
UTMCoordinates => {
|
||
|
|
Desire => {
|
||
|
|
0 => 'GPSMapDatum',
|
||
|
|
},
|
||
|
|
Require => {
|
||
|
|
1 => 'GPSLatitude',
|
||
|
|
2 => 'GPSLongitude',
|
||
|
|
},
|
||
|
|
ValueConv => 'join " ", latlon_to_utm(@val)',
|
||
|
|
PrintConv => 'sprintf("%s %.3fm E %.3fm N", split(" ", $val))',
|
||
|
|
},
|
||
|
|
UTMZone => {
|
||
|
|
Require => 'UTMCoordinates',
|
||
|
|
ValueConv => 'my @a=split(" ",$val); $a[0]',
|
||
|
|
},
|
||
|
|
UTMEasting => {
|
||
|
|
Require => 'UTMCoordinates',
|
||
|
|
ValueConv => 'my @a=split(" ",$val); $a[1]',
|
||
|
|
},
|
||
|
|
UTMNorthing => {
|
||
|
|
Require => 'UTMCoordinates',
|
||
|
|
ValueConv => 'my @a=split(" ",$val); $a[2]',
|
||
|
|
},
|
||
|
|
},
|
||
|
|
);
|
||
|
|
|
||
|
|
#------------------------------------------------------------------------------
|
||
|
|
1; #end
|