branches/gpst.spread/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 use GPSTdebug;
  15
  16 BEGIN {
  17     use Exporter ();
  18     our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);
  19
  20     my $rcs_id = '$Id$';
  21     push(@main::version_array, $rcs_id);
  22     $VERSION = ($rcs_id =~ / (\d+) /, $1);
  23
  24     @ISA = qw(Exporter);
  25     @EXPORT = qw(&list_nearest_waypoints &ddd_to_dms &current_pos &current_pos);
  26     %EXPORT_TAGS = ();
  27 }
  28 our @EXPORT_OK;
  29
  30 sub list_nearest_waypoints {
  31     # {{{
  32     my ($Lat, $Lon, $Count) = @_;
  33
  34     # FIXME: Hardcoding
  35     my $waypoint_file = "/home/sunny/gps/waypoints.gpx";
  36
  37     # FIXME: Incredible unfinished and kludgy.
  38     if (open(WaypFP, "$main::Cmd{'gpsbabel'} -i gpx -f $waypoint_file " .
  39                      "-x radius,lat=$Lat,lon=$Lon,distance=1000 " .
  40                      "-o gpx -F - |")
  41     ) {
  42         my $Str = join("", <WaypFP>);
  43         $Str =~ s{
  44             ^.*?<wpt\s.*?>.*?<name>(.+?)</name>.*?</wpt>.*?
  45              .*?<wpt\s.*?>.*?<name>(.+?)</name>.*?</wpt>.*?
  46              .*?<wpt\s.*?>.*?<name>(.+?)</name>.*?</wpt>.*$
  47         }{
  48             "($1, $2, $3)";
  49         }sex;
  50         return($Str);
  51     } else {
  52         die("$main::progname: Cannot open $main::Cmd{'gpsbabel'} pipe: $!\n");
  53     }
  54     # }}}
  55 }
  56
  57 sub ddd_to_dms {
  58     # Convert floating-point degrees into D°M'S.S" (ISO-8859-1).
  59     # Necessary for import into GPSman. Based on toDMS() from
  60     # gpstrans-0.39 to ensure compatibility.
  61     # {{{
  62     my $ddd = shift;
  63     my $Neg = 0;
  64     my ($Hour, $Min, $Sec) =
  65        (    0,    0,    0);
  66     my $Retval = "";
  67
  68     ($ddd =~ /^\-?(\d*)(\.\d+)?$/) || return(undef);
  69     length($ddd) || ($ddd = 0);
  70
  71     if ($ddd < 0.0) {
  72         $ddd = 0 - $ddd;
  73         $Neg = 1;
  74     }
  75     $Hour = int($ddd);
  76     $ddd = ($ddd - $Hour) * 60.0;
  77     $Min = int($ddd);
  78     $Sec = ($ddd - $Min) * 60.0;
  79
  80     if ($Sec > 59.5) {
  81         $Sec = 0.0;
  82         $Min += 1.0;
  83     }
  84     if ($Min > 59.5) {
  85         $Min = 0.0;
  86         $Hour += 1.0;
  87     }
  88     $Retval = sprintf("%s%.0f\xB0%02.0f'%04.1f\"",
  89                       $Neg
  90                         ? "-"
  91                         : "",
  92                       $Hour, $Min, $Sec);
  93     return $Retval;
  94     # }}}
  95 }
  96
  97 sub current_pos {
  98     # Calculate current lat or lon position based on time.
  99     # ta/tb = first/last time
 100     # xa/xb = first/last position
 101     # tc/xc = current time/position
 102     #
 103     # xc = xa+((xb-xa)*((tc-ta)/(tb-ta)))
 104
 105     my ($ta, $xa, $tb, $xb, $tc) = @_;
 106     D("current_pos('" . join("', '", @_) . "');");
 107     my $xc = $xa+(($xb-$xa)*(($tc-$ta)/($tb-$ta)));
 108     D("current_pos() returns '$xc'");
 109     return($xc);
 110 }
 111
 112 1;