From: djk Date: Sat, 5 Dec 1998 01:12:38 +0000 (+0000) Subject: added qra conversions and heading/distance calculations X-Git-Tag: R_1_8~5 X-Git-Url: http://dxcluster.net/gitweb/gitweb.cgi?a=commitdiff_plain;h=f2e898274129b45146a83630928e484d814a322a;p=spider.git 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 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]',