perl/DXBearing.pm

   1 #
   2 # bearing and distance calculations together with
   3 # locator convertions to lat/long and back
   4 #
   5 # some of this is nicked from 'Amateur Radio Software' by
   6 # John Morris GM4ANB and tranlated into perl from the original
   7 # basic by me - I have factorised it where I can be bothered
   8 #
   9 # Copyright (c) 1998 - Dirk Koopman G1TLH
  10 #
  11 # $Id$
  12 #
  13
  14 package DXBearing;
  15
  16 use POSIX;
  17 use DXUtil;
  18
  19 use strict;
  20 use vars qw($pi);
  21
  22 $pi = 3.14159265358979;
  23
  24 use vars qw($VERSION $BRANCH);
  25 $VERSION = sprintf( "%d.%03d", q$Revision$ =~ /(\d+)\.(\d+)/ );
  26 $BRANCH = sprintf( "%d.%03d", q$Revision$ =~ /\d+\.\d+\.(\d+)\.(\d+)/  || (0,0));
  27 $main::build += $VERSION;
  28 $main::branch += $BRANCH;
  29
  30 # convert a qra locator into lat/long in DEGREES
  31 sub qratoll
  32 {
  33         my $qra = uc shift;
  34         my ($p1, $p2, $p3, $p4, $p5, $p6) = unpack 'AAAAAA', $qra;
  35         ($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') );
  36
  37         my $long = ($p1*20) + ($p3*2) + (($p5+0.5)/12) - 180;
  38     my $lat = ($p2*10) + $p4 + (($p6+0.5)/24) - 90;
  39         return ($lat, $long);
  40 }
  41
  42 # convert a lat, long in DEGREES to a qra locator
  43 sub lltoqra
  44 {
  45         my $lat = shift;
  46         my $long = shift;
  47
  48         my $v;
  49         my ($p1, $p2, $p3, $p4, $p5, $p6);
  50
  51         $lat += 90;
  52         $long += 180;
  53         $v = int($long / 20);
  54         $long -= ($v * 20);
  55         $p1 = chr(ord('A') + $v);
  56         $v = int($lat / 10);
  57         $lat -= ($v * 10);
  58         $p2 = chr(ord('A') + $v);
  59         $p3 = int($long/2);
  60         $p4 = int($lat);
  61         $long -= $p3*2;
  62         $lat -= $p4;
  63         $p3 = chr(ord('0')+$p3);
  64         $p4 = chr(ord('0')+$p4);
  65         $p5 = int((12 * $long) );
  66         $p6 = int((24 * $lat) );
  67         $p5 = chr(ord('A')+$p5);
  68         $p6 = chr(ord('A')+$p6);
  69
  70         return "$p1$p2$p3$p4$p5$p6";
  71 }
  72
  73 # radians to degrees
  74 sub rd
  75 {
  76         my $n = shift;
  77         return ($n / $pi) * 180;
  78 }
  79
  80 # degrees to radians
  81 sub dr
  82 {
  83         my $n = shift;
  84         return ($n / 180) * $pi;
  85 }
  86
  87 # calc bearing and distance, with arguments in DEGREES
  88 # home lat/long -> lat/long
  89 # returns bearing (in DEGREES) & distance in KM
  90 sub bdist
  91 {
  92         my $hn = dr(shift);
  93         my $he = dr(shift);
  94         my $n = dr(shift);
  95         my $e = dr(shift);
  96         return (0, 0) if $hn == $n && $he == $e;
  97         my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
  98         my $ca = $co ? atan(abs(sqrt(1-$co*$co)/$co)) : $pi;
  99         $ca = $pi-$ca if $co < 0;
 100         my $dx = 6367*$ca;
 101         my $si = sin($e-$he)*cos($n)*cos($hn);
 102         $co = sin($n)-sin($hn)*cos($ca);
 103         my $az = $co ? atan(abs($si/$co)) : $pi;
 104         $az = $pi - $az if $co < 0;
 105         $az = -$az if $si < 0;
 106         $az = $az+2*$pi if $az < 0;
 107         return (rd($az), $dx);
 108 }
 109
 110 # turn a lat long string into floating point lat and long
 111 sub stoll
 112 {
 113         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])/;
 114
 115         $longd += ($longm/60);
 116         $longd = 0-$longd if (uc $longl) eq 'W';
 117         $latd += ($latm/60);
 118         $latd = 0-$latd if (uc $latl) eq 'S';
 119         return ($latd, $longd);
 120 }
 121
 122 # turn a lat and long into a string
 123 sub lltos
 124 {
 125         my ($lat, $long) = @_;
 126         my $slat = slat($lat);
 127         my $slong = slong($long);
 128         return "$slat $slong";
 129 }
 130 1;