branches/gpst.gpsman-format/GPSTgeo.pm

   1 package GPSTgeo;
   2
   3 #=======================================================================
   4 # $Id$
   5 #
   6 # Character set: UTF-8
   7 # ©opyleft 2002– Øyvind A. Holm <sunny@sunbase.org>
   8 # License: GNU General Public License, see end of file for legal stuff.
   9 #=======================================================================
  10
  11 use strict;
  12 use warnings;
  13
  14 BEGIN {
  15     use Exporter ();
  16     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  17
  18     my $rcs_id = '$Id$';
  19     push(@main::version_array, $rcs_id);
  20     $VERSION = ($rcs_id =~ / (\d+) /, $1);
  21
  22     @ISA = qw(Exporter);
  23     @EXPORT = qw(&list_nearest_waypoints &ddd_to_dms &dms_to_ddd);
  24     %EXPORT_TAGS = ();
  25 }
  26 our @EXPORT_OK;
  27
  28 sub list_nearest_waypoints {
  29     # {{{
  30     my ($Lat, $Lon, $Count) = @_;
  31
  32     # FIXME: Hardcoding
  33     my $waypoint_file = "/home/sunny/gps/waypoints.gpx";
  34
  35     # FIXME: Incredible unfinished and kludgy.
  36     if (open(WaypFP, "$main::Cmd{'gpsbabel'} -i gpx -f $waypoint_file " .
  37                      "-x radius,lat=$Lat,lon=$Lon,distance=1000 " .
  38                      "-o gpx -F - |")
  39     ) {
  40         my $Str = join("", <WaypFP>);
  41         $Str =~ s{
  42             ^.*?<wpt\s.*?>.*?<name>(.+?)</name>.*?</wpt>.*?
  43              .*?<wpt\s.*?>.*?<name>(.+?)</name>.*?</wpt>.*?
  44              .*?<wpt\s.*?>.*?<name>(.+?)</name>.*?</wpt>.*$
  45         }{
  46             "($1, $2, $3)";
  47         }sex;
  48         return($Str);
  49     } else {
  50         die("$main::progname: Cannot open $main::Cmd{'gpsbabel'} pipe: $!\n");
  51     }
  52     # }}}
  53 }
  54
  55 sub ddd_to_dms {
  56     # Convert floating-point degrees into D°M'S.S" (ISO-8859-1).
  57     # Necessary for import into GPSman. Based on toDMS() from
  58     # gpstrans-0.39 to ensure compatibility.
  59     # {{{
  60     my $ddd = shift;
  61     my $Neg = 0;
  62     my ($Hour, $Min, $Sec) =
  63        (    0,    0,    0);
  64     my $Retval = "";
  65
  66     ($ddd =~ /^\-?(\d*)(\.\d+)?$/) || return(undef);
  67     length($ddd) || ($ddd = 0);
  68
  69     if ($ddd < 0.0) {
  70         $ddd = 0 - $ddd;
  71         $Neg = 1;
  72     }
  73     $Hour = int($ddd);
  74     $ddd = ($ddd - $Hour) * 60.0;
  75     $Min = int($ddd);
  76     $Sec = ($ddd - $Min) * 60.0;
  77
  78     if ($Sec > 59.5) {
  79         $Sec = 0.0;
  80         $Min += 1.0;
  81     }
  82     if ($Min > 59.5) {
  83         $Min = 0.0;
  84         $Hour += 1.0;
  85     }
  86     $Retval = sprintf("%s%.0f\xB0%02.0f'%04.1f\"",
  87                       $Neg
  88                         ? "-"
  89                         : "",
  90                       $Hour, $Min, $Sec);
  91     return $Retval;
  92     # }}}
  93 }
  94
  95 sub dms_to_ddd {
  96     # {{{
  97     my ($Deg, $Min, $Sec) = @_;
  98
  99     defined($Deg) || ($Deg = 0);
 100     defined($Min) || ($Min = 0);
 101     defined($Sec) || ($Sec = 0);
 102
 103     length($Deg) || ($Deg = 0);
 104     length($Min) || ($Min = 0);
 105     length($Sec) || ($Sec = 0);
 106
 107     if ("$Deg$Min$Sec" =~ /[^\d\.]/) {
 108         return(undef);
 109     }
 110     # Limit at 16 decimals, due to float restriction. YAGNI.
 111     my $Retval = 1.0 * sprintf("%.16f", $Deg + 1.0*$Min/60 + 1.0*$Sec/3600);
 112     return(GPST::num_expand($Retval));
 113     # }}}
 114 }
 115
 116 1;