]> www.dxcluster.org Git - spider.git/blob - perl/DXBearing.pm
add a subversion derived from tags to all builds
[spider.git] / 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 DXUtil;
17 use POSIX qw(:math_h);
18
19 use strict;
20 use vars qw($pi);
21
22 $pi = 3.14159265358979;
23
24 # convert a qra locator into lat/long in DEGREES
25 sub qratoll
26 {
27         my $qra = uc shift;
28         my ($p1, $p2, $p3, $p4, $p5, $p6) = unpack 'AAAAAA', $qra;
29         ($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') );
30         
31         my $long = ($p1*20) + ($p3*2) + (($p5+0.5)/12) - 180;
32     my $lat = ($p2*10) + $p4 + (($p6+0.5)/24) - 90;
33         return ($lat, $long);
34 }
35
36 # convert a lat, long in DEGREES to a qra locator 
37 sub lltoqra
38 {
39         my $lat = shift;
40         my $long = shift;
41
42         my $v;
43         my ($p1, $p2, $p3, $p4, $p5, $p6);
44         
45         $lat += 90;
46         $long += 180;
47         $v = int($long / 20); 
48         $long -= ($v * 20);
49         $p1 = chr(ord('A') + $v);
50         $v = int($lat / 10);                       
51         $lat -= ($v * 10);
52         $p2 = chr(ord('A') + $v);
53         $p3 = int($long/2);
54         $p4 = int($lat);
55         $long -= $p3*2;
56         $lat -= $p4;
57         $p3 = chr(ord('0')+$p3);
58         $p4 = chr(ord('0')+$p4);
59         $p5 = int((12 * $long) );
60         $p6 = int((24 * $lat) );
61         $p5 = chr(ord('A')+$p5);
62         $p6 = chr(ord('A')+$p6);
63
64         return "$p1$p2$p3$p4$p5$p6";
65 }
66
67 # radians to degrees
68 sub rd
69 {
70         my $n = shift;
71         return ($n / $pi) * 180;
72 }
73
74 # degrees to radians
75 sub dr 
76 {
77         my $n = shift;
78         return ($n / 180) * $pi;
79 }
80
81 # calc bearing and distance, with arguments in DEGREES
82 # home lat/long -> lat/long
83 # returns bearing (in DEGREES) & distance in KM
84 sub bdist
85 {
86         my $hn = dr(shift);
87         my $he = dr(shift);
88         my $n = dr(shift);
89         my $e = dr(shift);
90         return (0, 0) if $hn == $n && $he == $e;
91         my $co = cos($he-$e)*cos($hn)*cos($n)+sin($hn)*sin($n);
92         my $ca = $co ? atan(abs(sqrt(1-$co*$co)/$co)) : $pi;
93         $ca = $pi-$ca if $co < 0;
94         my $dx = 6367*$ca;
95         my $si = sin($e-$he)*cos($n)*cos($hn);
96         $co = sin($n)-sin($hn)*cos($ca);
97         my $az = $co ? atan(abs($si/$co)) : $pi;
98         $az = $pi - $az if $co < 0;
99         $az = -$az if $si < 0;
100         $az = $az+2*$pi if $az < 0;
101         return (rd($az), $dx);
102 }
103
104 # turn a lat long string into floating point lat and long
105 sub stoll
106 {
107         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])/;
108         
109         $longd += ($longm/60);
110         $longd = 0-$longd if (uc $longl) eq 'W'; 
111         $latd += ($latm/60);
112         $latd = 0-$latd if (uc $latl) eq 'S';
113         return ($latd, $longd);
114 }
115
116 # turn a lat and long into a string
117 sub lltos
118 {
119         my ($lat, $long) = @_;
120         my $slat = slat($lat);
121         my $slong = slong($long);
122         return "$slat $slong";
123 }
124 1;