#!/usr/bin/perl -w
#
# by Winfried Beer, 2002
#

use IO::Handle;
use POSIX;
use Fcntl;

$PI=3.14159265358979323846;
if (unpack("V",pack("L",1))==1) {
  $little_endian=1;
}else{
  $little_endian=0;
}

$device='/dev/cua1';
$debug=0;
$recbuf=""; # global buffer for serial device
$oldpid=0;  # global for decode_packet
@PA=();     # global for decode_packet (Protocol Arrray), specifies available protocols and data formats
@PA=("P000",  "L001", "A010", "A100", "D108", "A201", "D202", "D108", "D210",
  "A301", "D310", "D301", "A500", "D501", "A600", "D600", "A700", "D700",
  "A800", "D800", "A900", "A902", "A903"); # default for: etrex vista
$PA_idx=-1;      # global for decode_packet (index of @PA with current application protocol)
$PA_wpt_type="";
$PA_rte_hdr_type="";
$PA_rte_point_type=""; 
$PA_rte_link_type="";
$PA_trk_point_type=""; 
$PA_trk_hdr_type="";
$PA_prx_wpt_type="";
$PA_almanac_type="";
$PA_date_time_type="";
$PA_position_type="";
$PA_pvt_data_type="";
@month_names=("JAN","FEB","MAR","APR","MAY","JUN","JUL","AUG","SEP","OCT","NOV","DEC");

