added qra conversions and heading/distance calculations

alter sh/head and sh/prefix to suit

diff --git a/cmd/show/heading.pl b/cmd/show/heading.pl
index 9273243504e0a7b6c73b782f68addfae4546c004..aebf8da36bd6b2b2123956a3187742dc8e2883d3 100644 (file)
--- a/cmd/show/heading.pl
+++ b/cmd/show/heading.pl
@@ -9,16 +9,24 @@ my @list = split /\s+/, $line;                      # generate a list of callsigns
 
 my $l;
 my @out;
+my $lat = $self->user->lat;
+my $long = $self->user->long;
+if (!$long && !$lat) {
+       push @out, $self->msg('heade1');
+       $lat = $main::mylat;
+       $long = $main::mylong;
+}
 
-print "line: $line\n";
 foreach $l (@list) {
   my @ans = Prefix::extract($l);
-  print "ans:", @ans, "\n";
   next if !@ans;
   my $pre = shift @ans;
   my $a;
   foreach $a (@ans) {
-    push @out, sprintf "%s   DXCC: %3d ITU: %3d CQ: %3d (%s, %s)", uc $l, $a->dxcc(), $a->itu(), $a->cq(), $pre, $a->name();
+         my ($b, $dx) = DXBearing::bdist($lat, $long, $a->{lat}, $a->{long});
+         my ($r, $rdx) = DXBearing::bdist($a->{lat}, $a->{long}, $lat, $long);
+         push @out, sprintf "%-9s (%s, %s) Bearing: %.0f Recip: %.0f %.0fKm %.0fMi", uc $l, $pre, $a->name(), $b, $r, $dx, $dx * 0.62133785;
+         $l = "";
   }
 }
 

diff --git a/cmd/show/prefix.pl b/cmd/show/prefix.pl
index 310ee6b858650972a2a2841c32fe52ab033d6232..d1cdcbfeec1de782a687370b3682a019c44d4ce7 100644 (file)
--- a/cmd/show/prefix.pl
+++ b/cmd/show/prefix.pl
@@ -18,7 +18,8 @@ foreach $l (@list) {
   my $pre = shift @ans;
   my $a;
   foreach $a (@ans) {
-    push @out, sprintf "%s   DXCC: %3d ITU: %3d CQ: %3d (%s, %s)", uc $l, $a->dxcc(), $a->itu(), $a->cq(), $pre, $a->name();
+    push @out, sprintf "%-9s DXCC: %3d ITU: %3d CQ: %3d (%s, %s)", uc $l, $a->dxcc(), $a->itu(), $a->cq(), $pre, $a->name();
+       $l = "";
   }
 }
 

diff --git a/perl/DXBearing.pm b/perl/DXBearing.pm
new file mode 100644 (file)
index 0000000..798339c
--- /dev/null
+++ b/perl/DXBearing.pm
@@ -0,0 +1,115 @@
+#
+# bearing and distance calculations together with
+# locator convertions to lat/long and back
+#
+# some of this is nicked from 'Amateur Radio Software' by 
+# John Morris GM4ANB and tranlated into perl from the original
+# basic by me - I have factorised it where I can be bothered
+#
+# Copyright (c) 1998 - Dirk Koopman G1TLH
+#
+# $Id$
+#
+
+package DXBearing;
+
+use POSIX;
+
+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);
+}
+
+# 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;
+
+       $long = $long * $t +.5 ;
+       $lat = $lat * $t * 2 + .5 ;
+
+       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;
+}
+
+# radians to degrees
+sub rd
+{
+       my $n = shift;
+       return ($n / $pi) * 180;
+}
+
+# degrees to radians
+sub dr 
+{
+       my $n = shift;
+       return ($n / 180) * $pi;
+}
+
+# does it look like a qra locator?
+sub is_qra
+{
+       my $qra = shift;
+       return $qra =~ /\a\a\d\d\a\a/o;
+}
+
+# calc bearing and distance, with arguments in DEGREES
+# home lat/long -> lat/long
+# returns bearing (in DEGREES) & distance in KM
+sub bdist
+{
+       my $hn = dr(shift);
+       my $he = dr(shift);
+       my $n = dr(shift);
+       my $e = dr(shift);
+       my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
+       my $ca = atan(abs(sqrt(1-$co*$co)/$co));
+       $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));
+       $az = $pi - $az if $co < 0;
+       $az = -$az if $si < 0;
+       $az = $az+2*$pi if $az < 0;
+       return (rd($az), $dx);
+}
+1;

diff --git a/perl/DXCommandmode.pm b/perl/DXCommandmode.pm
index 639820ad15fff7ce177f95432574a2df862769cd..0f1912387633402372e93091cbe86574d4de318c 100644 (file)
--- a/perl/DXCommandmode.pm
+++ b/perl/DXCommandmode.pm
@@ -19,6 +19,7 @@ use DXDebug;
 use DXM;
 use DXLog;
 use DXLogPrint;
+use DXBearing;
 use CmdAlias;
 use FileHandle;
 use Carp;

diff --git a/perl/Messages b/perl/Messages
index ded684122839778faab5618f6ee94b6384b8d3c7..8d75053f7a19c7c11c97f32bc770bb394c89fcdd 100644 (file)
--- a/perl/Messages
+++ b/perl/Messages
@@ -36,6 +36,7 @@ package DXM;
                                e9 => 'Need at least some text',
                                email => 'E-mail address set to: $_[0]',
                                heres => 'Here set on $_[0]',
+                               heade1 => 'Using $main::mycall Coords, consider doing a set/location or set/qra',
                                hereu => 'Here unset on $_[0]',
                                homebbs => 'Home BBS set to: $_[0]',
                                homenode => 'Home Node set to: $_[0]',