X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=blobdiff_plain;f=perl%2FDXBearing.pm;h=db6f4686d0a75ed89c32e0c32e28509ae233bb5a;hb=8106275008346b0cceb090f7317ff4240a3ba44f;hp=ea17c2a4221e58d5143f4786ec9d160e9acfb033;hpb=e00a697bdb9f7c066b3e921d4f8ccc9bb9cf7485;p=spider.git

diff --git a/perl/DXBearing.pm b/perl/DXBearing.pm
index ea17c2a4..db6f4686 100644
--- a/perl/DXBearing.pm
+++ b/perl/DXBearing.pm
@@ -8,66 +8,60 @@
 #
 # Copyright (c) 1998 - Dirk Koopman G1TLH
 #
-# $Id$
+#
 #
 
 package DXBearing;
 
-use POSIX;
+use DXUtil;
+use POSIX qw(:math_h);
 
 use strict;
 use vars qw($pi);
 
 $pi = 3.14159265358979;
 
-# half a qra to lat long translation
-sub _half_qratoll
-{
-	my ($l, $n, $m) = @_;
-	my $lat = ord($l) - ord('A');
-	$lat = $lat * 10 + (ord($n) - ord('0'));
-	$lat = $lat * 24 + (ord($m) - ord('A'));
-	$lat -= (2160 + 0.5);
-	$lat = $lat * ($pi/4320);
-	
-} 
 # convert a qra locator into lat/long in DEGREES
 sub qratoll
 {
 	my $qra = uc shift;
-	my $long = _half_qratoll((unpack 'AAAAAA', $qra)[0,2,4]) * 2;
-	my $lat = _half_qratoll((unpack 'AAAAAA', $qra)[1,3,5]);
-	return (rd($lat), rd($long));
-}
-
-sub _part_lltoqra
-{
-	my ($t, $f, $n, $e) = @_;
-	$n = $f * ($n - int($n));
-	$e = $f * ($e - int($e));
-	my $q = chr($t+$e) . chr($t+$n);
-	return ($q, $n, $e);
+	my ($p1, $p2, $p3, $p4, $p5, $p6) = unpack 'AAAAAA', $qra;
+	($p1, $p2, $p3, $p4, $p5, $p6) = (ord($p1)-ord('A'), ord($p2)-ord('A'), ord($p3)-ord('0'), ord($p4)-ord('0'), ord($p5)-ord('A'), ord($p6)-ord('A') );
+	
+	my $long = ($p1*20) + ($p3*2) + (($p5+0.5)/12) - 180;
+    my $lat = ($p2*10) + $p4 + (($p6+0.5)/24) - 90;
+	return ($lat, $long);
 }
 
 # convert a lat, long in DEGREES to a qra locator 
 sub lltoqra
 {
-	my $lat = dr(shift);
-	my $long = dr(shift);
-	my $t = 1/6.283185;
+	my $lat = shift;
+	my $long = shift;
 
-	$long = $long * $t +.5 ;
-	$lat = $lat * $t * 2 + .5 ;
+	my $v;
+	my ($p1, $p2, $p3, $p4, $p5, $p6);
+	
+	$lat += 90;
+	$long += 180;
+	$v = int($long / 20); 
+	$long -= ($v * 20);
+	$p1 = chr(ord('A') + $v);
+	$v = int($lat / 10);			   
+	$lat -= ($v * 10);
+	$p2 = chr(ord('A') + $v);
+	$p3 = int($long/2);
+	$p4 = int($lat);
+	$long -= $p3*2;
+	$lat -= $p4;
+	$p3 = chr(ord('0')+$p3);
+	$p4 = chr(ord('0')+$p4);
+	$p5 = int((12 * $long) );
+	$p6 = int((24 * $lat) );
+	$p5 = chr(ord('A')+$p5);
+	$p6 = chr(ord('A')+$p6);
 
-	my $q;
-	my $qq;
-	($q, $lat, $long) = _part_lltoqra(ord('A'), 18, $lat, $long);
-	$qq = $q;
-	($q, $lat, $long) = _part_lltoqra(ord('0'), 10, $lat, $long);
-	$qq .= $q;
-	($q, $lat, $long) = _part_lltoqra(ord('A'), 24, $lat, $long);
-	$qq .= $q;
-	return $qq;
+	return "$p1$p2$p3$p4$p5$p6";
 }
 
 # radians to degrees
@@ -84,13 +78,6 @@ sub dr
 	return ($n / 180) * $pi;
 }
 
-# does it look like a qra locator?
-sub is_qra
-{
-	my $qra = shift;
-	return $qra =~ /^[A-Za-z][A-Za-z]\d\d[A-Za-z][A-Za-z]$/o;
-}
-
 # calc bearing and distance, with arguments in DEGREES
 # home lat/long -> lat/long
 # returns bearing (in DEGREES) & distance in KM
@@ -100,16 +87,52 @@ sub bdist
 	my $he = dr(shift);
 	my $n = dr(shift);
 	my $e = dr(shift);
+	return (0, 0) if $hn == $n && $he == $e;
 	my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
-	my $ca = atan(abs(sqrt(1-$co*$co)/$co));
+	my $ca = $co ? atan(abs(sqrt(1-$co*$co)/$co)) : $pi;
 	$ca = $pi-$ca if $co < 0;
 	my $dx = 6367*$ca;
 	my $si = sin($e-$he)*cos($n)*cos($hn);
 	$co = sin($n)-sin($hn)*cos($ca);
-	my $az = atan(abs($si/$co));
+	my $az = $co ? atan(abs($si/$co)) : $pi;
 	$az = $pi - $az if $co < 0;
 	$az = -$az if $si < 0;
 	$az = $az+2*$pi if $az < 0;
 	return (rd($az), $dx);
 }
+
+# just the distance - parameters as above
+sub distance
+{
+	my $hn = dr(shift);
+	my $he = dr(shift);
+	my $n = dr(shift);
+	my $e = dr(shift);
+	return (0, 0) if $hn == $n && $he == $e;
+	my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
+	my $ca = $co ? atan(abs(sqrt(1-$co*$co)/$co)) : $pi;
+	$ca = $pi-$ca if $co < 0;
+	my $dx = 6367*$ca;
+}
+
+# turn a lat long string into floating point lat and long
+sub stoll
+{
+	my ($latd, $latm, $latl, $longd, $longm, $longl) = $_[0] =~ /(\d{1,2})\s+(\d{1,2})\s*([NnSs])\s+(1?\d{1,2})\s+(\d{1,2})\s*([EeWw])/;
+	
+	$longd += ($longm/60);
+	$longd = 0-$longd if (uc $longl) eq 'W'; 
+	$latd += ($latm/60);
+	$latd = 0-$latd if (uc $latl) eq 'S';
+	return ($latd, $longd);
+}
+
+# turn a lat and long into a string
+sub lltos
+{
+	my ($lat, $long) = @_;
+	my $slat = slat($lat);
+	my $slong = slong($long);
+	return "$slat $slong";
+}
 1;