if ($#ARGV==-1) { push @ARGV, "-h" };

for ($i=0; $i<=$#ARGV; $i++) {
  if ($ARGV[$i] eq "-h") {
    print STDERR "\ngarman [-h] [-d] [-p port] [-i] [-t] [-d?]\n";
    print STDERR " (by Winfried Beer, July 2002, v0.1)\n\n";
    print STDERR "Flags:\n";
    print STDERR "  -h        help\n";
    print STDERR "  -d        enable debug mode\n";
    print STDERR "  -p port   serial i/o-device\n";
    print STDERR "  -i        identify connected GPS\n";
    print STDERR "  -d????    download: rte=route, trk=track, wpt=waypoint, ";
    print STDERR              "alm=almanac, prx=proximity waypoints, time=date&time\n ";
    print STDERR              "posn=position\n ";
    print STDERR "  -abort    abort transfer\n ";
    print STDERR "  -pvt_on, -pvt_off           PVT mode on/off\n ";
    print STDERR "  -pwr_off,-pwr_off_prompt    switch off gps device\n ";
    print STDERR "  -sleep <seconds>            wait some seconds\n ";
    exit;
  }elsif ($ARGV[$i] eq "-p") {
    $device=$ARGV[$i+1];
  }elsif ($ARGV[$i] eq "-d") {
    $debug=1;
  }
}


# --- open serial port and set serial parameters
sysopen (PORT, $device, O_RDWR|O_NDELAY|O_NOCTTY, 0700) or die "Cannot read from $device";

# -- set serial parameters
# $termios_t = "cccs";
# ioctl (PORT, &TCGETA, $termios);
# @ary = unpack($termios_t,$termios);
$termios=POSIX::Termios->new;
$termios->getattr(fileno(PORT));
$termios->setcflag((&POSIX::CSIZE & &POSIX::CS8) | &POSIX::CREAD | &POSIX::CLOCAL);
$termios->setiflag(0);
$termios->setlflag(0);
$termios->setoflag(0);
$termios->setospeed(&POSIX::B9600);
$termios->setispeed(&POSIX::B9600);
$termios->setattr(fileno(PORT));

$argcnt=0;
MAINLOOP: while ($argcnt<=$#ARGV) {

  #($nfound,$timeleft)=select(undef, undef, undef, 0.5);  # wait 0.5 seconds

  # --- get next useful argument and send command to GPS device
  $prot="";
  $noop=1;
  while ($argcnt<=$#ARGV && $noop==1) {
    $noop=0;
    $prot="";
    if ($ARGV[$argcnt] eq "-i") { # A000 Product Data Protocol (includes A001)
      $cmd=make_packet(254, chr(254).chr(0));
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-dwpt") {  # A1xx Waypoint Transfer Protocol
      $cmd=make_packet(10, chr(7).chr(0));  # ==Cmnd_Transfer_Wpt
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-drte") {  # A2xx Route Transfer Protocol
      $cmd=make_packet(10, chr(4).chr(0));  # ==Cmnd_Transfer_Rte
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-dtrk") {  # A3xx Track Log Transfer Protocol
      $cmd=make_packet(10, chr(6).chr(0));  # ==Cmnd_Transfer_Trk
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-dprx") {  # A4xx Proximity Waypoint Transfer Protocol
      $cmd=make_packet(10, chr(3).chr(0));  # ==Cmnd_Transfer_Prx
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-dalm") {  # A5xx Almanac Transfer Protocol
      $cmd=make_packet(10, chr(1).chr(0));  # ==Cmnd_Transfer_Alm
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-dtime") {  # A6xx Date and Time Initialization Protocol
      $cmd=make_packet(10, chr(5).chr(0));  # ==Cmnd_Transfer_Time
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-dposn") {  # A7xx Position Initialization Protocol
      $cmd=make_packet(10, chr(2).chr(0));  # ==Cmnd_Transfer_Posn
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-pvt_on") {  # A8xx PVT Data Protocol (start)
      $cmd=make_packet(10, chr(49).chr(0));  # ==Cmnd_Start_Pvt_Data
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-pvt_off") {  # A8xx PVT Data Protocol (stop)
      $cmd=make_packet(10, chr(50).chr(0));  # ==Cmnd_Stop_Pvt_Data
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
      sleep(1);
    }elsif ($ARGV[$argcnt] eq "-abort") {  
      $cmd=make_packet(10, chr(0).chr(0));  # ==Cmnd_Abort_Transfer
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
    }elsif ($ARGV[$argcnt] eq "-pwr_off") {  
      $cmd=make_packet(10, chr(8).chr(0));  # ==Cmnd_Turn_Off_Pwr
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);
    }elsif ($ARGV[$argcnt] eq "-pwr_off_prompt") {  
      $cmd=make_packet(10, chr(11).chr(0)); 
      send_packet_ack(PORT, $cmd);
      decode_packet($cmd);

    }elsif ($ARGV[$argcnt] eq "-sleep") {  
      $argcnt++;
      $noop=1;
      sleep($ARGV[$argcnt]);
      $argcnt++;
    }elsif ($ARGV[$argcnt] eq "-h" || $ARGV[$argcnt] eq "-d") {
      $argcnt++;
      $noop=1;
    }elsif ($ARGV[$argcnt] eq "-p") {
      $argcnt++;
      $argcnt++;
      $noop=1;
    }else{
      print STDERR "\nWARNING: unknown argument \"".$ARGV[$argcnt]."\"\n";
      $argcnt++;
      $noop=1;
    }
    if ($argcnt>$#ARGV) { last MAINLOOP;}
  }


  # -- read requested data packet(s) from GPS
  $idlecnt=0;
  READLIST: while ($idlecnt<9) { # loop as long packets received within last 2 seconds (8*250 ms) (or all data read)
    $packet=receive_packet_ack(PORT);
    if (!defined($packet)) {
      $idlecnt=9999;
      print STDERR "ERROR: receiving no data packets.\n"; 
    }elsif ($packet eq "") {
      $idlecnt++;
      if ($debug) { print STDERR "IDLE (buflen=".length($recbuf).")\n"; }
    }else{
      $idlecnt=0;
      $pid=ord(substr($packet,1,1));
      if ($pid==6) {
        print STDERR "ERROR: Got extra ACK.\n";
      }elsif ($pid==21) {
        print STDERR "ERROR: Got extra NAK.\n";
      }else{
        if ($debug) { print STDERR "DATA: ".hexstr($packet)."\n"; }
        $str=decode_packet ($packet);
	if (!$debug) { $str=~s/##.*?\n//g; }  # clear debug comments
        print $str;
	if ($pid==12 || $pid==253 || $pid==14 || $pid==17 || $pid==51) {
	  # Pid_Xfer_Cmplt, Pid_Protocol_Array, Pid_Date_Time_Data, Pid_Position_Data, Pid_Pvt_Data
	  # (end of packet list or one packet protocols)
          last READLIST; # no more packets expected
	}
      }
    }
  }

  # -- advance to next argument
  $argcnt++;
}

close PORT;
exit;


# ---------------------------------------------------------------------
# Read from $FH, but return (an empty string) within $timeout 
# seconds, if no data are available. Return undef at end of file
# or other errors.
#
# $FH:      filehandle
# $timeout: timeout in seconds, fraction possible (eg. 0.5)
# ---------------------------------------------------------------------
sub read_timeout {
  my ($FH,$timeout)=@_;  
  my ($packet,$nfound,$rin);

  $rin='';
  vec($rin,fileno($FH),1) = 1;
  ($nfound,undef)=select($rin, undef, $rin, $timeout);
  if (!$nfound) { return ''; } # timed out
  sysread $FH, $packet,1024;
  if ($packet eq '') { return undef;} # error or end of file
  #print "RAW: ".hexstr($packet)."\n";
  return $packet;
}

# ---------------------------------------------------------------------
sub hexstr {
  my ($str)=@_;
  my ($hex,$i);

  $hex="";
  if ($str ne "") {
    for ($i=0;$i<length($str);$i++){
      $hex=$hex.sprintf("%02x ",ord(substr($str,$i,1)));
    }
    #return pack ("x*", unpack("c*",$str));
  } 
  return $hex;
}

# ---------------------------------------------------------------------
sub send_packet_ack {
  my ($FH,$packet)=@_;
  my ($pid,$ret);

  $pid=ord(substr($packet,1,1));
  send_packet ($FH,$packet);
  $ret=waitfor_ack ($FH,$pid);
  if (!defined($ret)) {
    return undef;
  }else{
    return 1;
  }
}

# ---------------------------------------------------------------------
sub receive_packet_ack {
  my ($FH)=@_;
  my ($packet,$ret);

  $packet=receive_packet ($FH);
  if (!defined($packet)) {return undef;}
  if ($packet eq "") {return "";} # timed out
  $pid=ord(substr($packet,1,1));
  $ret=send_ack ($FH,$pid);
  if (!defined($ret)) {
    return undef;
  }else{
    return $packet;
  }
}

# ---------------------------------------------------------------------
sub make_packet {
  my ($pid,$str)=@_;
  my ($packet,$checksum);

  $packet=chr($pid).chr(length($str)).$str;
  $checksum=eval_checksum($packet);
  $packet=$packet.chr($checksum);
  $packet=~s/\020/\020\020/g;  # DLE Stuffing
  $packet=chr(16).$packet.chr(16).chr(3); # DLE+pid+size+packet+DLE+ETX
  return $packet;
}

# ---------------------------------------------------------------------
sub send_packet {
  my ($FH,$packet)=@_;

  syswrite $FH,$packet,length($packet);
  if ($debug) {print STDERR "OUT:  ".hexstr($packet)."\n";}
}

# ---------------------------------------------------------------------
# Read data from device $FH and return one correct packet.
# Other packets are recbuffered and used for following calls.
# ---------------------------------------------------------------------
sub receive_packet {
  my ($FH)=@_;
  my ($packet,$have_read,$len,$checksum,$i);

  $packet="";
  $have_read=0;

  while (1==1) {
#print "T0: ".hexstr($recbuf)."\n";
    $i=1;
    while ($i<length($recbuf)-1) {
#print "X: ".ord(substr($recbuf,$i,1))."\n";
      if (ord(substr($recbuf,$i,1))==16) {
        if (ord(substr($recbuf,$i+1,1))==16) {
	  $i++; # skip stuffed DLE
	}elsif (ord(substr($recbuf,$i+1,1))==3) {
          # packet found
          $packet=substr($recbuf,0,$i+2);
          $recbuf=substr($recbuf,length($packet));
          $packet=~s/^[^\020]*\020/\020/g;  # cut off leading noise
          $packet=~s/\020\020/\020/g;  # DLE destuffing
          if (substr($packet,0,1) eq chr(16)) { # check packet
            $len=length($packet);
	    if (ord(substr($packet,2,1))==$len-6) {
	      $checksum=eval_checksum(substr($packet,1,$len-4));
	      if (ord(substr($packet,$len-3,1))==$checksum) {
#print "T1: ".hexstr($packet)."\n";
#print "T2: ".hexstr($recbuf)."\n";
                if ($debug) { print STDERR "IN:   ".hexstr($packet)."\n"; }
                return $packet; # yeah, packet is good!
	      }
	    }
	  }
        }
      }
      $i++;
    }

    if ($have_read) { return ""; };  # no complete packet yet

    $newrecbuf=read_timeout($FH, 0.25);
    if (!defined($newrecbuf)) {return undef;}  # eof or error
    if ($newrecbuf eq "") {return "";} # timeout
    $recbuf=$recbuf.$newrecbuf;
    $have_read=1;
  }
}


# ---------------------------------------------------------------------
sub send_ack {
  my ($FH,$pid)=@_;
  my $packet;

  if ($pid==6 || $pid==21) { return 1; } # don't send an ACK for an ACK packet!
  if ($debug) { print STDERR "send ack...\n"; }
  $packet=make_packet(6,chr($pid).chr(0));
  send_packet($FH, $packet);
  if ($debug) { print STDERR "...ack sent\n"; }
  return 1;
}

# ---------------------------------------------------------------------
# wait for ACK; returns 1 if successfull, 0 else (error)
# ---------------------------------------------------------------------
sub waitfor_ack {
  my ($FH,$pid)=@_;
  my ($rep,$packet);

  if ($pid==6 || $pid==21) { return 1; } # don't wait for ACK of an ACK packet!

  if ($debug) { print STDERR "waitfor ack...\n"; }
  # -- wait for my ack
  $rep=0;
  while ($rep<4) {
    $packet=receive_packet($FH);
    if ($packet ne "") {
      if (ord(substr($packet,1,1))==6 && ord(substr($packet,3,1))==$pid) {
        # yeah, got my ack
        if ($debug) { print STDERR "...ack received\n"; }
	return 1;
      }elsif (ord(substr($packet,1,1))==21) {
        print STDERR "ERROR: Got NAK.\n";
	return undef;
      }else{
        print STDERR "WARNING: waiting for ACK, got wrong packet. Waiting...\n";
      }
    }else{
      print STDERR "WARNING: ACK timed out. Waiting...\n";
    }
    $rep++;
  }
  print STDERR "ERROR: Probably packet not sent successfully. ACK missing.\n";
  return undef;
}

# ---------------------------------------------------------------------
sub eval_checksum {
  my ($str)=@_;
  my ($checksum,$i);

  $checksum=unpack("%8C*", $str);
    #$checksum=0;
    #for ($i=0;$i<length($str);$i++){
    #  $checksum=($checksum+ord(substr($str,$i,1)))&255;
    #} 
  $checksum=(256 - ($checksum & 255))&255 ;
  #print "CHK: ".hexstr($str)."-".$checksum."\n";
  return $checksum;
} 

# ---------------------------------------------------------------------
# Decode binary packet from garmin device to ascii text str. (One or
# more lines inside the string. Or even empty.)
# ---------------------------------------------------------------------
sub decode_packet () {
  my ($packet)=@_;
  my ($str,$pid,$pdata);
  my ($i,$cmd,$nr,$s);
  # globals: @PA, $oldpid

  if (length($packet)<6) { print STDERR "WARNING: packet to small\n"; return ""; }

  $pid=ord(substr($packet,1,1));
  $pdata=substr($packet,3,-3);
  $str="";
  if    ($pid==   6) {  # == Pid_Ack
    $str="## Pid_Ack\n";

  }elsif ($pid== 21) {  # == Pid_Nak
    $str="## Pid_Nak\n";
  
  }elsif ($pid==253) {  # == Pid_Protocol_ Array
    @protocol_array=();
    for ($i=0; $i+2<length($pdata); $i=$i+3) {
      push @protocol_array, sprintf("%s%03d",unpack("av",substr($pdata,$i,3)));
    }
    $str="\nH  PROT D_TYPE1 D_TYPE2 D_TYPE3\n";
    foreach $s (@protocol_array) {
      if ($s=~/^D/) {
	chomp $str;
        $str=$str." ".$s."   \n";
      }else{
        $str=$str."PA ".$s."\n";
      }
    }
    @PA=@protocol_array;

  }elsif ($pid==254) {  # == Pid_Product_Request
    $str="## Pid_Product_Request\n";

  }elsif ($pid==255) {  # == Pid_Product_Data
    ($product_id, $software_version)=unpack("vv",$pdata);
    ($product_description, undef)=split(/\0/,substr($pdata,4),2);
      #($product_description, @product_strings)=split(/\0/,substr($pdata,4));
    $str="\nH  PRODUCT_ID SOFTWARE_VERSION PRODUCT_DESCRIPTION\n";
    $str=$str.sprintf("PR %-10d %-16d %s\n", $product_id, $software_version, $product_description);
      #foreach $s (@product_strings) {
      #  $str=$str.sprintf("PS %s\n", $s);
      #}

  }elsif ($pid==10) {  # == Pid_Command_Data
    $cmd=unpack("v",$pdata);
    if ($cmd==0) {
      $str="## Command ".$cmd." (Cmnd_Abort_Transfer)\n";
    }elsif ($cmd==1) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Alm - A5xx)\n";
      $PA_idx=PA_find_protocol("A5");
      $PA_almanac_type=$PA[$PA_idx+1];
    }elsif ($cmd==2) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Posn - A7xx)\n";
      $PA_idx=PA_find_protocol("A7");
      $PA_position_type=$PA[$PA_idx+1];
    }elsif ($cmd==3) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Prx - A4xx)\n";
      $PA_idx=PA_find_protocol("A4");
      $PA_prx_wpt_type=$PA[$PA_idx+1];
    }elsif ($cmd==4) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Rte - A2xx)\n";
      $PA_idx=PA_find_protocol("A4");
      $PA_rte_hdr_type=$PA[$PA_idx+1];
      $PA_rte_point_type=$PA[$PA_idx+2];
      if ($PA[$PA_idx] eq "A201") {
        $PA_rte_link_type=$PA[$PA_idx+3];
      }
    }elsif ($cmd==5) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Time - A6xx)\n";
      $PA_idx=PA_find_protocol("A6");
      $PA_date_time_type=$PA[$PA_idx+1];
    }elsif ($cmd==6) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Trk - A3xx)\n";
      $PA_idx=PA_find_protocol("A3");
      if ($PA[$PA_idx] eq "A301") {
        $PA_trk_point_type=$PA[$PA_idx+2];
        $PA_trk_hdr_type=$PA[$PA_idx+1];
      }else{
        $PA_trk_point_type=$PA[$PA_idx+1];
      }
    }elsif ($cmd==7) {
      $str="## Command ".$cmd." (Cmnd_Transfer_Wpt - A1xx)\n";
      $PA_idx=PA_find_protocol("A1");
      $PA_wpt_type=$PA[$PA_idx+1];
    }elsif ($cmd==49) {
      $str="## Command ".$cmd." (Cmnd_Start_Pvt_Data - A8xx)\n";
      $PA_idx=PA_find_protocol("A8");
      $PA_pvt_data_type=$PA[$PA_idx+1];
    }else {
      $str="## Command ".$cmd." (??)\n";
    }

  }elsif ($pid==27) {  # == Pid_Records
    $nr=unpack("v",$pdata);
    $str="## Records ".$nr."\n";

  }elsif ($pid==12) {  # == Pid_Xfer_Cmplt
    $cmd=unpack("v",$pdata);
    $str="## Xfer_Cmplt ".$cmd."\n";

  }elsif ($pid==35) {  # == Pid_Wpt_Data
    if ($PA_wpt_type eq "D108") {
      #($wpt_class,$color,$dspl,$attr,$smbl,$subclass,$lat,$lon,$alt,$dpth,$dist,$state,$cc)=
      #push @arr,$ident,$comment,$facility,$city,$addr,$cross_road)=split(/\0/,substr($pdata,48));
      @arr=unpack("CCCCva18VVVVVA2A2",$pdata);
      push @arr,split(/\0/,substr($pdata,48),6);
      my $lat=semicircle2degree($arr[6]);
      my $lon=semicircle2degree($arr[7]);
      my $alt=floor(unpack("f",pack("L",$arr[8])));  # float, correct byte order
      my $dist=floor(unpack("f",pack("L",$arr[9])));  # float, correct byte order
      my $ident=substr($arr[13],0,11);
      my $comment=substr($arr[14],0,20);
      my $smbl=$arr[4];
      if ($oldpid!=$pid) {
        $str="\nH  IDNT        LATITUDE    LONGITUDE    ALT     DESCRIPTION          PROXIMITY SYMBOL\n";
      }
      $str=$str.sprintf("W  %-11s %11.7f %12.7f %7g %-20s %9g %6d\n",$ident,$lat,$lon,$alt,$comment,$dist,$smbl);
    }else{
      print STDERR "ERROR: unknown wpt_type \"$PA_wpt_type\"\n";
      $str="#  unknown type of waypoint packet\n";
    }

  }elsif ($pid==34) {  # == Pid_Trk_Data
    if ($PA_trk_point_type eq "D301") {
      @arr=unpack("VVVVVC",$pdata);
      my $lat=semicircle2degree($arr[0]);
      my $lon=semicircle2degree($arr[1]);
      my $time=$arr[2]+631065600;
      my ($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst)=gmtime($time);
      my $alt=floor(unpack("f",pack("L",$arr[3])));  # float, correct byte order
      my $new_trk=$arr[5];
      if ($oldpid!=$pid) {
        $str="\nH  LATITUDE    LONGITUDE    DATE      TIME     ALT     DESCRIPTION\n";
      }
      if ($new_trk!=0 && $oldpid==$pid) {
        $str=$str."\n";
      }
      $str=$str.sprintf("T  %11.7f %12.7f %02d-%3s-%02d %02d:%02d:%02d %7g\n",$lat,$lon,$mday,$month_names[$mon],$year%100, $hour,$min,$sec, $alt);
    }else{
      print STDERR "ERROR: unknown trk_point_type \"$PA_trk_point_type\"\n";
      $str="#  unknown type of track packet\n";
    }

  }elsif ($pid==14) {  # == Pid_Date_Time_Data
    if ($PA_date_time_type eq "D600") {
      @arr=unpack("CCvvCC",$pdata);
      if ($oldpid!=$pid) {
        $str="\nH  DATE      TIME\n";
      }
      $str=$str.sprintf("DT %02d-%3s-%02d %02d:%02d:%02d\n",$arr[1],$month_names[$arr[0]-1],$arr[2]%100, $arr[3],$arr[4],$arr[5]);
    }else{
      print STDERR "ERROR: unknown date_time_type \"$PA_date_time_type\"\n";
      $str="#  unknown type of date_time packet\n";
    }

  }elsif ($pid==17) {  # == Pid_Posistion_Data
    if ($PA_position_type eq "D700") {
      my $lat=0;
      my $lon=0;
      if ($little_endian) { # garmin uses little endian, convert to host byte order (i86: little endian)
        @arr=unpack("dd",$pdata);
        $lat=radian2degree($arr[0]);
        $lon=radian2degree($arr[1]);
      }else{
        @arr=unpack("VVVV",$pdata);
        $lat=radian2degree(unpack("d",pack("LL",$arr[1],$arr[0])));  # convert to host byte order/double
        $lon=radian2degree(unpack("d",pack("LL",$arr[3],$arr[2])));
      }
      if ($oldpid!=$pid) {
        $str="\nH  LATITUDE    LONGITUDE\n";
      }
      $str=$str.sprintf("PO %11.7f %12.7f\n",$lat,$lon);
    }else{
      print STDERR "ERROR: unknown posistion_type \"$PA_position_type\"\n";
      $str="#  unknown type of position packet\n";
    }



  }elsif ($pid==99) {  # == Pid_Trk_Hdr
    if ($PA_trk_hdr_type eq "D310") {
      @arr=unpack("CC",$pdata);
      push @arr,substr($pdata,2,length($pdata)-3);
      my $trk_ident=$arr[2];
      $str="\nK  ".$trk_ident;
    }else{
      print STDERR "ERROR: unknown trk_hdr_type \"$PA_trk_hdr_type\"\n";
      $str="#  unknown type of track header packet\n";
    }

  }else              {  # == unknown Pid
    $str="#  unknown packet: pid=".$pid.", data= ".hexstr($pdata)."\n";
  }
  $oldpid=$pid;
  return $str;
}

# ---------------------------------------------------------------------
# find long protocol version (e.g A2 -> A201) and index of array @PA
# ---------------------------------------------------------------------
sub PA_find_protocol {
  my ($prot)=@_;
  my $i;

  for ($i=0;$i<=$#PA;$i++) {
    if ($PA[$i]=~/^$prot/) {
      return $i;
    }
  }
  return -1;
}

# ---------------------------------------------------------------------
# semicircle -> degree 
# ---------------------------------------------------------------------
sub semicircle2degree {
  my ($semi)=@_;
  my $degree;
  $degree=$semi*180.0/(1<<31);  
  if ($degree>180) {
    $degree=$degree-360.0;
  }
  return $degree;
}

# ---------------------------------------------------------------------
# radian -> degree 
# ---------------------------------------------------------------------
sub radian2degree {
  my ($radi)=@_;
  my $degree;
  $degree=$radi*180.0/$PI;  
  if ($degree>180) {
    $degree=$degree-360.0;
  }
  return $degree;
}