From f2e898274129b45146a83630928e484d814a322a Mon Sep 17 00:00:00 2001
From: djk <djk>
Date: Sat, 5 Dec 1998 01:12:38 +0000
Subject: [PATCH] added qra conversions and heading/distance calculations alter
 sh/head and sh/prefix to suit

---
 cmd/show/heading.pl   |  14 +++--
 cmd/show/prefix.pl    |   3 +-
 perl/DXBearing.pm     | 115 ++++++++++++++++++++++++++++++++++++++++++
 perl/DXCommandmode.pm |   1 +
 perl/Messages         |   1 +
 5 files changed, 130 insertions(+), 4 deletions(-)
 create mode 100644 perl/DXBearing.pm

diff --git a/cmd/show/heading.pl b/cmd/show/heading.pl
index 92732435..aebf8da3 100644
--- 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 310ee6b8..d1cdcbfe 100644
--- 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
index 00000000..798339cb
--- /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 639820ad..0f191238 100644
--- 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 ded68412..8d75053f 100644
--- 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]',
-- 
2.34.1